ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.61
Committed: Tue Apr 11 13:17:24 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.60: +1 -1 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 elmex 1.32 $self->render_chld;
312 root 1.42 $self->SUPER::update;
313 elmex 1.20 }
314    
315     sub render_chld {
316     my ($self) = @_;
317    
318     $self->{texture} =
319 root 1.60 CFClient::Texture->new_from_opengl (
320 root 1.42 $self->{w}, $self->{h}, sub { $self->child->draw }
321 elmex 1.20 );
322 elmex 1.36 }
323    
324     sub size_allocate {
325     my ($self, $w, $h) = @_;
326    
327 root 1.42 $self->{w} = $w;
328     $self->{h} = $h;
329    
330     $self->child->size_allocate ($w, $h);
331 elmex 1.36
332 root 1.42 $self->render_chld;
333 elmex 1.20 }
334    
335     sub _draw {
336     my ($self) = @_;
337    
338 elmex 1.36 my ($w, $h) = ($self->w, $self->h);
339 root 1.29
340 elmex 1.20 my $tex = $self->{texture}
341     or return;
342    
343     glEnable GL_BLEND;
344     glEnable GL_TEXTURE_2D;
345 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
346 elmex 1.20
347 root 1.56 $tex->draw_quad (0, 0, $w, $h);
348 elmex 1.20
349     glDisable GL_BLEND;
350     glDisable GL_TEXTURE_2D;
351     }
352    
353 root 1.39 #############################################################################
354    
355 root 1.60 package CFClient::Widget::Frame;
356 elmex 1.15
357 root 1.60 our @ISA = CFClient::Widget::Bin::;
358 elmex 1.15
359     use SDL::OpenGL;
360    
361     sub size_request {
362     my ($self) = @_;
363 root 1.39 my $chld = $self->child
364 elmex 1.15 or return (0, 0);
365 root 1.30
366     $chld->move (2, 2);
367    
368 elmex 1.15 map { $_ + 4 } $chld->size_request;
369     }
370    
371 elmex 1.36 sub size_allocate {
372     my ($self, $w, $h) = @_;
373 root 1.42
374     $self->{w} = $w;
375     $self->{h} = $h;
376 elmex 1.36
377 root 1.39 $self->child->size_allocate ($w - 4, $h - 4);
378     $self->child->move (2, 2);
379 elmex 1.36 }
380    
381 elmex 1.15 sub _draw {
382     my ($self) = @_;
383    
384 root 1.39 my $chld = $self->child;
385 elmex 1.15
386     my ($w, $h) = $chld->size_request;
387    
388     glBegin GL_QUADS;
389 root 1.30 glColor 0, 0, 0;
390 root 1.56 glVertex 0 , 0;
391     glVertex 0 , $h + 4;
392     glVertex $w + 4 , $h + 4;
393     glVertex $w + 4 , 0;
394 elmex 1.15 glEnd;
395    
396 root 1.23 $chld->draw;
397 elmex 1.15 }
398    
399 root 1.39 #############################################################################
400    
401 root 1.60 package CFClient::Widget::FancyFrame;
402 elmex 1.31
403 root 1.60 our @ISA = CFClient::Widget::Bin::;
404 elmex 1.31
405     use SDL::OpenGL;
406    
407 root 1.41 my @tex =
408 root 1.60 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
409 root 1.41 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
410 elmex 1.34
411     sub size_request {
412     my ($self) = @_;
413 root 1.39
414     my ($w, $h) = $self->SUPER::size_request;
415 elmex 1.34
416 root 1.41 $h += $tex[1]->{height};
417     $h += $tex[4]->{height};
418     $w += $tex[2]->{width};
419     $w += $tex[3]->{width};
420 elmex 1.34
421 elmex 1.36 ($w, $h)
422     }
423    
424     sub size_allocate {
425     my ($self, $w, $h) = @_;
426    
427 root 1.40 $self->SUPER::size_allocate ($w, $h);
428    
429 root 1.41 $h -= $tex[1]->{height};
430     $h -= $tex[4]->{height};
431     $w -= $tex[2]->{width};
432     $w -= $tex[3]->{width};
433 elmex 1.36
434     $h = $h < 0 ? 0 : $h;
435     $w = $w < 0 ? 0 : $w;
436 root 1.43
437 root 1.39 $self->child->size_allocate ($w, $h);
438 root 1.43 $self->child->move ($tex[3]->{width}, $tex[1]->{height});
439 elmex 1.34 }
440    
441     sub _draw {
442     my ($self) = @_;
443    
444 root 1.43 my ($w, $h) = ($self->{w}, $self->{h});
445     my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
446 elmex 1.34
447     glEnable GL_BLEND;
448     glEnable GL_TEXTURE_2D;
449     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
450 elmex 1.36 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
451 elmex 1.34
452 root 1.41 my $top = $tex[1];
453 root 1.56 $top->draw_quad (0, 0, $w, $top->{height});
454 elmex 1.34
455 root 1.41 my $left = $tex[3];
456 root 1.56 $left->draw_quad (0, $top->{height}, $left->{width}, $ch);
457 elmex 1.34
458 root 1.41 my $right = $tex[2];
459 root 1.56 $right->draw_quad ($w - $right->{width}, $top->{height}, $right->{width}, $ch);
460 elmex 1.34
461 root 1.41 my $bottom = $tex[4];
462 root 1.56 $bottom->draw_quad (0, $h - $bottom->{height}, $w, $bottom->{height});
463 elmex 1.34
464 root 1.41 my $bg = $tex[0];
465 elmex 1.36 glBindTexture GL_TEXTURE_2D, $bg->{name};
466     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
467     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
468     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
469 elmex 1.34
470 elmex 1.36 my $rep_x = $cw / $bg->{width};
471     my $rep_y = $ch / $bg->{height};
472 elmex 1.34
473 root 1.56 $bg->draw_quad ($left->{width}, $top->{height}, $cw, $ch);
474 elmex 1.34
475     glDisable GL_BLEND;
476     glDisable GL_TEXTURE_2D;
477 elmex 1.36
478 root 1.39 $self->child->draw;
479 elmex 1.36
480 elmex 1.34 }
481 elmex 1.31
482 root 1.39 #############################################################################
483    
484 root 1.60 package CFClient::Widget::Table;
485 elmex 1.15
486 root 1.60 our @ISA = CFClient::Widget::Bin::;
487 elmex 1.15
488     use SDL::OpenGL;
489    
490     sub add {
491     my ($self, $x, $y, $chld) = @_;
492 root 1.38 my $old_chld = $self->{children}[$y][$x];
493 elmex 1.32
494 root 1.38 $self->{children}[$y][$x] = $chld;
495 elmex 1.32 $chld->set_parent ($self);
496     $self->update;
497 elmex 1.15 }
498    
499     sub max_row_height {
500     my ($self, $row) = @_;
501    
502     my $hs = 0;
503 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$row] || []}; $xi++) {
504     my $c = $self->{children}->[$row]->[$xi];
505 elmex 1.17 if ($c) {
506     my ($w, $h) = $c->size_request;
507     if ($hs < $h) { $hs = $h }
508     }
509 elmex 1.15 }
510     return $hs;
511     }
512    
513     sub max_col_width {
514     my ($self, $col) = @_;
515    
516     my $ws = 0;
517 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children} || []}; $yi++) {
518     my $c = ($self->{children}->[$yi] || [])->[$col];
519 elmex 1.17 if ($c) {
520     my ($w, $h) = $c->size_request;
521     if ($ws < $w) { $ws = $w }
522     }
523 elmex 1.15 }
524     return $ws;
525     }
526    
527     sub size_request {
528     my ($self) = @_;
529    
530     my ($hs, $ws) = (0, 0);
531    
532 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
533 elmex 1.15 $hs += $self->max_row_height ($yi);
534     }
535    
536 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
537 elmex 1.15 my $wm = 0;
538 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
539 elmex 1.15 $wm += $self->max_col_width ($xi)
540     }
541     if ($ws < $wm) { $ws = $wm }
542     }
543    
544     return ($ws, $hs);
545     }
546    
547     sub _draw {
548     my ($self) = @_;
549    
550     my $y = 0;
551 root 1.38 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
552 elmex 1.15 my $x = 0;
553    
554 root 1.38 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
555 elmex 1.15
556 root 1.38 my $c = $self->{children}->[$yi]->[$xi];
557 elmex 1.26 if ($c) {
558     $c->move ($x, $y, 0); #TODO: Move to size_request
559     $c->draw if $c;
560     }
561 elmex 1.15
562     $x += $self->max_col_width ($xi);
563     }
564    
565     $y += $self->max_row_height ($yi);
566     }
567     }
568    
569 root 1.39 #############################################################################
570    
571 root 1.60 package CFClient::Widget::VBox;
572 elmex 1.15
573 root 1.60 our @ISA = CFClient::Widget::Container::;
574 elmex 1.15
575     use SDL::OpenGL;
576    
577 root 1.43 sub size_request {
578     my ($self) = @_;
579    
580     my @alloc = map [$_->size_request], @{$self->{children}};
581    
582     (
583     (List::Util::max map $_->[0], @alloc),
584     (List::Util::sum map $_->[1], @alloc),
585     )
586     }
587    
588 elmex 1.36 sub size_allocate {
589     my ($self, $w, $h) = @_;
590    
591     $self->w ($w);
592     $self->h ($h);
593    
594     my $exp;
595     my @oth;
596     # find expand widget
597 root 1.38 for (@{$self->{children}}) {
598 elmex 1.36 if ($_->{expand}) {
599     $exp = $_;
600     last;
601     }
602     push @oth, $_;
603     }
604    
605     my ($ow, $oh);
606    
607     # get sizes of other widgets
608     for (@oth) {
609     my ($w, $h) = $_->size_request;
610     $oh += $h;
611     if ($ow < $w) { $ow = $w }
612     }
613    
614     my $y = 0;
615 root 1.38 for (@{$self->{children}}) {
616 elmex 1.36 $_->move (0, $y);
617    
618     if ($_ == $exp) {
619     $_->size_allocate ($w, $h - $oh);
620     $y += $h - $oh;
621     } else {
622     my ($cw, $h) = $_->size_request;
623     $_->size_allocate ($w, $h);
624     $y += $h;
625     }
626     }
627     }
628    
629 root 1.39 #############################################################################
630    
631 root 1.60 package CFClient::Widget::Label;
632 root 1.10
633 root 1.60 our @ISA = CFClient::Widget::;
634 root 1.12
635 root 1.10 use SDL::OpenGL;
636    
637     sub new {
638 root 1.28 my ($class, $x, $y, $z, $height, $text) = @_;
639 root 1.10
640 root 1.51 $height ||= $::FONTSIZE;
641    
642 root 1.33 # TODO: color, and make height, xyz etc. optional
643 root 1.59 my $self = $class->SUPER::new (
644     x => $x,
645     y => $y,
646     z => $z,
647     height => $height,
648 root 1.61 layout => new CFClient::Layout $height,
649 root 1.59 );
650 root 1.10
651 elmex 1.15 $self->set_text ($text);
652 root 1.10
653     $self
654     }
655    
656 elmex 1.15 sub set_text {
657     my ($self, $text) = @_;
658 root 1.28
659     $self->{text} = $text;
660 root 1.59 $self->{layout}->set_markup ($text);
661 root 1.28
662 root 1.59 delete $self->{texture};
663 elmex 1.15 }
664    
665     sub get_text {
666     my ($self, $text) = @_;
667 root 1.28
668 elmex 1.15 $self->{text}
669     }
670    
671 root 1.14 sub size_request {
672     my ($self) = @_;
673    
674 root 1.59 $self->{layout}->set_width;
675     $self->{layout}->size
676     # if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack
677     # (
678     # $self->{texture}{width},
679     # $self->{texture}{height},
680     # )
681     # } else {
682 root 1.60 # my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height};
683 root 1.59 #
684     # ($w, $h)
685     # }
686     }
687 root 1.51
688 root 1.59 sub size_allocate {
689     my ($self, $w, $h) = @_;
690 root 1.51
691 root 1.59 $self->SUPER::size_allocate ($w, $h);
692     delete $self->{texture};
693 root 1.14 }
694    
695 elmex 1.11 sub _draw {
696 root 1.10 my ($self) = @_;
697    
698 root 1.59 my $tex = $self->{texture} ||= do {
699     $self->{layout}->set_width ($self->{w});
700 root 1.60 new_from_layout CFClient::Texture $self->{layout};
701 root 1.59 };
702 root 1.10
703 root 1.12 glEnable GL_BLEND;
704 root 1.10 glEnable GL_TEXTURE_2D;
705 root 1.30 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
706 root 1.28 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
707 root 1.10
708 elmex 1.36 glColor 1, 0, 0, 1; # TODO color
709 root 1.12
710 root 1.56 $tex->draw_quad (0, 0);
711 root 1.10
712 root 1.12 glDisable GL_BLEND;
713 root 1.10 glDisable GL_TEXTURE_2D;
714     }
715    
716 root 1.39 #############################################################################
717    
718 root 1.60 package CFClient::Widget::Entry;
719 elmex 1.31
720 root 1.60 our @ISA = CFClient::Widget::Label::;
721 elmex 1.31
722     use SDL;
723     use SDL::OpenGL;
724    
725     sub key_down {
726     my ($self, $ev) = @_;
727    
728     my $mod = $ev->key_mod;
729     my $sym = $ev->key_sym;
730    
731     my $uni = $ev->key_unicode;
732    
733     my $text = $self->get_text;
734    
735     if ($sym == SDLK_BACKSPACE) {
736     substr $text, -1, 1, '';
737     } elsif ($uni) {
738     $text .= chr $uni;
739     }
740 root 1.51
741 elmex 1.31 $self->set_text ($text);
742     }
743    
744 root 1.51 sub button_down {
745     my ($self, $ev) = @_;
746    
747     $self->focus_in;
748     }
749    
750 root 1.58 sub mouse_motion {
751     my ($self, $ev, $x, $y) = @_;
752     printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
753     }
754    
755 root 1.51 sub _draw {
756     my ($self) = @_;
757    
758     if ($FOCUS == $self) {
759     glColor 1, 1, 1;
760     } else {
761     glColor 0.7, 0.7, 0.7;
762     }
763    
764     glBegin GL_QUADS;
765     glVertex 0 , 0;
766     glVertex 0 , $self->{h} - 1;
767     glVertex $self->{w} - 1, $self->{h} - 1;
768     glVertex $self->{w} - 1, 0;
769     glEnd;
770    
771     $self->SUPER::_draw;
772     }
773    
774 root 1.39 #############################################################################
775    
776 root 1.60 package CFClient::Widget::MapWidget;
777 root 1.4
778 elmex 1.2 use strict;
779 elmex 1.7
780 root 1.25 use List::Util qw(min max);
781 elmex 1.2
782 root 1.16 use SDL;
783 elmex 1.2 use SDL::OpenGL;
784     use SDL::OpenGL::Constants;
785    
786 root 1.60 our @ISA = CFClient::Widget::;
787 root 1.25
788 elmex 1.2 sub key_down {
789     print "MAPKEYDOWN\n";
790     }
791    
792     sub key_up {
793     }
794    
795 elmex 1.36 sub size_request {
796 root 1.52 (
797     1 + int $::WIDTH / 32,
798     1 + int $::HEIGHT / 32,
799     )
800 elmex 1.36 }
801    
802 elmex 1.11 sub _draw {
803 root 1.21 my ($self) = @_;
804    
805 root 1.25 my $mx = $::CONN->{mapx};
806     my $my = $::CONN->{mapy};
807    
808     my $map = $::CONN->{map};
809    
810     my ($xofs, $yofs);
811    
812     my $sw = 1 + int $::WIDTH / 32;
813     my $sh = 1 + int $::HEIGHT / 32;
814    
815     if ($::CONN->{mapw} > $sw) {
816 root 1.27 $xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
817 root 1.25 } else {
818     $xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
819     }
820    
821     if ($::CONN->{maph} > $sh) {
822 root 1.27 $yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
823 root 1.25 } else {
824     $yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
825     }
826    
827 elmex 1.2 glEnable GL_TEXTURE_2D;
828     glEnable GL_BLEND;
829 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
830    
831     my $sw4 = ($sw + 3) & ~3;
832 root 1.57 my $darkness = "\x00" x ($sw4 * $sh);
833 elmex 1.2
834 root 1.25 for my $x (0 .. $sw - 1) {
835 root 1.57 my $row = $map->[$x + $xofs];
836 root 1.25 for my $y (0 .. $sh - 1) {
837 elmex 1.2
838 root 1.57 my $cell = $row->[$y + $yofs]
839 elmex 1.2 or next;
840    
841 root 1.57 my $dark = $cell->[0];
842     if ($dark < 0) {
843     substr $darkness, $y * $sw4 + $x, 1, chr 224;
844     } else {
845     substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark;
846 root 1.21 }
847 elmex 1.2
848 root 1.21 for my $num (grep $_, @$cell[1,2,3]) {
849 root 1.4 my $tex = $::CONN->{face}[$num]{texture} || next;
850 root 1.56
851 root 1.19 my $w = $tex->{width};
852     my $h = $tex->{height};
853    
854 root 1.57 $tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h);
855 elmex 1.2 }
856     }
857     }
858    
859 root 1.35 # if (1) { # higher quality darkness
860     # $lighting =~ s/(.)/$1$1$1/gs;
861     # my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
862     #
863     # $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear");
864     #
865     # $lighting = $pb->get_pixels;
866     # $lighting =~ s/(.)../$1/gs;
867     # }
868    
869 root 1.57 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
870     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
871    
872 root 1.60 $darkness = new CFClient::Texture
873 root 1.35 width => $sw4,
874     height => $sh,
875 root 1.57 data => $darkness,
876 root 1.52 internalformat => GL_ALPHA,
877 root 1.35 format => GL_ALPHA;
878    
879 root 1.55 glColor 0.45, 0.45, 0.45, 1;
880 root 1.57 $darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32);
881 root 1.35
882 elmex 1.2 glDisable GL_TEXTURE_2D;
883     glDisable GL_BLEND;
884     }
885    
886 root 1.16 my %DIR = (
887     SDLK_KP8, [1, "north"],
888 root 1.18 SDLK_KP9, [2, "northeast"],
889 root 1.16 SDLK_KP6, [3, "east"],
890     SDLK_KP3, [4, "southeast"],
891     SDLK_KP2, [5, "south"],
892     SDLK_KP1, [6, "southwest"],
893     SDLK_KP4, [7, "west"],
894     SDLK_KP7, [8, "northwest"],
895 root 1.18
896     SDLK_UP, [1, "north"],
897     SDLK_RIGHT, [3, "east"],
898     SDLK_DOWN, [5, "south"],
899     SDLK_LEFT, [7, "west"],
900 root 1.16 );
901    
902     sub key_down {
903     my ($self, $ev) = @_;
904    
905     my $mod = $ev->key_mod;
906     my $sym = $ev->key_sym;
907    
908     if ($sym == SDLK_KP5) {
909     $::CONN->send ("command stay fire");
910     } elsif (exists $DIR{$sym}) {
911     if ($mod & KMOD_SHIFT) {
912 root 1.18 $self->{shft}++;
913 root 1.16 $::CONN->send ("command fire $DIR{$sym}[0]");
914     } elsif ($mod & KMOD_CTRL) {
915 root 1.18 $self->{ctrl}++;
916 root 1.16 $::CONN->send ("command run $DIR{$sym}[0]");
917     } else {
918 root 1.18 $::CONN->send ("command $DIR{$sym}[1]");
919 root 1.16 }
920     }
921     }
922    
923     sub key_up {
924     my ($self, $ev) = @_;
925    
926     my $mod = $ev->key_mod;
927     my $sym = $ev->key_sym;
928    
929 root 1.18 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
930     $::CONN->send ("command fire_stop");
931     }
932     if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
933     $::CONN->send ("command run_stop");
934 root 1.16 }
935     }
936    
937 root 1.39 #############################################################################
938    
939 root 1.60 package CFClient::Widget::Animator;
940 root 1.35
941     use SDL::OpenGL;
942    
943 root 1.60 our @ISA = CFClient::Widget::Bin::;
944 root 1.35
945     sub moveto {
946     my ($self, $x, $y) = @_;
947    
948     $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
949 root 1.56 $self->{speed} = 0.001;
950 root 1.35 $self->{time} = 1;
951    
952     ::animation_start $self;
953     }
954    
955     sub animate {
956     my ($self, $interval) = @_;
957    
958     $self->{time} -= $interval * $self->{speed};
959     if ($self->{time} <= 0) {
960     $self->{time} = 0;
961     ::animation_stop $self;
962     }
963    
964     my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
965    
966     $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
967     $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
968     }
969    
970     sub _draw {
971     my ($self) = @_;
972    
973     glPushMatrix;
974 root 1.51 glRotate $self->{time} * 1000, 0, 1, 0;
975 root 1.38 $self->{children}[0]->draw;
976 root 1.35 glPopMatrix;
977     }
978    
979 root 1.51 #############################################################################
980    
981 root 1.60 package CFClient::Widget::Toplevel;
982 root 1.51
983 root 1.60 our @ISA = CFClient::Widget::Container::;
984 root 1.51
985     sub size_request {
986     ($::WIDTH, $::HEIGHT)
987     }
988    
989     sub size_allocate {
990     my ($self, $w, $h) = @_;
991    
992     $self->SUPER::size_allocate ($w, $h);
993    
994     $_->size_allocate ($_->size_request)
995     for @{$self->{children}};
996     }
997    
998 root 1.58 sub translate {
999     my ($self, $x, $y) = @_;
1000    
1001     ($x, $y)
1002     }
1003    
1004 root 1.51 sub update {
1005     my ($self) = @_;
1006    
1007     $self->size_allocate ($self->size_request);
1008     ::refresh ();
1009     }
1010    
1011     sub add {
1012     my ($self, $widget) = @_;
1013    
1014     $self->SUPER::add ($widget);
1015    
1016     $widget->size_allocate ($widget->size_request);
1017     }
1018    
1019     sub draw {
1020     my ($self) = @_;
1021    
1022     $self->_draw;
1023     }
1024    
1025     #############################################################################
1026    
1027 root 1.60 package CFClient::Widget;
1028 root 1.51
1029 root 1.60 $TOPLEVEL = new CFClient::Widget::Toplevel;
1030 root 1.51
1031     1
1032 root 1.5