ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.62
Committed: Tue Apr 11 13:27:48 2006 UTC (18 years, 2 months ago) by root
Branch: MAIN
Changes since 1.61: +2 -1 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     my ($class, @widgets) = @_;
221    
222     my $self = $class->SUPER::new (children => []);
223     $self->add ($_) for @widgets;
224    
225     $self
226     }
227    
228     sub add {
229     my ($self, $chld, $expand) = @_;
230    
231     $chld->{expand} = $expand;
232     $chld->set_parent ($self);
233    
234     @{$self->{children}} =
235     sort { $a->{z} <=> $b->{z} }
236     @{$self->{children}}, $chld;
237    
238 root 1.43 $self->size_allocate ($self->{w}, $self->{h})
239     if $self->{w}; #TODO: check for "realised state"
240 root 1.38 }
241 root 1.35
242 elmex 1.32 sub remove {
243 root 1.38 my ($self, $widget) = @_;
244    
245     $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];
246    
247     $self->size_allocate ($self->{w}, $self->{h});
248     }
249    
250     sub find_widget {
251     my ($self, $x, $y) = @_;
252    
253 root 1.45 $x -= $self->{x};
254     $y -= $self->{y};
255    
256 root 1.38 my $res;
257    
258 root 1.46 for (reverse @{ $self->{children} }) {
259 root 1.45 $res = $_->find_widget ($x, $y)
260 root 1.38 and return $res;
261     }
262    
263 root 1.46 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
264 elmex 1.32 }
265 elmex 1.15
266 root 1.35 sub _draw {
267     my ($self) = @_;
268    
269 root 1.38 $_->draw for @{$self->{children}};
270 root 1.35 }
271 elmex 1.15
272 root 1.39 #############################################################################
273    
274 root 1.60 package CFClient::Widget::Bin;
275 elmex 1.32
276 root 1.60 our @ISA = CFClient::Widget::Container::;
277 elmex 1.32
278 root 1.39 sub child { $_[0]->{children}[0] }
279 elmex 1.32
280 root 1.38 sub size_request {
281     $_[0]{children}[0]->size_request if $_[0]{children}[0];
282     }
283 elmex 1.32
284 root 1.38 sub size_allocate {
285     my ($self, $w, $h) = @_;
286 root 1.42
287 root 1.38 $self->SUPER::size_allocate ($w, $h);
288     $self->{children}[0]->size_allocate ($w, $h)
289     if $self->{children}[0]
290     }
291 elmex 1.32
292 root 1.39 #############################################################################
293    
294 root 1.60 package CFClient::Widget::Window;
295 elmex 1.20
296 root 1.60 our @ISA = CFClient::Widget::Bin::;
297 elmex 1.20
298     use SDL::OpenGL;
299    
300 root 1.42 sub new {
301     my ($class, $x, $y, $z, $w, $h) = @_;
302    
303     my $self = $class->SUPER::new;
304 elmex 1.32
305 root 1.42 @$self{qw(x y z w h)} = ($x, $y, $z, $w, $h);
306 elmex 1.32 }
307    
308     sub update {
309     my ($self) = @_;
310 root 1.42
311 elmex 1.32 $self->render_chld;
312 root 1.42 $self->SUPER::update;
313 elmex 1.20 }
314    
315     sub render_chld {
316     my ($self) = @_;
317    
318     $self->{texture} =
319 root 1.60 CFClient::Texture->new_from_opengl (
320 root 1.42 $self->{w}, $self->{h}, sub { $self->child->draw }
321 elmex 1.20 );
322 elmex 1.36 }
323    
324     sub size_allocate {
325     my ($self, $w, $h) = @_;
326    
327 root 1.42 $self->{w} = $w;
328     $self->{h} = $h;
329    
330     $self->child->size_allocate ($w, $h);
331 elmex 1.36
332 root 1.42 $self->render_chld;
333 elmex 1.20 }
334    
335     sub _draw {
336     my ($self) = @_;
337    
338 elmex 1.36 my ($w, $h) = ($self->w, $self->h);
339 root 1.29
340 elmex 1.20 my $tex = $self->{texture}
341     or return;
342    
343     glEnable GL_BLEND;
344     glEnable GL_TEXTURE_2D;
345 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
346 elmex 1.20
347 root 1.56 $tex->draw_quad (0, 0, $w, $h);
348 elmex 1.20
349     glDisable GL_BLEND;
350     glDisable GL_TEXTURE_2D;
351     }
352    
353 root 1.39 #############################################################################
354    
355 root 1.60 package CFClient::Widget::Frame;
356 elmex 1.15
357 root 1.60 our @ISA = CFClient::Widget::Bin::;
358 elmex 1.15
359     use SDL::OpenGL;
360    
361     sub size_request {
362     my ($self) = @_;
363 root 1.39 my $chld = $self->child
364 elmex 1.15 or return (0, 0);
365 root 1.30
366     $chld->move (2, 2);
367    
368 elmex 1.15 map { $_ + 4 } $chld->size_request;
369     }
370    
371 elmex 1.36 sub size_allocate {
372     my ($self, $w, $h) = @_;
373 root 1.42
374     $self->{w} = $w;
375     $self->{h} = $h;
376 elmex 1.36
377 root 1.39 $self->child->size_allocate ($w - 4, $h - 4);
378     $self->child->move (2, 2);
379 elmex 1.36 }
380    
381 elmex 1.15 sub _draw {
382     my ($self) = @_;
383    
384 root 1.39 my $chld = $self->child;
385 elmex 1.15
386     my ($w, $h) = $chld->size_request;
387    
388     glBegin GL_QUADS;
389 root 1.30 glColor 0, 0, 0;
390 root 1.56 glVertex 0 , 0;
391     glVertex 0 , $h + 4;
392     glVertex $w + 4 , $h + 4;
393     glVertex $w + 4 , 0;
394 elmex 1.15 glEnd;
395    
396 root 1.23 $chld->draw;
397 elmex 1.15 }
398    
399 root 1.39 #############################################################################
400    
401 root 1.60 package CFClient::Widget::FancyFrame;
402 elmex 1.31
403 root 1.60 our @ISA = CFClient::Widget::Bin::;
404 elmex 1.31
405     use SDL::OpenGL;
406    
407 root 1.41 my @tex =
408 root 1.60 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
409 root 1.41 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
410 elmex 1.34
411     sub size_request {
412     my ($self) = @_;
413 root 1.39
414     my ($w, $h) = $self->SUPER::size_request;
415 elmex 1.34
416 root 1.41 $h += $tex[1]->{height};
417     $h += $tex[4]->{height};
418     $w += $tex[2]->{width};
419     $w += $tex[3]->{width};
420 elmex 1.34
421 elmex 1.36 ($w, $h)
422     }
423    
424     sub size_allocate {
425     my ($self, $w, $h) = @_;
426    
427 root 1.40 $self->SUPER::size_allocate ($w, $h);
428    
429 root 1.41 $h -= $tex[1]->{height};
430     $h -= $tex[4]->{height};
431     $w -= $tex[2]->{width};
432     $w -= $tex[3]->{width};
433 elmex 1.36
434     $h = $h < 0 ? 0 : $h;
435     $w = $w < 0 ? 0 : $w;
436 root 1.43
437 root 1.39 $self->child->size_allocate ($w, $h);
438 root 1.43 $self->child->move ($tex[3]->{width}, $tex[1]->{height});
439 elmex 1.34 }
440    
441     sub _draw {
442     my ($self) = @_;
443    
444 root 1.43 my ($w, $h) = ($self->{w}, $self->{h});
445     my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
446 elmex 1.34
447     glEnable GL_BLEND;
448     glEnable GL_TEXTURE_2D;
449     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
450 elmex 1.36 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
451 elmex 1.34
452 root 1.41 my $top = $tex[1];
453 root 1.56 $top->draw_quad (0, 0, $w, $top->{height});
454 elmex 1.34
455 root 1.41 my $left = $tex[3];
456 root 1.56 $left->draw_quad (0, $top->{height}, $left->{width}, $ch);
457 elmex 1.34
458 root 1.41 my $right = $tex[2];
459 root 1.56 $right->draw_quad ($w - $right->{width}, $top->{height}, $right->{width}, $ch);
460 elmex 1.34
461 root 1.41 my $bottom = $tex[4];
462 root 1.56 $bottom->draw_quad (0, $h - $bottom->{height}, $w, $bottom->{height});
463 elmex 1.34
464 root 1.41 my $bg = $tex[0];
465 elmex 1.36 glBindTexture GL_TEXTURE_2D, $bg->{name};
466     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
467     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
468     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
469 elmex 1.34
470 elmex 1.36 my $rep_x = $cw / $bg->{width};
471     my $rep_y = $ch / $bg->{height};
472 elmex 1.34
473 root 1.56 $bg->draw_quad ($left->{width}, $top->{height}, $cw, $ch);
474 elmex 1.34
475     glDisable GL_BLEND;
476     glDisable GL_TEXTURE_2D;
477 elmex 1.36
478 root 1.39 $self->child->draw;
479 elmex 1.36
480 elmex 1.34 }
481 elmex 1.31
482 root 1.39 #############################################################################
483    
484 root 1.60 package CFClient::Widget::Table;
485 elmex 1.15
486 root 1.60 our @ISA = CFClient::Widget::Bin::;
487 elmex 1.15
488     use SDL::OpenGL;
489    
490     sub add {
491     my ($self, $x, $y, $chld) = @_;
492 root 1.38 my $old_chld = $self->{children}[$y][$x];
493 elmex 1.32
494 root 1.38 $self->{children}[$y][$x] = $chld;
495 elmex 1.32 $chld->set_parent ($self);
496     $self->update;
497 elmex 1.15 }
498    
499     sub max_row_height {
500     my ($self, $row) = @_;
501    
502     my $hs = 0;
503 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$row] || []}; $xi++) {
504     my $c = $self->{children}->[$row]->[$xi];
505 elmex 1.17 if ($c) {
506     my ($w, $h) = $c->size_request;
507     if ($hs < $h) { $hs = $h }
508     }
509 elmex 1.15 }
510     return $hs;
511     }
512    
513     sub max_col_width {
514     my ($self, $col) = @_;
515    
516     my $ws = 0;
517 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children} || []}; $yi++) {
518     my $c = ($self->{children}->[$yi] || [])->[$col];
519 elmex 1.17 if ($c) {
520     my ($w, $h) = $c->size_request;
521     if ($ws < $w) { $ws = $w }
522     }
523 elmex 1.15 }
524     return $ws;
525     }
526    
527     sub size_request {
528     my ($self) = @_;
529    
530     my ($hs, $ws) = (0, 0);
531    
532 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
533 elmex 1.15 $hs += $self->max_row_height ($yi);
534     }
535    
536 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
537 elmex 1.15 my $wm = 0;
538 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
539 elmex 1.15 $wm += $self->max_col_width ($xi)
540     }
541     if ($ws < $wm) { $ws = $wm }
542     }
543    
544     return ($ws, $hs);
545     }
546    
547     sub _draw {
548     my ($self) = @_;
549    
550     my $y = 0;
551 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
552 elmex 1.15 my $x = 0;
553    
554 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
555 elmex 1.15
556 root 1.38 my $c = $self->{children}->[$yi]->[$xi];
557 elmex 1.26 if ($c) {
558     $c->move ($x, $y, 0); #TODO: Move to size_request
559     $c->draw if $c;
560     }
561 elmex 1.15
562     $x += $self->max_col_width ($xi);
563     }
564    
565     $y += $self->max_row_height ($yi);
566     }
567     }
568    
569 root 1.39 #############################################################################
570    
571 root 1.60 package CFClient::Widget::VBox;
572 elmex 1.15
573 root 1.60 our @ISA = CFClient::Widget::Container::;
574 elmex 1.15
575     use SDL::OpenGL;
576    
577 root 1.43 sub size_request {
578     my ($self) = @_;
579    
580     my @alloc = map [$_->size_request], @{$self->{children}};
581    
582     (
583     (List::Util::max map $_->[0], @alloc),
584     (List::Util::sum map $_->[1], @alloc),
585     )
586     }
587    
588 elmex 1.36 sub size_allocate {
589     my ($self, $w, $h) = @_;
590    
591     $self->w ($w);
592     $self->h ($h);
593    
594     my $exp;
595     my @oth;
596     # find expand widget
597 root 1.38 for (@{$self->{children}}) {
598 elmex 1.36 if ($_->{expand}) {
599     $exp = $_;
600     last;
601     }
602     push @oth, $_;
603     }
604    
605     my ($ow, $oh);
606    
607     # get sizes of other widgets
608     for (@oth) {
609     my ($w, $h) = $_->size_request;
610     $oh += $h;
611     if ($ow < $w) { $ow = $w }
612     }
613    
614     my $y = 0;
615 root 1.38 for (@{$self->{children}}) {
616 elmex 1.36 $_->move (0, $y);
617    
618     if ($_ == $exp) {
619     $_->size_allocate ($w, $h - $oh);
620     $y += $h - $oh;
621     } else {
622     my ($cw, $h) = $_->size_request;
623     $_->size_allocate ($w, $h);
624     $y += $h;
625     }
626     }
627     }
628    
629 root 1.39 #############################################################################
630    
631 root 1.60 package CFClient::Widget::Label;
632 root 1.10
633 root 1.60 our @ISA = CFClient::Widget::;
634 root 1.12
635 root 1.10 use SDL::OpenGL;
636    
637     sub new {
638 root 1.28 my ($class, $x, $y, $z, $height, $text) = @_;
639 root 1.10
640 root 1.51 $height ||= $::FONTSIZE;
641    
642 root 1.33 # TODO: color, and make height, xyz etc. optional
643 root 1.59 my $self = $class->SUPER::new (
644 root 1.62 color => [1, 1, 1],
645 root 1.59 x => $x,
646     y => $y,
647     z => $z,
648     height => $height,
649 root 1.61 layout => new CFClient::Layout $height,
650 root 1.59 );
651 root 1.10
652 elmex 1.15 $self->set_text ($text);
653 root 1.10
654     $self
655     }
656    
657 elmex 1.15 sub set_text {
658     my ($self, $text) = @_;
659 root 1.28
660     $self->{text} = $text;
661 root 1.59 $self->{layout}->set_markup ($text);
662 root 1.28
663 root 1.59 delete $self->{texture};
664 elmex 1.15 }
665    
666     sub get_text {
667     my ($self, $text) = @_;
668 root 1.28
669 elmex 1.15 $self->{text}
670     }
671    
672 root 1.14 sub size_request {
673     my ($self) = @_;
674    
675 root 1.59 $self->{layout}->set_width;
676     $self->{layout}->size
677     # if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack
678     # (
679     # $self->{texture}{width},
680     # $self->{texture}{height},
681     # )
682     # } else {
683 root 1.60 # my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height};
684 root 1.59 #
685     # ($w, $h)
686     # }
687     }
688 root 1.51
689 root 1.59 sub size_allocate {
690     my ($self, $w, $h) = @_;
691 root 1.51
692 root 1.59 $self->SUPER::size_allocate ($w, $h);
693     delete $self->{texture};
694 root 1.14 }
695    
696 elmex 1.11 sub _draw {
697 root 1.10 my ($self) = @_;
698    
699 root 1.59 my $tex = $self->{texture} ||= do {
700     $self->{layout}->set_width ($self->{w});
701 root 1.60 new_from_layout CFClient::Texture $self->{layout};
702 root 1.59 };
703 root 1.10
704 root 1.12 glEnable GL_BLEND;
705 root 1.10 glEnable GL_TEXTURE_2D;
706 root 1.30 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
707 root 1.28 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
708 root 1.10
709 root 1.62 glColor @{$self->{color}};
710 root 1.12
711 root 1.56 $tex->draw_quad (0, 0);
712 root 1.10
713 root 1.12 glDisable GL_BLEND;
714 root 1.10 glDisable GL_TEXTURE_2D;
715     }
716    
717 root 1.39 #############################################################################
718    
719 root 1.60 package CFClient::Widget::Entry;
720 elmex 1.31
721 root 1.60 our @ISA = CFClient::Widget::Label::;
722 elmex 1.31
723     use SDL;
724     use SDL::OpenGL;
725    
726     sub key_down {
727     my ($self, $ev) = @_;
728    
729     my $mod = $ev->key_mod;
730     my $sym = $ev->key_sym;
731    
732     my $uni = $ev->key_unicode;
733    
734     my $text = $self->get_text;
735    
736     if ($sym == SDLK_BACKSPACE) {
737     substr $text, -1, 1, '';
738     } elsif ($uni) {
739     $text .= chr $uni;
740     }
741 root 1.51
742 elmex 1.31 $self->set_text ($text);
743     }
744    
745 root 1.51 sub button_down {
746     my ($self, $ev) = @_;
747    
748     $self->focus_in;
749     }
750    
751 root 1.58 sub mouse_motion {
752     my ($self, $ev, $x, $y) = @_;
753     printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
754     }
755    
756 root 1.51 sub _draw {
757     my ($self) = @_;
758    
759     if ($FOCUS == $self) {
760     glColor 1, 1, 1;
761     } else {
762     glColor 0.7, 0.7, 0.7;
763     }
764    
765     glBegin GL_QUADS;
766     glVertex 0 , 0;
767     glVertex 0 , $self->{h} - 1;
768     glVertex $self->{w} - 1, $self->{h} - 1;
769     glVertex $self->{w} - 1, 0;
770     glEnd;
771    
772     $self->SUPER::_draw;
773     }
774    
775 root 1.39 #############################################################################
776    
777 root 1.60 package CFClient::Widget::MapWidget;
778 root 1.4
779 elmex 1.2 use strict;
780 elmex 1.7
781 root 1.25 use List::Util qw(min max);
782 elmex 1.2
783 root 1.16 use SDL;
784 elmex 1.2 use SDL::OpenGL;
785     use SDL::OpenGL::Constants;
786    
787 root 1.60 our @ISA = CFClient::Widget::;
788 root 1.25
789 elmex 1.2 sub key_down {
790     print "MAPKEYDOWN\n";
791     }
792    
793     sub key_up {
794     }
795    
796 elmex 1.36 sub size_request {
797 root 1.52 (
798     1 + int $::WIDTH / 32,
799     1 + int $::HEIGHT / 32,
800     )
801 elmex 1.36 }
802    
803 elmex 1.11 sub _draw {
804 root 1.21 my ($self) = @_;
805    
806 root 1.25 my $mx = $::CONN->{mapx};
807     my $my = $::CONN->{mapy};
808    
809     my $map = $::CONN->{map};
810    
811     my ($xofs, $yofs);
812    
813     my $sw = 1 + int $::WIDTH / 32;
814     my $sh = 1 + int $::HEIGHT / 32;
815    
816     if ($::CONN->{mapw} > $sw) {
817 root 1.27 $xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
818 root 1.25 } else {
819     $xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
820     }
821    
822     if ($::CONN->{maph} > $sh) {
823 root 1.27 $yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
824 root 1.25 } else {
825     $yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
826     }
827    
828 elmex 1.2 glEnable GL_TEXTURE_2D;
829     glEnable GL_BLEND;
830 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
831    
832     my $sw4 = ($sw + 3) & ~3;
833 root 1.57 my $darkness = "\x00" x ($sw4 * $sh);
834 elmex 1.2
835 root 1.25 for my $x (0 .. $sw - 1) {
836 root 1.57 my $row = $map->[$x + $xofs];
837 root 1.25 for my $y (0 .. $sh - 1) {
838 elmex 1.2
839 root 1.57 my $cell = $row->[$y + $yofs]
840 elmex 1.2 or next;
841    
842 root 1.57 my $dark = $cell->[0];
843     if ($dark < 0) {
844     substr $darkness, $y * $sw4 + $x, 1, chr 224;
845     } else {
846     substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark;
847 root 1.21 }
848 elmex 1.2
849 root 1.21 for my $num (grep $_, @$cell[1,2,3]) {
850 root 1.4 my $tex = $::CONN->{face}[$num]{texture} || next;
851 root 1.56
852 root 1.19 my $w = $tex->{width};
853     my $h = $tex->{height};
854    
855 root 1.57 $tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h);
856 elmex 1.2 }
857     }
858     }
859    
860 root 1.35 # if (1) { # higher quality darkness
861     # $lighting =~ s/(.)/$1$1$1/gs;
862     # my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
863     #
864     # $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear");
865     #
866     # $lighting = $pb->get_pixels;
867     # $lighting =~ s/(.)../$1/gs;
868     # }
869    
870 root 1.57 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
871     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
872    
873 root 1.60 $darkness = new CFClient::Texture
874 root 1.35 width => $sw4,
875     height => $sh,
876 root 1.57 data => $darkness,
877 root 1.52 internalformat => GL_ALPHA,
878 root 1.35 format => GL_ALPHA;
879    
880 root 1.55 glColor 0.45, 0.45, 0.45, 1;
881 root 1.57 $darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32);
882 root 1.35
883 elmex 1.2 glDisable GL_TEXTURE_2D;
884     glDisable GL_BLEND;
885     }
886    
887 root 1.16 my %DIR = (
888     SDLK_KP8, [1, "north"],
889 root 1.18 SDLK_KP9, [2, "northeast"],
890 root 1.16 SDLK_KP6, [3, "east"],
891     SDLK_KP3, [4, "southeast"],
892     SDLK_KP2, [5, "south"],
893     SDLK_KP1, [6, "southwest"],
894     SDLK_KP4, [7, "west"],
895     SDLK_KP7, [8, "northwest"],
896 root 1.18
897     SDLK_UP, [1, "north"],
898     SDLK_RIGHT, [3, "east"],
899     SDLK_DOWN, [5, "south"],
900     SDLK_LEFT, [7, "west"],
901 root 1.16 );
902    
903     sub key_down {
904     my ($self, $ev) = @_;
905    
906     my $mod = $ev->key_mod;
907     my $sym = $ev->key_sym;
908    
909     if ($sym == SDLK_KP5) {
910     $::CONN->send ("command stay fire");
911     } elsif (exists $DIR{$sym}) {
912     if ($mod & KMOD_SHIFT) {
913 root 1.18 $self->{shft}++;
914 root 1.16 $::CONN->send ("command fire $DIR{$sym}[0]");
915     } elsif ($mod & KMOD_CTRL) {
916 root 1.18 $self->{ctrl}++;
917 root 1.16 $::CONN->send ("command run $DIR{$sym}[0]");
918     } else {
919 root 1.18 $::CONN->send ("command $DIR{$sym}[1]");
920 root 1.16 }
921     }
922     }
923    
924     sub key_up {
925     my ($self, $ev) = @_;
926    
927     my $mod = $ev->key_mod;
928     my $sym = $ev->key_sym;
929    
930 root 1.18 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
931     $::CONN->send ("command fire_stop");
932     }
933     if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
934     $::CONN->send ("command run_stop");
935 root 1.16 }
936     }
937    
938 root 1.39 #############################################################################
939    
940 root 1.60 package CFClient::Widget::Animator;
941 root 1.35
942     use SDL::OpenGL;
943    
944 root 1.60 our @ISA = CFClient::Widget::Bin::;
945 root 1.35
946     sub moveto {
947     my ($self, $x, $y) = @_;
948    
949     $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
950 root 1.56 $self->{speed} = 0.001;
951 root 1.35 $self->{time} = 1;
952    
953     ::animation_start $self;
954     }
955    
956     sub animate {
957     my ($self, $interval) = @_;
958    
959     $self->{time} -= $interval * $self->{speed};
960     if ($self->{time} <= 0) {
961     $self->{time} = 0;
962     ::animation_stop $self;
963     }
964    
965     my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
966    
967     $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
968     $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
969     }
970    
971     sub _draw {
972     my ($self) = @_;
973    
974     glPushMatrix;
975 root 1.51 glRotate $self->{time} * 1000, 0, 1, 0;
976 root 1.38 $self->{children}[0]->draw;
977 root 1.35 glPopMatrix;
978     }
979    
980 root 1.51 #############################################################################
981    
982 root 1.60 package CFClient::Widget::Toplevel;
983 root 1.51
984 root 1.60 our @ISA = CFClient::Widget::Container::;
985 root 1.51
986     sub size_request {
987     ($::WIDTH, $::HEIGHT)
988     }
989    
990     sub size_allocate {
991     my ($self, $w, $h) = @_;
992    
993     $self->SUPER::size_allocate ($w, $h);
994    
995     $_->size_allocate ($_->size_request)
996     for @{$self->{children}};
997     }
998    
999 root 1.58 sub translate {
1000     my ($self, $x, $y) = @_;
1001    
1002     ($x, $y)
1003     }
1004    
1005 root 1.51 sub update {
1006     my ($self) = @_;
1007    
1008     $self->size_allocate ($self->size_request);
1009     ::refresh ();
1010     }
1011    
1012     sub add {
1013     my ($self, $widget) = @_;
1014    
1015     $self->SUPER::add ($widget);
1016    
1017     $widget->size_allocate ($widget->size_request);
1018     }
1019    
1020     sub draw {
1021     my ($self) = @_;
1022    
1023     $self->_draw;
1024     }
1025    
1026     #############################################################################
1027    
1028 root 1.60 package CFClient::Widget;
1029 root 1.51
1030 root 1.60 $TOPLEVEL = new CFClient::Widget::Toplevel;
1031 root 1.51
1032     1
1033 root 1.5