ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.38
Committed: Sun Apr 9 21:34:49 2006 UTC (18 years, 2 months ago) by root
Branch: MAIN
Changes since 1.37: +96 -78 lines
Log Message:
*** empty log message ***

File Contents

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