ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.65
Committed: Tue Apr 11 14:04:27 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.64: +79 -56 lines
Log Message:
*** empty log message ***

File Contents

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