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