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