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