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