ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.64
Committed: Tue Apr 11 13:38:22 2006 UTC (18 years, 2 months ago) by root
Branch: MAIN
Changes since 1.63: +20 -16 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.60 package CFClient::Widget;
2 root 1.8
3 elmex 1.1 use strict;
4 root 1.18
5     use Scalar::Util;
6    
7 elmex 1.11 use SDL::OpenGL;
8     use SDL::OpenGL::Constants;
9 elmex 1.1
10 root 1.60 use CFClient;
11 root 1.41
12 root 1.51 our ($FOCUS, $HOVER, $GRAB); # various widgets
13    
14     our $TOPLEVEL;
15     our $BUTTON_STATE;
16    
17 elmex 1.1 # class methods for events
18 root 1.51 sub feed_sdl_key_down_event {
19     $FOCUS->key_down ($_[0]) if $FOCUS;
20     }
21    
22     sub feed_sdl_key_up_event {
23     $FOCUS->key_up ($_[0]) if $FOCUS;
24     }
25    
26     sub feed_sdl_button_down_event {
27     my ($ev) = @_;
28     my ($x, $y) = ($ev->motion_x, $ev->motion_y);
29    
30     if (!$BUTTON_STATE) {
31     my $widget = $TOPLEVEL->find_widget ($x, $y);
32    
33     $GRAB = $widget;
34     $GRAB->update if $GRAB;
35     }
36    
37     $BUTTON_STATE |= 1 << ($ev->button - 1);
38    
39 root 1.58 $GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB;
40 root 1.51 }
41    
42     sub feed_sdl_button_up_event {
43     my ($ev) = @_;
44     my ($x, $y) = ($ev->motion_x, $ev->motion_y);
45    
46     my $widget = $GRAB || $TOPLEVEL->find_widget ($x, $y);
47    
48     $BUTTON_STATE &= ~(1 << ($ev->button - 1));
49    
50 root 1.58 $GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB;
51    
52 root 1.51 if (!$BUTTON_STATE) {
53     my $grab = $GRAB; undef $GRAB;
54     $grab->update if $grab;
55     $GRAB->update if $GRAB;
56     }
57     }
58    
59     sub feed_sdl_motion_event {
60     my ($ev) = @_;
61     my ($x, $y) = ($ev->motion_x, $ev->motion_y);
62    
63     my $widget = $GRAB || $TOPLEVEL->find_widget ($x, $y);
64    
65     if ($widget != $HOVER) {
66     my $hover = $HOVER; $HOVER = $widget;
67    
68     $hover->update if $hover;
69     $HOVER->update if $HOVER;
70     }
71    
72 root 1.58 $HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER;
73 root 1.51 }
74 elmex 1.1
75     sub new {
76     my $class = shift;
77 root 1.10
78     bless { @_ }, $class
79 elmex 1.1 }
80    
81 root 1.18 sub move {
82     my ($self, $x, $y, $z) = @_;
83     $self->{x} = $x;
84     $self->{y} = $y;
85     $self->{z} = $z if defined $z;
86     }
87    
88 elmex 1.20 sub needs_redraw {
89     0
90     }
91    
92 root 1.14 sub size_request {
93 elmex 1.36 require Carp;
94     Carp::confess "size_request is abtract";
95     }
96    
97     sub size_allocate {
98     my ($self, $w, $h) = @_;
99 root 1.40
100     $self->{w} = $w;
101     $self->{h} = $h;
102 root 1.14 }
103    
104 root 1.58 # translate global koordinates to local coordinate system
105     sub translate {
106     my ($self, $x, $y) = @_;
107    
108     $self->{parent}->translate ($x - $self->{x}, $y - $self->{y});
109     }
110    
111 elmex 1.1 sub focus_in {
112 root 1.51 my ($self) = @_;
113    
114     my $focus = $FOCUS; $FOCUS = $self;
115     $focus->update if $focus;
116     $FOCUS->update;
117 elmex 1.1 }
118 root 1.4
119 elmex 1.1 sub focus_out {
120 root 1.51 my ($self) = @_;
121 root 1.4
122 root 1.51 return unless $FOCUS == $self;
123 root 1.4
124 root 1.51 my $focus = $FOCUS; undef $FOCUS;
125     $focus->update if $focus; #?
126 elmex 1.1 }
127 root 1.4
128 root 1.51 sub mouse_motion { }
129     sub button_up { }
130     sub button_down { }
131     sub key_down { }
132     sub key_up { }
133    
134     sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
135     sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
136     sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
137     sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
138     sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
139 elmex 1.11
140 elmex 1.1 sub draw {
141 elmex 1.11 my ($self) = @_;
142    
143     glPushMatrix;
144 root 1.12 glTranslate $self->{x}, $self->{y}, 0;
145 elmex 1.11 $self->_draw;
146 root 1.51 if ($self == $HOVER) {
147 root 1.48 glColor 1, 1, 1, 0.4;
148 root 1.50 glEnable GL_BLEND;
149 root 1.48 glBegin GL_QUADS;
150 root 1.51 glVertex 0 , 0;
151     glVertex $self->{w}, 0;
152     glVertex $self->{w}, $self->{h};
153     glVertex 0 , $self->{h};
154 root 1.47 glEnd;
155 root 1.50 glDisable GL_BLEND;
156 root 1.47 }
157 elmex 1.11 glPopMatrix;
158     }
159    
160     sub _draw {
161 root 1.38 my ($self) = @_;
162    
163     warn "no draw defined for $self\n";
164 elmex 1.1 }
165 root 1.4
166 elmex 1.1 sub bbox {
167 elmex 1.32 my ($self) = @_;
168     my ($w, $h) = $self->size_request;
169     (
170     $self->{x},
171     $self->{y},
172     $self->{x} = $w,
173     $self->{y} = $h
174     )
175     }
176    
177 root 1.38 sub find_widget {
178     my ($self, $x, $y) = @_;
179    
180     return $self
181     if $x >= $self->{x} && $x < $self->{x} + $self->{w}
182     && $y >= $self->{y} && $y < $self->{y} + $self->{h};
183    
184     ()
185     }
186    
187 elmex 1.32 sub del_parent { $_[0]->{parent} = undef }
188    
189     sub set_parent {
190     my ($self, $par) = @_;
191    
192     $self->{parent} = $par;
193     Scalar::Util::weaken $self->{parent};
194     }
195    
196     sub get_parent {
197     $_[0]->{parent}
198     }
199    
200     sub update {
201     my ($self) = @_;
202    
203     $self->{parent}->update
204     if $self->{parent};
205 elmex 1.1 }
206 elmex 1.2
207 root 1.18 sub DESTROY {
208     my ($self) = @_;
209    
210 elmex 1.32 #$self->deactivate;
211 root 1.18 }
212    
213 root 1.39 #############################################################################
214    
215 root 1.60 package CFClient::Widget::Container;
216 elmex 1.15
217 root 1.60 our @ISA = CFClient::Widget::;
218 elmex 1.15
219 root 1.38 sub new {
220 root 1.64 my ($class, %arg) = @_;
221    
222     my $children = delete $arg{children} || [];
223 root 1.38
224     my $self = $class->SUPER::new (children => []);
225 root 1.64 $self->add ($_) for @$children;
226 root 1.38
227     $self
228     }
229    
230     sub add {
231     my ($self, $chld, $expand) = @_;
232    
233     $chld->{expand} = $expand;
234     $chld->set_parent ($self);
235    
236     @{$self->{children}} =
237     sort { $a->{z} <=> $b->{z} }
238     @{$self->{children}}, $chld;
239    
240 root 1.43 $self->size_allocate ($self->{w}, $self->{h})
241     if $self->{w}; #TODO: check for "realised state"
242 root 1.38 }
243 root 1.35
244 elmex 1.32 sub remove {
245 root 1.38 my ($self, $widget) = @_;
246    
247     $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];
248    
249     $self->size_allocate ($self->{w}, $self->{h});
250     }
251    
252     sub find_widget {
253     my ($self, $x, $y) = @_;
254    
255 root 1.45 $x -= $self->{x};
256     $y -= $self->{y};
257    
258 root 1.38 my $res;
259    
260 root 1.46 for (reverse @{ $self->{children} }) {
261 root 1.45 $res = $_->find_widget ($x, $y)
262 root 1.38 and return $res;
263     }
264    
265 root 1.46 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
266 elmex 1.32 }
267 elmex 1.15
268 root 1.35 sub _draw {
269     my ($self) = @_;
270    
271 root 1.38 $_->draw for @{$self->{children}};
272 root 1.35 }
273 elmex 1.15
274 root 1.39 #############################################################################
275    
276 root 1.60 package CFClient::Widget::Bin;
277 elmex 1.32
278 root 1.60 our @ISA = CFClient::Widget::Container::;
279 elmex 1.32
280 root 1.39 sub child { $_[0]->{children}[0] }
281 elmex 1.32
282 root 1.38 sub size_request {
283     $_[0]{children}[0]->size_request if $_[0]{children}[0];
284     }
285 elmex 1.32
286 root 1.38 sub size_allocate {
287     my ($self, $w, $h) = @_;
288 root 1.42
289 root 1.38 $self->SUPER::size_allocate ($w, $h);
290     $self->{children}[0]->size_allocate ($w, $h)
291     if $self->{children}[0]
292     }
293 elmex 1.32
294 root 1.39 #############################################################################
295    
296 root 1.60 package CFClient::Widget::Window;
297 elmex 1.20
298 root 1.60 our @ISA = CFClient::Widget::Bin::;
299 elmex 1.20
300     use SDL::OpenGL;
301    
302 root 1.42 sub new {
303 root 1.64 my ($class, %arg) = @_;
304 elmex 1.32
305 root 1.64 my $self = $class->SUPER::new (%arg);
306 elmex 1.32 }
307    
308     sub update {
309     my ($self) = @_;
310 root 1.42
311 root 1.63 # we want to do this delayed...
312 elmex 1.32 $self->render_chld;
313 root 1.42 $self->SUPER::update;
314 elmex 1.20 }
315    
316     sub render_chld {
317     my ($self) = @_;
318    
319     $self->{texture} =
320 root 1.60 CFClient::Texture->new_from_opengl (
321 root 1.42 $self->{w}, $self->{h}, sub { $self->child->draw }
322 elmex 1.20 );
323 elmex 1.36 }
324    
325     sub size_allocate {
326     my ($self, $w, $h) = @_;
327    
328 root 1.42 $self->{w} = $w;
329     $self->{h} = $h;
330    
331     $self->child->size_allocate ($w, $h);
332 elmex 1.36
333 root 1.42 $self->render_chld;
334 elmex 1.20 }
335    
336     sub _draw {
337     my ($self) = @_;
338    
339 elmex 1.36 my ($w, $h) = ($self->w, $self->h);
340 root 1.29
341 elmex 1.20 my $tex = $self->{texture}
342     or return;
343    
344     glEnable GL_BLEND;
345     glEnable GL_TEXTURE_2D;
346 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
347 elmex 1.20
348 root 1.56 $tex->draw_quad (0, 0, $w, $h);
349 elmex 1.20
350     glDisable GL_BLEND;
351     glDisable GL_TEXTURE_2D;
352     }
353    
354 root 1.39 #############################################################################
355    
356 root 1.60 package CFClient::Widget::Frame;
357 elmex 1.15
358 root 1.60 our @ISA = CFClient::Widget::Bin::;
359 elmex 1.15
360     use SDL::OpenGL;
361    
362     sub size_request {
363     my ($self) = @_;
364 root 1.39 my $chld = $self->child
365 elmex 1.15 or return (0, 0);
366 root 1.30
367     $chld->move (2, 2);
368    
369 elmex 1.15 map { $_ + 4 } $chld->size_request;
370     }
371    
372 elmex 1.36 sub size_allocate {
373     my ($self, $w, $h) = @_;
374 root 1.42
375     $self->{w} = $w;
376     $self->{h} = $h;
377 elmex 1.36
378 root 1.39 $self->child->size_allocate ($w - 4, $h - 4);
379     $self->child->move (2, 2);
380 elmex 1.36 }
381    
382 elmex 1.15 sub _draw {
383     my ($self) = @_;
384    
385 root 1.39 my $chld = $self->child;
386 elmex 1.15
387     my ($w, $h) = $chld->size_request;
388    
389     glBegin GL_QUADS;
390 root 1.30 glColor 0, 0, 0;
391 root 1.56 glVertex 0 , 0;
392     glVertex 0 , $h + 4;
393     glVertex $w + 4 , $h + 4;
394     glVertex $w + 4 , 0;
395 elmex 1.15 glEnd;
396    
397 root 1.23 $chld->draw;
398 elmex 1.15 }
399    
400 root 1.39 #############################################################################
401    
402 root 1.60 package CFClient::Widget::FancyFrame;
403 elmex 1.31
404 root 1.60 our @ISA = CFClient::Widget::Bin::;
405 elmex 1.31
406     use SDL::OpenGL;
407    
408 root 1.41 my @tex =
409 root 1.60 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
410 root 1.41 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
411 elmex 1.34
412     sub size_request {
413     my ($self) = @_;
414 root 1.39
415     my ($w, $h) = $self->SUPER::size_request;
416 elmex 1.34
417 root 1.41 $h += $tex[1]->{height};
418     $h += $tex[4]->{height};
419     $w += $tex[2]->{width};
420     $w += $tex[3]->{width};
421 elmex 1.34
422 elmex 1.36 ($w, $h)
423     }
424    
425     sub size_allocate {
426     my ($self, $w, $h) = @_;
427    
428 root 1.40 $self->SUPER::size_allocate ($w, $h);
429    
430 root 1.41 $h -= $tex[1]->{height};
431     $h -= $tex[4]->{height};
432     $w -= $tex[2]->{width};
433     $w -= $tex[3]->{width};
434 elmex 1.36
435     $h = $h < 0 ? 0 : $h;
436     $w = $w < 0 ? 0 : $w;
437 root 1.43
438 root 1.39 $self->child->size_allocate ($w, $h);
439 root 1.43 $self->child->move ($tex[3]->{width}, $tex[1]->{height});
440 elmex 1.34 }
441    
442     sub _draw {
443     my ($self) = @_;
444    
445 root 1.43 my ($w, $h) = ($self->{w}, $self->{h});
446     my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
447 elmex 1.34
448     glEnable GL_BLEND;
449     glEnable GL_TEXTURE_2D;
450     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
451 elmex 1.36 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
452 elmex 1.34
453 root 1.41 my $top = $tex[1];
454 root 1.56 $top->draw_quad (0, 0, $w, $top->{height});
455 elmex 1.34
456 root 1.41 my $left = $tex[3];
457 root 1.56 $left->draw_quad (0, $top->{height}, $left->{width}, $ch);
458 elmex 1.34
459 root 1.41 my $right = $tex[2];
460 root 1.56 $right->draw_quad ($w - $right->{width}, $top->{height}, $right->{width}, $ch);
461 elmex 1.34
462 root 1.41 my $bottom = $tex[4];
463 root 1.56 $bottom->draw_quad (0, $h - $bottom->{height}, $w, $bottom->{height});
464 elmex 1.34
465 root 1.41 my $bg = $tex[0];
466 elmex 1.36 glBindTexture GL_TEXTURE_2D, $bg->{name};
467     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
468     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
469     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
470 elmex 1.34
471 elmex 1.36 my $rep_x = $cw / $bg->{width};
472     my $rep_y = $ch / $bg->{height};
473 elmex 1.34
474 root 1.56 $bg->draw_quad ($left->{width}, $top->{height}, $cw, $ch);
475 elmex 1.34
476     glDisable GL_BLEND;
477     glDisable GL_TEXTURE_2D;
478 elmex 1.36
479 root 1.39 $self->child->draw;
480 elmex 1.36
481 elmex 1.34 }
482 elmex 1.31
483 root 1.39 #############################################################################
484    
485 root 1.60 package CFClient::Widget::Table;
486 elmex 1.15
487 root 1.60 our @ISA = CFClient::Widget::Bin::;
488 elmex 1.15
489     use SDL::OpenGL;
490    
491     sub add {
492     my ($self, $x, $y, $chld) = @_;
493 root 1.38 my $old_chld = $self->{children}[$y][$x];
494 elmex 1.32
495 root 1.38 $self->{children}[$y][$x] = $chld;
496 elmex 1.32 $chld->set_parent ($self);
497     $self->update;
498 elmex 1.15 }
499    
500     sub max_row_height {
501     my ($self, $row) = @_;
502    
503     my $hs = 0;
504 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$row] || []}; $xi++) {
505     my $c = $self->{children}->[$row]->[$xi];
506 elmex 1.17 if ($c) {
507     my ($w, $h) = $c->size_request;
508     if ($hs < $h) { $hs = $h }
509     }
510 elmex 1.15 }
511     return $hs;
512     }
513    
514     sub max_col_width {
515     my ($self, $col) = @_;
516    
517     my $ws = 0;
518 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children} || []}; $yi++) {
519     my $c = ($self->{children}->[$yi] || [])->[$col];
520 elmex 1.17 if ($c) {
521     my ($w, $h) = $c->size_request;
522     if ($ws < $w) { $ws = $w }
523     }
524 elmex 1.15 }
525     return $ws;
526     }
527    
528     sub size_request {
529     my ($self) = @_;
530    
531     my ($hs, $ws) = (0, 0);
532    
533 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
534 elmex 1.15 $hs += $self->max_row_height ($yi);
535     }
536    
537 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
538 elmex 1.15 my $wm = 0;
539 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
540 elmex 1.15 $wm += $self->max_col_width ($xi)
541     }
542     if ($ws < $wm) { $ws = $wm }
543     }
544    
545     return ($ws, $hs);
546     }
547    
548     sub _draw {
549     my ($self) = @_;
550    
551     my $y = 0;
552 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
553 elmex 1.15 my $x = 0;
554    
555 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
556 elmex 1.15
557 root 1.38 my $c = $self->{children}->[$yi]->[$xi];
558 elmex 1.26 if ($c) {
559     $c->move ($x, $y, 0); #TODO: Move to size_request
560     $c->draw if $c;
561     }
562 elmex 1.15
563     $x += $self->max_col_width ($xi);
564     }
565    
566     $y += $self->max_row_height ($yi);
567     }
568     }
569    
570 root 1.39 #############################################################################
571    
572 root 1.60 package CFClient::Widget::VBox;
573 elmex 1.15
574 root 1.60 our @ISA = CFClient::Widget::Container::;
575 elmex 1.15
576     use SDL::OpenGL;
577    
578 root 1.43 sub size_request {
579     my ($self) = @_;
580    
581     my @alloc = map [$_->size_request], @{$self->{children}};
582    
583     (
584     (List::Util::max map $_->[0], @alloc),
585     (List::Util::sum map $_->[1], @alloc),
586     )
587     }
588    
589 elmex 1.36 sub size_allocate {
590     my ($self, $w, $h) = @_;
591    
592     $self->w ($w);
593     $self->h ($h);
594    
595     my $exp;
596     my @oth;
597     # find expand widget
598 root 1.38 for (@{$self->{children}}) {
599 elmex 1.36 if ($_->{expand}) {
600     $exp = $_;
601     last;
602     }
603     push @oth, $_;
604     }
605    
606     my ($ow, $oh);
607    
608     # get sizes of other widgets
609     for (@oth) {
610     my ($w, $h) = $_->size_request;
611     $oh += $h;
612     if ($ow < $w) { $ow = $w }
613     }
614    
615     my $y = 0;
616 root 1.38 for (@{$self->{children}}) {
617 elmex 1.36 $_->move (0, $y);
618    
619     if ($_ == $exp) {
620     $_->size_allocate ($w, $h - $oh);
621     $y += $h - $oh;
622     } else {
623     my ($cw, $h) = $_->size_request;
624     $_->size_allocate ($w, $h);
625     $y += $h;
626     }
627     }
628     }
629    
630 root 1.39 #############################################################################
631    
632 root 1.60 package CFClient::Widget::Label;
633 root 1.10
634 root 1.60 our @ISA = CFClient::Widget::;
635 root 1.12
636 root 1.10 use SDL::OpenGL;
637    
638     sub new {
639 root 1.64 my ($class, %arg) = @_;
640 root 1.51
641 root 1.33 # TODO: color, and make height, xyz etc. optional
642 root 1.59 my $self = $class->SUPER::new (
643 root 1.64 color => [1, 1, 1],
644     height => $::FONTSIZE,
645     text => "",
646     layout => new CFClient::Layout,
647     %arg
648 root 1.59 );
649 root 1.10
650 root 1.64 $self->set_text ($self->{text});
651 root 1.10
652     $self
653     }
654    
655 elmex 1.15 sub set_text {
656     my ($self, $text) = @_;
657 root 1.28
658     $self->{text} = $text;
659 root 1.59 $self->{layout}->set_markup ($text);
660 root 1.28
661 root 1.59 delete $self->{texture};
662 elmex 1.15 }
663    
664     sub get_text {
665     my ($self, $text) = @_;
666 root 1.28
667 elmex 1.15 $self->{text}
668     }
669    
670 root 1.14 sub size_request {
671     my ($self) = @_;
672    
673 root 1.59 $self->{layout}->set_width;
674 root 1.64 $self->{layout}->set_height ($self->{height});
675 root 1.59 $self->{layout}->size
676     # if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack
677     # (
678     # $self->{texture}{width},
679     # $self->{texture}{height},
680     # )
681     # } else {
682 root 1.60 # my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height};
683 root 1.59 #
684     # ($w, $h)
685     # }
686     }
687 root 1.51
688 root 1.59 sub size_allocate {
689     my ($self, $w, $h) = @_;
690 root 1.51
691 root 1.59 $self->SUPER::size_allocate ($w, $h);
692     delete $self->{texture};
693 root 1.14 }
694    
695 elmex 1.11 sub _draw {
696 root 1.10 my ($self) = @_;
697    
698 root 1.59 my $tex = $self->{texture} ||= do {
699     $self->{layout}->set_width ($self->{w});
700 root 1.60 new_from_layout CFClient::Texture $self->{layout};
701 root 1.59 };
702 root 1.10
703 root 1.12 glEnable GL_BLEND;
704 root 1.10 glEnable GL_TEXTURE_2D;
705 root 1.30 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
706 root 1.28 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
707 root 1.10
708 root 1.62 glColor @{$self->{color}};
709 root 1.12
710 root 1.56 $tex->draw_quad (0, 0);
711 root 1.10
712 root 1.12 glDisable GL_BLEND;
713 root 1.10 glDisable GL_TEXTURE_2D;
714     }
715    
716 root 1.39 #############################################################################
717    
718 root 1.60 package CFClient::Widget::Entry;
719 elmex 1.31
720 root 1.60 our @ISA = CFClient::Widget::Label::;
721 elmex 1.31
722     use SDL;
723     use SDL::OpenGL;
724    
725     sub key_down {
726     my ($self, $ev) = @_;
727    
728     my $mod = $ev->key_mod;
729     my $sym = $ev->key_sym;
730    
731     my $uni = $ev->key_unicode;
732    
733     my $text = $self->get_text;
734    
735     if ($sym == SDLK_BACKSPACE) {
736     substr $text, -1, 1, '';
737     } elsif ($uni) {
738     $text .= chr $uni;
739     }
740 root 1.51
741 elmex 1.31 $self->set_text ($text);
742     }
743    
744 root 1.51 sub button_down {
745     my ($self, $ev) = @_;
746    
747     $self->focus_in;
748     }
749    
750 root 1.58 sub mouse_motion {
751     my ($self, $ev, $x, $y) = @_;
752     printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
753     }
754    
755 root 1.51 sub _draw {
756     my ($self) = @_;
757    
758     if ($FOCUS == $self) {
759     glColor 1, 1, 1;
760     } else {
761     glColor 0.7, 0.7, 0.7;
762     }
763    
764     glBegin GL_QUADS;
765     glVertex 0 , 0;
766     glVertex 0 , $self->{h} - 1;
767     glVertex $self->{w} - 1, $self->{h} - 1;
768     glVertex $self->{w} - 1, 0;
769     glEnd;
770    
771     $self->SUPER::_draw;
772     }
773    
774 root 1.39 #############################################################################
775    
776 root 1.60 package CFClient::Widget::MapWidget;
777 root 1.4
778 elmex 1.2 use strict;
779 elmex 1.7
780 root 1.25 use List::Util qw(min max);
781 elmex 1.2
782 root 1.16 use SDL;
783 elmex 1.2 use SDL::OpenGL;
784     use SDL::OpenGL::Constants;
785    
786 root 1.60 our @ISA = CFClient::Widget::;
787 root 1.25
788 root 1.64 sub new {
789     my $class = shift;
790    
791     $class->SUPER::new (z => -1, @_)
792     }
793    
794 elmex 1.2 sub key_down {
795     print "MAPKEYDOWN\n";
796     }
797    
798     sub key_up {
799     }
800    
801 elmex 1.36 sub size_request {
802 root 1.52 (
803     1 + int $::WIDTH / 32,
804     1 + int $::HEIGHT / 32,
805     )
806 elmex 1.36 }
807    
808 elmex 1.11 sub _draw {
809 root 1.21 my ($self) = @_;
810    
811 root 1.25 my $mx = $::CONN->{mapx};
812     my $my = $::CONN->{mapy};
813    
814     my $map = $::CONN->{map};
815    
816     my ($xofs, $yofs);
817    
818     my $sw = 1 + int $::WIDTH / 32;
819     my $sh = 1 + int $::HEIGHT / 32;
820    
821     if ($::CONN->{mapw} > $sw) {
822 root 1.27 $xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
823 root 1.25 } else {
824     $xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
825     }
826    
827     if ($::CONN->{maph} > $sh) {
828 root 1.27 $yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
829 root 1.25 } else {
830     $yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
831     }
832    
833 elmex 1.2 glEnable GL_TEXTURE_2D;
834     glEnable GL_BLEND;
835 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
836    
837     my $sw4 = ($sw + 3) & ~3;
838 root 1.57 my $darkness = "\x00" x ($sw4 * $sh);
839 elmex 1.2
840 root 1.25 for my $x (0 .. $sw - 1) {
841 root 1.57 my $row = $map->[$x + $xofs];
842 root 1.25 for my $y (0 .. $sh - 1) {
843 elmex 1.2
844 root 1.57 my $cell = $row->[$y + $yofs]
845 elmex 1.2 or next;
846    
847 root 1.57 my $dark = $cell->[0];
848     if ($dark < 0) {
849     substr $darkness, $y * $sw4 + $x, 1, chr 224;
850     } else {
851     substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark;
852 root 1.21 }
853 elmex 1.2
854 root 1.21 for my $num (grep $_, @$cell[1,2,3]) {
855 root 1.4 my $tex = $::CONN->{face}[$num]{texture} || next;
856 root 1.56
857 root 1.19 my $w = $tex->{width};
858     my $h = $tex->{height};
859    
860 root 1.57 $tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h);
861 elmex 1.2 }
862     }
863     }
864    
865 root 1.35 # if (1) { # higher quality darkness
866     # $lighting =~ s/(.)/$1$1$1/gs;
867     # my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
868     #
869     # $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear");
870     #
871     # $lighting = $pb->get_pixels;
872     # $lighting =~ s/(.)../$1/gs;
873     # }
874    
875 root 1.57 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
876     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
877    
878 root 1.60 $darkness = new CFClient::Texture
879 root 1.35 width => $sw4,
880     height => $sh,
881 root 1.57 data => $darkness,
882 root 1.52 internalformat => GL_ALPHA,
883 root 1.35 format => GL_ALPHA;
884    
885 root 1.55 glColor 0.45, 0.45, 0.45, 1;
886 root 1.57 $darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32);
887 root 1.35
888 elmex 1.2 glDisable GL_TEXTURE_2D;
889     glDisable GL_BLEND;
890     }
891    
892 root 1.16 my %DIR = (
893     SDLK_KP8, [1, "north"],
894 root 1.18 SDLK_KP9, [2, "northeast"],
895 root 1.16 SDLK_KP6, [3, "east"],
896     SDLK_KP3, [4, "southeast"],
897     SDLK_KP2, [5, "south"],
898     SDLK_KP1, [6, "southwest"],
899     SDLK_KP4, [7, "west"],
900     SDLK_KP7, [8, "northwest"],
901 root 1.18
902     SDLK_UP, [1, "north"],
903     SDLK_RIGHT, [3, "east"],
904     SDLK_DOWN, [5, "south"],
905     SDLK_LEFT, [7, "west"],
906 root 1.16 );
907    
908     sub key_down {
909     my ($self, $ev) = @_;
910    
911     my $mod = $ev->key_mod;
912     my $sym = $ev->key_sym;
913    
914     if ($sym == SDLK_KP5) {
915     $::CONN->send ("command stay fire");
916     } elsif (exists $DIR{$sym}) {
917     if ($mod & KMOD_SHIFT) {
918 root 1.18 $self->{shft}++;
919 root 1.16 $::CONN->send ("command fire $DIR{$sym}[0]");
920     } elsif ($mod & KMOD_CTRL) {
921 root 1.18 $self->{ctrl}++;
922 root 1.16 $::CONN->send ("command run $DIR{$sym}[0]");
923     } else {
924 root 1.18 $::CONN->send ("command $DIR{$sym}[1]");
925 root 1.16 }
926     }
927     }
928    
929     sub key_up {
930     my ($self, $ev) = @_;
931    
932     my $mod = $ev->key_mod;
933     my $sym = $ev->key_sym;
934    
935 root 1.18 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
936     $::CONN->send ("command fire_stop");
937     }
938     if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
939     $::CONN->send ("command run_stop");
940 root 1.16 }
941     }
942    
943 root 1.39 #############################################################################
944    
945 root 1.60 package CFClient::Widget::Animator;
946 root 1.35
947     use SDL::OpenGL;
948    
949 root 1.60 our @ISA = CFClient::Widget::Bin::;
950 root 1.35
951     sub moveto {
952     my ($self, $x, $y) = @_;
953    
954     $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
955 root 1.56 $self->{speed} = 0.001;
956 root 1.35 $self->{time} = 1;
957    
958     ::animation_start $self;
959     }
960    
961     sub animate {
962     my ($self, $interval) = @_;
963    
964     $self->{time} -= $interval * $self->{speed};
965     if ($self->{time} <= 0) {
966     $self->{time} = 0;
967     ::animation_stop $self;
968     }
969    
970     my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
971    
972     $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
973     $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
974     }
975    
976     sub _draw {
977     my ($self) = @_;
978    
979     glPushMatrix;
980 root 1.51 glRotate $self->{time} * 1000, 0, 1, 0;
981 root 1.38 $self->{children}[0]->draw;
982 root 1.35 glPopMatrix;
983     }
984    
985 root 1.51 #############################################################################
986    
987 root 1.60 package CFClient::Widget::Toplevel;
988 root 1.51
989 root 1.60 our @ISA = CFClient::Widget::Container::;
990 root 1.51
991     sub size_request {
992     ($::WIDTH, $::HEIGHT)
993     }
994    
995     sub size_allocate {
996     my ($self, $w, $h) = @_;
997    
998     $self->SUPER::size_allocate ($w, $h);
999    
1000     $_->size_allocate ($_->size_request)
1001     for @{$self->{children}};
1002     }
1003    
1004 root 1.58 sub translate {
1005     my ($self, $x, $y) = @_;
1006    
1007     ($x, $y)
1008     }
1009    
1010 root 1.51 sub update {
1011     my ($self) = @_;
1012    
1013     $self->size_allocate ($self->size_request);
1014     ::refresh ();
1015     }
1016    
1017     sub add {
1018     my ($self, $widget) = @_;
1019    
1020     $self->SUPER::add ($widget);
1021    
1022     $widget->size_allocate ($widget->size_request);
1023     }
1024    
1025     sub draw {
1026     my ($self) = @_;
1027    
1028     $self->_draw;
1029     }
1030    
1031     #############################################################################
1032    
1033 root 1.60 package CFClient::Widget;
1034 root 1.51
1035 root 1.60 $TOPLEVEL = new CFClient::Widget::Toplevel;
1036 root 1.51
1037     1
1038 root 1.5