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