ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.143
Committed: Thu Apr 20 21:28:51 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.142: +4 -6 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.73 package CFClient::UI;
2 root 1.8
3 elmex 1.1 use strict;
4 root 1.18
5 root 1.74 use Scalar::Util ();
6     use List::Util ();
7 root 1.18
8 root 1.60 use CFClient;
9 root 1.41
10 root 1.51 our ($FOCUS, $HOVER, $GRAB); # various widgets
11    
12 root 1.113 our $ROOT;
13 root 1.51 our $BUTTON_STATE;
14    
15 elmex 1.1 # class methods for events
16 root 1.51 sub feed_sdl_key_down_event {
17     $FOCUS->key_down ($_[0]) if $FOCUS;
18     }
19    
20     sub feed_sdl_key_up_event {
21     $FOCUS->key_up ($_[0]) if $FOCUS;
22     }
23    
24     sub feed_sdl_button_down_event {
25     my ($ev) = @_;
26 root 1.137 my ($x, $y) = ($ev->{x}, $ev->{y});
27 root 1.51
28     if (!$BUTTON_STATE) {
29 root 1.113 my $widget = $ROOT->find_widget ($x, $y);
30 root 1.51
31     $GRAB = $widget;
32     $GRAB->update if $GRAB;
33     }
34    
35 root 1.137 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
36 root 1.51
37 root 1.113 $GRAB->button_down ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;
38 root 1.51 }
39    
40     sub feed_sdl_button_up_event {
41     my ($ev) = @_;
42 root 1.137 my ($x, $y) = ($ev->{x}, $ev->{y});
43 root 1.51
44 root 1.113 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
45 root 1.51
46 root 1.137 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
47 root 1.51
48 root 1.113 $GRAB->button_up ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;
49 root 1.58
50 root 1.51 if (!$BUTTON_STATE) {
51     my $grab = $GRAB; undef $GRAB;
52     $grab->update if $grab;
53     $GRAB->update if $GRAB;
54     }
55     }
56    
57     sub feed_sdl_motion_event {
58     my ($ev) = @_;
59 root 1.137 my ($x, $y) = ($ev->{x}, $ev->{y});
60 root 1.51
61 root 1.113 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
62 root 1.51
63     if ($widget != $HOVER) {
64     my $hover = $HOVER; $HOVER = $widget;
65    
66 root 1.105 $hover->update if $hover && $hover->{can_hover};
67     $HOVER->update if $HOVER && $HOVER->{can_hover};
68 root 1.51 }
69    
70 root 1.113 $HOVER->mouse_motion ($ev, $HOVER->coord2local ($x, $y)) if $HOVER;
71 root 1.51 }
72 elmex 1.1
73 root 1.112 # convert position array to integers
74     sub harmonize {
75     my ($vals) = @_;
76    
77     my $rem = 0;
78    
79 root 1.116 for (@$vals) {
80 root 1.112 my $i = int $_ + $rem;
81     $rem += $_ - $i;
82     $_ = $i;
83     }
84     }
85    
86 root 1.73 #############################################################################
87    
88     package CFClient::UI::Base;
89    
90     use strict;
91    
92 root 1.138 use CFClient::OpenGL;
93 root 1.73
94 elmex 1.1 sub new {
95     my $class = shift;
96 root 1.10
97 root 1.79 my $self = bless {
98 root 1.65 x => 0,
99     y => 0,
100     z => 0,
101     @_
102 root 1.79 }, $class;
103    
104     for (keys %$self) {
105     if (/^connect_(.*)$/) {
106     $self->connect ($1 => delete $self->{$_});
107     }
108     }
109    
110     $self
111 elmex 1.1 }
112    
113 root 1.134 sub show {
114     my ($self) = @_;
115    
116     return if $self->{parent};
117    
118     $CFClient::UI::ROOT->add ($self);
119     }
120    
121     sub hide {
122     my ($self) = @_;
123    
124     return unless $self->{parent};
125    
126     $self->{parent}->remove ($self);
127     }
128    
129 root 1.18 sub move {
130     my ($self, $x, $y, $z) = @_;
131 root 1.128
132 root 1.117 $self->{x} = int $x;
133     $self->{y} = int $y;
134 root 1.18 $self->{z} = $z if defined $z;
135 root 1.128
136     $self->update;
137 root 1.18 }
138    
139 elmex 1.20 sub needs_redraw {
140     0
141     }
142    
143 root 1.14 sub size_request {
144 elmex 1.36 require Carp;
145     Carp::confess "size_request is abtract";
146     }
147    
148 root 1.128 sub configure {
149 root 1.75 my ($self, $x, $y, $w, $h) = @_;
150    
151 root 1.141 if ($self->{aspect}) {
152     my $w2 = List::Util::min $w, int $h * $self->{aspect};
153     my $h2 = List::Util::min $h, int $w / $self->{aspect};
154    
155     # use alignment to adjust x, y
156 root 1.75
157 root 1.141 $x += ($w - $w2) * 0.5;
158     $y += ($h - $h2) * 0.5;
159    
160     ($w, $h) = ($w2, $h2);
161 root 1.140 }
162    
163 root 1.141 if ($self->{x} != $x || $self->{y} != $y) {
164     $self->{x} = $x;
165     $self->{y} = $y;
166     $self->update;
167     }
168 root 1.40
169 root 1.141 if ($self->{w} != $w || $self->{h} != $h) {
170     $self->{w} = $w;
171     $self->{h} = $h;
172 root 1.75
173 root 1.141 $self->size_allocate ($w, $h);
174     $self->update;
175     }
176 root 1.75 }
177    
178     sub size_allocate {
179 root 1.128 # nothing to be done
180 root 1.14 }
181    
182 root 1.113 # return top left coordinates
183     sub _topleft {
184     my ($self, $x, $y) = @_;
185    
186     $self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});
187     }
188    
189 root 1.82 # translate global coordinates to local coordinate system
190 root 1.113 sub coord2local {
191 root 1.58 my ($self, $x, $y) = @_;
192    
193 root 1.113 my ($X, $Y) = $self->_topleft;
194     ($x - $X, $y - $Y)
195     }
196    
197     # translate local coordinates to global coordinate system
198     sub coord2global {
199     my ($self, $x, $y) = @_;
200    
201     my ($X, $Y) = $self->_topleft;
202     ($x + $X, $y + $Y)
203 root 1.58 }
204    
205 elmex 1.1 sub focus_in {
206 root 1.51 my ($self) = @_;
207    
208 root 1.68 return if $FOCUS == $self;
209 root 1.97 return unless $self->{can_focus};
210 root 1.68
211 root 1.51 my $focus = $FOCUS; $FOCUS = $self;
212 elmex 1.120
213     $self->emit (focus_in => $focus);
214    
215 root 1.51 $focus->update if $focus;
216     $FOCUS->update;
217 elmex 1.1 }
218 root 1.4
219 elmex 1.1 sub focus_out {
220 root 1.51 my ($self) = @_;
221 root 1.4
222 root 1.51 return unless $FOCUS == $self;
223 root 1.4
224 root 1.51 my $focus = $FOCUS; undef $FOCUS;
225 elmex 1.120
226     $self->emit (focus_out => $focus);
227    
228 root 1.51 $focus->update if $focus; #?
229 elmex 1.1 }
230 root 1.4
231 root 1.51 sub mouse_motion { }
232     sub button_up { }
233     sub key_down { }
234     sub key_up { }
235    
236 root 1.68 sub button_down {
237     my ($self, $ev, $x, $y) = @_;
238    
239     $self->focus_in;
240     }
241    
242 root 1.51 sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
243     sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
244     sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
245     sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
246     sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
247 elmex 1.11
248 elmex 1.1 sub draw {
249 elmex 1.11 my ($self) = @_;
250    
251 root 1.68 return unless $self->{h} && $self->{w};
252    
253 elmex 1.11 glPushMatrix;
254 root 1.12 glTranslate $self->{x}, $self->{y}, 0;
255 elmex 1.11 $self->_draw;
256 root 1.72 glPopMatrix;
257    
258 root 1.97 if ($self == $HOVER && $self->{can_hover}) {
259 root 1.73 my ($x, $y) = @$self{qw(x y)};
260 root 1.72
261 root 1.122 glColor 1, 0.8, 0.5, 0.2;
262 root 1.50 glEnable GL_BLEND;
263 root 1.74 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
264 root 1.48 glBegin GL_QUADS;
265 root 1.72 glVertex $x , $y;
266     glVertex $x + $self->{w}, $y;
267     glVertex $x + $self->{w}, $y + $self->{h};
268     glVertex $x , $y + $self->{h};
269 root 1.47 glEnd;
270 root 1.50 glDisable GL_BLEND;
271 root 1.47 }
272 elmex 1.11 }
273    
274     sub _draw {
275 root 1.38 my ($self) = @_;
276    
277     warn "no draw defined for $self\n";
278 elmex 1.1 }
279 root 1.4
280 root 1.38 sub find_widget {
281     my ($self, $x, $y) = @_;
282    
283     return $self
284     if $x >= $self->{x} && $x < $self->{x} + $self->{w}
285     && $y >= $self->{y} && $y < $self->{y} + $self->{h};
286    
287     ()
288     }
289    
290 elmex 1.32 sub set_parent {
291 root 1.113 my ($self, $parent) = @_;
292 elmex 1.32
293 root 1.113 Scalar::Util::weaken ($self->{parent} = $parent);
294 elmex 1.32 }
295    
296 root 1.125 sub check_size {
297     my ($self) = @_;
298    
299     my ($w, $h) = $self->size_request;
300    
301     if ($w != $self->{req_w} || $h != $self->{req_h}) {
302     $self->{req_w} = $w;
303     $self->{req_h} = $h;
304    
305     $self->{parent}->check_size
306     if $self->{parent};
307     }
308     }
309    
310 elmex 1.32 sub update {
311     my ($self) = @_;
312    
313     $self->{parent}->update
314     if $self->{parent};
315 elmex 1.1 }
316 elmex 1.2
317 root 1.72 sub connect {
318     my ($self, $signal, $cb) = @_;
319    
320 root 1.133 push @{ $self->{signal_cb}{$signal} }, $cb;
321 root 1.72 }
322    
323     sub emit {
324     my ($self, $signal, @args) = @_;
325    
326 root 1.133 for my $cb (@{$self->{signal_cb}{$signal} || []}) {
327     $cb->($self, @args);
328     }
329 root 1.72 }
330    
331 root 1.18 sub DESTROY {
332     my ($self) = @_;
333    
334 elmex 1.32 #$self->deactivate;
335 root 1.18 }
336    
337 root 1.39 #############################################################################
338    
339 root 1.73 package CFClient::UI::DrawBG;
340 root 1.68
341 root 1.73 our @ISA = CFClient::UI::Base::;
342 root 1.68
343     use strict;
344 root 1.138 use CFClient::OpenGL;
345 root 1.68
346     sub new {
347     my $class = shift;
348    
349     # range [value, low, high, page]
350    
351     $class->SUPER::new (
352 root 1.76 bg => [0, 0, 0, 0.2],
353 root 1.79 active_bg => [1, 1, 1, 0.5],
354 root 1.68 @_
355     )
356     }
357    
358     sub _draw {
359     my ($self) = @_;
360    
361     my ($w, $h) = @$self{qw(w h)};
362    
363 root 1.76 glEnable GL_BLEND;
364     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
365 root 1.68 glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };
366 root 1.76
367 root 1.68 glBegin GL_QUADS;
368     glVertex 0 , 0;
369     glVertex 0 , $h;
370     glVertex $w, $h;
371     glVertex $w, 0;
372     glEnd;
373 root 1.76
374     glDisable GL_BLEND;
375 root 1.68 }
376    
377     #############################################################################
378    
379 root 1.73 package CFClient::UI::Empty;
380 root 1.66
381 root 1.73 our @ISA = CFClient::UI::Base::;
382 root 1.66
383     sub size_request {
384     (0, 0)
385     }
386    
387 root 1.67 sub draw { }
388 root 1.66
389     #############################################################################
390    
391 root 1.73 package CFClient::UI::Container;
392 elmex 1.15
393 root 1.73 our @ISA = CFClient::UI::Base::;
394 elmex 1.15
395 root 1.38 sub new {
396 root 1.64 my ($class, %arg) = @_;
397    
398     my $children = delete $arg{children} || [];
399 root 1.38
400 root 1.65 my $self = $class->SUPER::new (children => [], %arg);
401 root 1.64 $self->add ($_) for @$children;
402 root 1.38
403     $self
404     }
405    
406     sub add {
407 root 1.113 my ($self, $child) = @_;
408    
409     $child->set_parent ($self);
410 root 1.38
411 root 1.113 use sort 'stable';
412 root 1.38
413 root 1.66 $self->{children} = [
414 root 1.38 sort { $a->{z} <=> $b->{z} }
415 root 1.113 @{$self->{children}}, $child
416 root 1.66 ];
417 root 1.38
418 root 1.126 $child->check_size;
419 root 1.38 }
420 root 1.35
421 elmex 1.32 sub remove {
422 root 1.134 my ($self, $child) = @_;
423    
424     delete $child->{parent};
425 root 1.38
426 root 1.134 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
427 root 1.38
428 root 1.125 $self->check_size;
429 root 1.38 }
430    
431     sub find_widget {
432     my ($self, $x, $y) = @_;
433    
434 root 1.45 $x -= $self->{x};
435     $y -= $self->{y};
436    
437 root 1.38 my $res;
438    
439 root 1.46 for (reverse @{ $self->{children} }) {
440 root 1.45 $res = $_->find_widget ($x, $y)
441 root 1.38 and return $res;
442     }
443    
444 root 1.46 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
445 elmex 1.32 }
446 elmex 1.15
447 root 1.35 sub _draw {
448     my ($self) = @_;
449    
450 root 1.38 $_->draw for @{$self->{children}};
451 root 1.35 }
452 elmex 1.15
453 root 1.39 #############################################################################
454    
455 root 1.73 package CFClient::UI::Bin;
456 elmex 1.32
457 root 1.73 our @ISA = CFClient::UI::Container::;
458 elmex 1.32
459 root 1.66 sub new {
460     my ($class, %arg) = @_;
461    
462 root 1.73 my $child = (delete $arg{child}) || new CFClient::UI::Empty::;
463 root 1.66
464     $class->SUPER::new (children => [$child], %arg)
465     }
466    
467     sub add {
468 root 1.134 my ($self, $child) = @_;
469 root 1.66
470     $self->{children} = [];
471    
472 root 1.134 $self->SUPER::add ($child);
473 root 1.66 }
474    
475     sub remove {
476     my ($self, $widget) = @_;
477    
478     $self->SUPER::remove ($widget);
479    
480 root 1.73 $self->{children} = [new CFClient::UI::Empty]
481 root 1.66 unless @{$self->{children}};
482     }
483    
484 root 1.39 sub child { $_[0]->{children}[0] }
485 elmex 1.32
486 root 1.38 sub size_request {
487 root 1.68 $_[0]{children}[0]->size_request
488 root 1.38 }
489 elmex 1.32
490 root 1.38 sub size_allocate {
491 root 1.128 my ($self, $w, $h) = @_;
492 root 1.42
493 root 1.128 $self->{children}[0]->configure (0, 0, $w, $h);
494 root 1.38 }
495 elmex 1.32
496 root 1.39 #############################################################################
497    
498 root 1.73 package CFClient::UI::Window;
499 elmex 1.20
500 root 1.73 our @ISA = CFClient::UI::Bin::;
501 elmex 1.20
502 root 1.138 use CFClient::OpenGL;
503 elmex 1.20
504 root 1.42 sub new {
505 root 1.64 my ($class, %arg) = @_;
506 elmex 1.32
507 root 1.64 my $self = $class->SUPER::new (%arg);
508 elmex 1.32 }
509    
510     sub update {
511     my ($self) = @_;
512 root 1.42
513 root 1.63 # we want to do this delayed...
514 elmex 1.32 $self->render_chld;
515 root 1.42 $self->SUPER::update;
516 elmex 1.20 }
517    
518     sub render_chld {
519     my ($self) = @_;
520    
521 root 1.105 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
522     glClearColor 0, 0, 0, 1;
523     glClear GL_COLOR_BUFFER_BIT;
524     $self->child->draw;
525     };
526 elmex 1.36 }
527    
528     sub size_allocate {
529 root 1.128 my ($self, $w, $h) = @_;
530 elmex 1.36
531 root 1.128 $self->child->configure (0, 0, $w, $h);
532 elmex 1.36
533 root 1.42 $self->render_chld;
534 elmex 1.20 }
535    
536     sub _draw {
537     my ($self) = @_;
538    
539 elmex 1.36 my ($w, $h) = ($self->w, $self->h);
540 root 1.29
541 elmex 1.20 my $tex = $self->{texture}
542     or return;
543    
544     glEnable GL_BLEND;
545 root 1.74 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
546 elmex 1.20 glEnable GL_TEXTURE_2D;
547 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
548 elmex 1.20
549 root 1.56 $tex->draw_quad (0, 0, $w, $h);
550 elmex 1.20
551     glDisable GL_BLEND;
552     glDisable GL_TEXTURE_2D;
553     }
554    
555 root 1.39 #############################################################################
556    
557 root 1.125 package CFClient::UI::ViewPort;
558    
559     our @ISA = CFClient::UI::Window::;
560    
561     sub new { die }
562    
563     sub size_request {
564     my ($self) = @_;
565    
566     @$self{qw(child_w child_h)} = $self->child->size_request;
567     $self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
568    
569     @$self{qw(child_w child_h)}
570     }
571    
572     sub _draw {
573     my ($self) = @_;
574    
575     $self->{children}[1]->draw;
576     }
577    
578    
579     #############################################################################
580    
581 root 1.73 package CFClient::UI::Frame;
582 elmex 1.15
583 root 1.73 our @ISA = CFClient::UI::Bin::;
584 elmex 1.15
585 root 1.138 use CFClient::OpenGL;
586 elmex 1.15
587     sub size_request {
588     my ($self) = @_;
589 root 1.39 my $chld = $self->child
590 elmex 1.15 or return (0, 0);
591 root 1.30
592     $chld->move (2, 2);
593    
594 elmex 1.15 map { $_ + 4 } $chld->size_request;
595     }
596    
597 elmex 1.36 sub size_allocate {
598 root 1.75 my ($self, $x, $y, $w, $h) = @_;
599 root 1.42
600 root 1.128 $self->child->configure (2, 2, $w - 4, $h - 4);
601 elmex 1.36 }
602    
603 elmex 1.15 sub _draw {
604     my ($self) = @_;
605    
606 root 1.39 my $chld = $self->child;
607 elmex 1.15
608     my ($w, $h) = $chld->size_request;
609    
610     glBegin GL_QUADS;
611 root 1.30 glColor 0, 0, 0;
612 root 1.56 glVertex 0 , 0;
613     glVertex 0 , $h + 4;
614     glVertex $w + 4 , $h + 4;
615     glVertex $w + 4 , 0;
616 elmex 1.15 glEnd;
617    
618 root 1.23 $chld->draw;
619 elmex 1.15 }
620    
621 root 1.39 #############################################################################
622    
623 root 1.73 package CFClient::UI::FancyFrame;
624 elmex 1.31
625 root 1.73 our @ISA = CFClient::UI::Bin::;
626 elmex 1.31
627 root 1.138 use CFClient::OpenGL;
628 elmex 1.31
629 root 1.41 my @tex =
630 root 1.60 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
631 root 1.41 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
632 elmex 1.34
633 root 1.97 sub new {
634     my $class = shift;
635    
636     # TODO: user_x, user_y, overwrite moveto?
637    
638 root 1.141 my $self = $class->SUPER::new (
639 root 1.97 bg => [1, 1, 1, 1],
640     border_bg => [1, 1, 1, 1],
641 root 1.134 border => 0.8,
642 root 1.97 @_
643 root 1.141 );
644    
645     $self->{title} &&= new CFClient::UI::Label
646     align => 0,
647     valign => 1,
648     text => $self->{title},
649     fontsize => 1;
650    
651     $self
652 root 1.97 }
653    
654 root 1.134 sub border {
655     int $_[0]{border} * $::FONTSIZE
656     }
657    
658 elmex 1.34 sub size_request {
659     my ($self) = @_;
660 root 1.39
661 root 1.78 return ($self->{user_w}, $self->{user_h}) if $self->{user_w} && $self->{user_h};
662    
663     my ($w, $h) = $self->SUPER::size_request;
664 elmex 1.34
665 root 1.97 (
666 root 1.134 $w + $self->border * 2,
667     $h + $self->border * 2,
668 root 1.97 )
669 elmex 1.36 }
670    
671     sub size_allocate {
672 root 1.128 my ($self, $w, $h) = @_;
673 root 1.40
674 root 1.134 $h -= List::Util::max 0, $self->border * 2;
675     $w -= List::Util::max 0, $self->border * 2;
676 elmex 1.36
677 root 1.141 $self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)
678     if $self->{title};
679    
680 root 1.134 $self->child->configure ($self->border, $self->border, $w, $h);
681 elmex 1.34 }
682    
683 root 1.77 sub button_down {
684     my ($self, $ev, $x, $y) = @_;
685    
686 root 1.134 my $border = $self->border;
687    
688     if ($x < $self->{w} && $x >= $self->{w} - $border
689     && $y < $self->{h} && $y >= $self->{h} - $border) {
690 root 1.77
691 root 1.139 my ($ox, $oy) = ($ev->{x}, $ev->{y});
692 root 1.77 my ($bw, $bh) = ($self->{w}, $self->{h});
693    
694     $self->{motion} = sub {
695     my ($ev, $x, $y) = @_;
696    
697 root 1.139 ($x, $y) = ($ev->{x}, $ev->{y});
698 root 1.77
699     $self->{user_w} = $bw + $x - $ox;
700     $self->{user_h} = $bh + $y - $oy;
701 root 1.128 $self->check_size;
702 root 1.77 };
703    
704     } elsif ($x >= 0 && $x < $self->{w}
705 root 1.134 && $y >= 0 && $y < $border) {
706 root 1.77
707 root 1.139 my ($ox, $oy) = ($ev->{x}, $ev->{y});
708 root 1.77 my ($bx, $by) = ($self->{x}, $self->{y});
709    
710     $self->{motion} = sub {
711     my ($ev, $x, $y) = @_;
712    
713 root 1.139 ($x, $y) = ($ev->{x}, $ev->{y});
714 root 1.77
715     $self->move ($bx + $x - $ox, $by + $y - $oy);
716     $self->update;
717     };
718     }
719     }
720    
721     sub button_up {
722     my ($self, $ev, $x, $y) = @_;
723    
724     delete $self->{motion};
725     }
726    
727     sub mouse_motion {
728     my ($self, $ev, $x, $y) = @_;
729    
730     $self->{motion}->($ev, $x, $y) if $self->{motion};
731     }
732    
733 elmex 1.34 sub _draw {
734     my ($self) = @_;
735    
736 root 1.97 my ($w, $h ) = ($self->{w}, $self->{h});
737 root 1.43 my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
738 elmex 1.34
739     glEnable GL_BLEND;
740 root 1.74 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
741 elmex 1.34 glEnable GL_TEXTURE_2D;
742 root 1.97 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
743 elmex 1.34
744 root 1.134 my $border = $self->border;
745    
746 root 1.97 glColor @{ $self->{border_bg} };
747 root 1.134 $tex[1]->draw_quad (0, 0, $w, $border);
748     $tex[3]->draw_quad (0, $border, $border, $ch);
749     $tex[2]->draw_quad ($w - $border, $border, $border, $ch);
750     $tex[4]->draw_quad (0, $h - $border, $w, $border);
751 elmex 1.34
752 root 1.41 my $bg = $tex[0];
753 root 1.76
754 root 1.97 # TODO: repeat texture not scale
755 root 1.72 my $rep_x = $cw / $bg->{w};
756     my $rep_y = $ch / $bg->{h};
757 elmex 1.34
758 root 1.97 glColor @{ $self->{bg} };
759 elmex 1.100
760     $bg->{s} = $rep_x;
761     $bg->{t} = $rep_y;
762     $bg->{wrap_mode} = 1;
763 root 1.134 $bg->draw_quad ($border, $border, $cw, $ch);
764 elmex 1.34
765 root 1.76 glDisable GL_TEXTURE_2D;
766 elmex 1.34 glDisable GL_BLEND;
767 elmex 1.36
768 root 1.141 $self->{title}->draw if $self->{title};
769 root 1.39 $self->child->draw;
770 elmex 1.34 }
771 elmex 1.31
772 root 1.39 #############################################################################
773    
774 root 1.73 package CFClient::UI::Table;
775 elmex 1.15
776 root 1.73 our @ISA = CFClient::UI::Base::;
777 elmex 1.15
778 root 1.75 use List::Util qw(max sum);
779    
780 root 1.138 use CFClient::OpenGL;
781 elmex 1.15
782 root 1.78 sub new {
783     my $class = shift;
784    
785     $class->SUPER::new (
786     col_expand => [],
787     @_
788     )
789     }
790    
791 elmex 1.15 sub add {
792 root 1.113 my ($self, $x, $y, $child) = @_;
793 elmex 1.32
794 root 1.113 $child->set_parent ($self);
795     $self->{children}[$y][$x] = $child;
796 root 1.75
797 root 1.126 $child->check_size;
798 elmex 1.15 }
799    
800 root 1.115 # TODO: move to container class maybe? send childs a signal on removal?
801     sub clear {
802     my ($self) = @_;
803    
804     delete $self->{children};
805     $self->update;
806     }
807    
808 root 1.75 sub get_wh {
809     my ($self) = @_;
810    
811     my (@w, @h);
812 elmex 1.15
813 root 1.75 for my $y (0 .. $#{$self->{children}}) {
814     my $row = $self->{children}[$y]
815     or next;
816 elmex 1.15
817 root 1.75 for my $x (0 .. $#$row) {
818     my $widget = $row->[$x]
819     or next;
820     my ($w, $h) = $widget->size_request;
821 elmex 1.15
822 root 1.75 $w[$x] = max $w[$x], $w;
823     $h[$y] = max $h[$y], $h;
824 elmex 1.17 }
825 elmex 1.15 }
826 root 1.75
827     (\@w, \@h)
828 elmex 1.15 }
829    
830     sub size_request {
831     my ($self) = @_;
832    
833 root 1.75 my ($ws, $hs) = $self->get_wh;
834 elmex 1.15
835 root 1.75 (
836 root 1.78 (sum @$ws),
837     (sum @$hs),
838 root 1.75 )
839     }
840    
841     sub size_allocate {
842 root 1.128 my ($self, $w, $h) = @_;
843 root 1.75
844     my ($ws, $hs) = $self->get_wh;
845    
846 root 1.78 my $req_w = sum @$ws;
847     my $req_h = sum @$hs;
848    
849     # TODO: nicer code && do row_expand
850     my @col_expand = @{$self->{col_expand}};
851     @col_expand = (1) x @$ws unless @col_expand;
852     my $col_expand = (sum @col_expand) || 1;
853 elmex 1.15
854 root 1.75 # linearly scale sizes
855 root 1.78 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
856     $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
857 elmex 1.15
858 root 1.112 CFClient::UI::harmonize $ws;
859     CFClient::UI::harmonize $hs;
860 root 1.106
861 root 1.75 my $y;
862 elmex 1.15
863 root 1.75 for my $r (0 .. $#{$self->{children}}) {
864     my $row = $self->{children}[$r]
865     or next;
866 elmex 1.15
867     my $x = 0;
868 root 1.75 my $row_h = $hs->[$r];
869    
870     for my $c (0 .. $#$row) {
871     my $col_w = $ws->[$c];
872 elmex 1.15
873 root 1.83 if (my $widget = $row->[$c]) {
874 root 1.128 $widget->configure ($x, $y, $col_w, $row_h);
875 root 1.83 }
876 elmex 1.15
877 root 1.75 $x += $col_w;
878 elmex 1.15 }
879    
880 root 1.75 $y += $row_h;
881     }
882    
883     }
884    
885 root 1.76 sub find_widget {
886     my ($self, $x, $y) = @_;
887    
888     $x -= $self->{x};
889     $y -= $self->{y};
890    
891     my $res;
892    
893     for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
894     $res = $_->find_widget ($x, $y)
895     and return $res;
896     }
897    
898     $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
899     }
900    
901 root 1.75 sub _draw {
902     my ($self) = @_;
903    
904     for (grep $_, @{$self->{children}}) {
905     $_->draw for grep $_, @$_;
906 elmex 1.15 }
907     }
908    
909 root 1.39 #############################################################################
910    
911 root 1.76 package CFClient::UI::HBox;
912    
913     # TODO: wrap into common Box base class
914    
915     our @ISA = CFClient::UI::Container::;
916    
917     sub size_request {
918     my ($self) = @_;
919    
920     my @alloc = map [$_->size_request], @{$self->{children}};
921    
922     (
923     (List::Util::sum map $_->[0], @alloc),
924     (List::Util::max map $_->[1], @alloc),
925     )
926     }
927    
928     sub size_allocate {
929 root 1.128 my ($self, $w, $h) = @_;
930 root 1.76
931     ($h, $w) = ($w, $h);
932    
933     my $children = $self->{children};
934    
935     my @h = map +($_->size_request)[0], @$children;
936    
937     my $req_h = List::Util::sum @h;
938    
939     if ($req_h > $h) {
940     # ah well, not enough space
941 root 1.78 $_ *= $h / $req_h for @h;
942 root 1.76 } else {
943 root 1.77 my $exp = List::Util::sum map $_->{expand}, @$children;
944     $exp ||= 1;
945 root 1.76
946     for (0 .. $#$children) {
947     my $child = $children->[$_];
948    
949     my $alloc_h = $h[$_];
950 root 1.77 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
951 root 1.76 $h[$_] = $alloc_h;
952     }
953     }
954    
955 root 1.112 CFClient::UI::harmonize \@h;
956    
957 root 1.76 my $y = 0;
958     for (0 .. $#$children) {
959     my $child = $children->[$_];
960 root 1.112 my $h = $h[$_];
961 root 1.128 $child->configure ($y, 0, $h, $w);
962 root 1.76
963     $y += $h;
964     }
965 root 1.125
966     1
967 root 1.76 }
968    
969     #############################################################################
970    
971 root 1.73 package CFClient::UI::VBox;
972 elmex 1.15
973 root 1.76 # TODO: wrap into common Box base class
974    
975 root 1.73 our @ISA = CFClient::UI::Container::;
976 elmex 1.15
977 root 1.43 sub size_request {
978     my ($self) = @_;
979    
980     my @alloc = map [$_->size_request], @{$self->{children}};
981    
982     (
983     (List::Util::max map $_->[0], @alloc),
984     (List::Util::sum map $_->[1], @alloc),
985     )
986     }
987    
988 elmex 1.36 sub size_allocate {
989 root 1.128 my ($self, $w, $h) = @_;
990 root 1.68
991     my $children = $self->{children};
992    
993     my @h = map +($_->size_request)[1], @$children;
994    
995     my $req_h = List::Util::sum @h;
996    
997     if ($req_h > $h) {
998     # ah well, not enough space
999 root 1.78 $_ *= $h / $req_h for @h;
1000 root 1.68 } else {
1001 root 1.77 my $exp = List::Util::sum map $_->{expand}, @$children;
1002     $exp ||= 1;
1003 root 1.68
1004     for (0 .. $#$children) {
1005     my $child = $children->[$_];
1006 elmex 1.36
1007 root 1.77 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1008 root 1.68 }
1009 elmex 1.36 }
1010    
1011 root 1.112 CFClient::UI::harmonize \@h;
1012    
1013 elmex 1.36 my $y = 0;
1014 root 1.68 for (0 .. $#$children) {
1015     my $child = $children->[$_];
1016 root 1.112 my $h = $h[$_];
1017 root 1.128 $child->configure (0, $y, $w, $h);
1018 elmex 1.36
1019 root 1.68 $y += $h;
1020 elmex 1.36 }
1021 root 1.125
1022     1
1023 elmex 1.36 }
1024    
1025 root 1.39 #############################################################################
1026    
1027 root 1.73 package CFClient::UI::Label;
1028 root 1.10
1029 root 1.73 our @ISA = CFClient::UI::Base::;
1030 root 1.12
1031 root 1.138 use CFClient::OpenGL;
1032 root 1.10
1033     sub new {
1034 root 1.64 my ($class, %arg) = @_;
1035 root 1.51
1036 root 1.59 my $self = $class->SUPER::new (
1037 root 1.105 fg => [1, 1, 1],
1038 root 1.134 fontsize => 1,
1039 root 1.105 text => "",
1040     align => -1,
1041 root 1.116 valign => -1,
1042 root 1.105 padding => 2,
1043     layout => new CFClient::Layout,
1044 root 1.64 %arg
1045 root 1.59 );
1046 root 1.10
1047 root 1.141 if (exists $self->{template}) {
1048     my $layout = new CFClient::Layout;
1049     $layout->set_text (delete $self->{template});
1050     $self->{template} = $layout;
1051     }
1052 root 1.121
1053     $self->set_text (delete $self->{text}) if exists $self->{text};
1054     $self->set_markup (delete $self->{markup}) if exists $self->{markup};
1055 root 1.10
1056     $self
1057     }
1058    
1059 root 1.68 sub escape_text {
1060     local $_ = $_[1];
1061    
1062     s/&/&amp;/g;
1063     s/>/&gt;/g;
1064     s/</&lt;/g;
1065    
1066     $_[1]
1067     }
1068    
1069 elmex 1.15 sub set_text {
1070     my ($self, $text) = @_;
1071 root 1.28
1072 root 1.121 $self->{layout}->set_text ($text);
1073 root 1.28
1074 root 1.59 delete $self->{texture};
1075 root 1.68 $self->update;
1076 elmex 1.15 }
1077    
1078 root 1.121 sub set_markup {
1079     my ($self, $markup) = @_;
1080    
1081     $self->{layout}->set_markup ($markup);
1082 root 1.28
1083 root 1.121 delete $self->{texture};
1084     $self->update;
1085 elmex 1.15 }
1086    
1087 root 1.14 sub size_request {
1088     my ($self) = @_;
1089    
1090 root 1.59 $self->{layout}->set_width;
1091 root 1.134 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1092 root 1.121
1093 root 1.76 my ($w, $h) = $self->{layout}->size;
1094    
1095 root 1.141 if (exists $self->{template}) {
1096     $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1097    
1098     my ($w2, $h2) = $self->{template}->size;
1099    
1100     $w = List::Util::max $w, $w2;
1101     $h = List::Util::max $h, $h2;
1102     }
1103    
1104 root 1.76 (
1105     $w + $self->{padding} * 2,
1106     $h + $self->{padding} * 2,
1107     )
1108 root 1.59 }
1109 root 1.51
1110 root 1.59 sub size_allocate {
1111 root 1.128 my ($self, $w, $h) = @_;
1112 root 1.68
1113 root 1.59 delete $self->{texture};
1114 root 1.14 }
1115    
1116 elmex 1.11 sub _draw {
1117 root 1.10 my ($self) = @_;
1118    
1119 root 1.59 my $tex = $self->{texture} ||= do {
1120     $self->{layout}->set_width ($self->{w});
1121 root 1.134 $self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);
1122 root 1.74 new_from_layout CFClient::Texture $self->{layout}
1123 root 1.59 };
1124 root 1.10
1125 root 1.12 glEnable GL_BLEND;
1126 root 1.74 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1127 root 1.10 glEnable GL_TEXTURE_2D;
1128 root 1.105 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1129 root 1.10
1130 root 1.68 glColor @{$self->{fg}};
1131 root 1.12
1132 root 1.122 $self->{ox} = int (
1133 root 1.76 $self->{align} < 0 ? $self->{padding}
1134     : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1135 root 1.122 : ($self->{w} - $tex->{w}) * 0.5
1136     );
1137 root 1.72
1138 root 1.122 $self->{oy} = int (
1139 root 1.116 $self->{valign} < 0 ? $self->{padding}
1140     : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1141 root 1.122 : ($self->{h} - $tex->{h}) * 0.5
1142     );
1143 root 1.116
1144 root 1.122 $tex->draw_quad ($self->{ox}, $self->{oy});
1145 root 1.10
1146 root 1.74 glDisable GL_TEXTURE_2D;
1147 root 1.12 glDisable GL_BLEND;
1148 root 1.10 }
1149    
1150 root 1.39 #############################################################################
1151    
1152 root 1.121 package CFClient::UI::EntryBase;
1153 elmex 1.31
1154 root 1.73 our @ISA = CFClient::UI::Label::;
1155 elmex 1.31
1156 root 1.138 use CFClient::OpenGL;
1157 elmex 1.31
1158 root 1.68 sub new {
1159     my $class = shift;
1160    
1161     $class->SUPER::new (
1162     fg => [1, 1, 1],
1163 root 1.76 bg => [0, 0, 0, 0.2],
1164 root 1.79 active_bg => [1, 1, 1, 0.5],
1165 root 1.68 active_fg => [0, 0, 0],
1166 root 1.97 can_hover => 1,
1167     can_focus => 1,
1168 root 1.116 valign => 0,
1169 root 1.68 @_
1170     )
1171     }
1172    
1173     sub _set_text {
1174     my ($self, $text) = @_;
1175    
1176 root 1.121 delete $self->{cur_h};
1177    
1178     return if $self->{text} eq $text;
1179 elmex 1.100
1180 root 1.134 delete $self->{texture};
1181    
1182 root 1.68 $self->{last_activity} = $::NOW;
1183     $self->{text} = $text;
1184 root 1.72
1185     $text =~ s/./*/g if $self->{hidden};
1186 root 1.121 $self->{layout}->set_text ("$text ");
1187 root 1.72
1188 root 1.121 $self->emit (changed => $self->{text});
1189     }
1190 root 1.68
1191 root 1.121 sub get_text {
1192     $_[0]{text}
1193 root 1.68 }
1194    
1195     sub size_request {
1196     my ($self) = @_;
1197    
1198     my ($w, $h) = $self->SUPER::size_request;
1199    
1200     ($w + 1, $h) # add 1 for cursor
1201     }
1202    
1203     sub size_allocate {
1204 root 1.128 my ($self, $w, $h) = @_;
1205 root 1.68
1206     $self->_set_text ($self->{text});
1207     }
1208    
1209     sub set_text {
1210     my ($self, $text) = @_;
1211    
1212     $self->{cursor} = length $text;
1213     $self->_set_text ($text);
1214     $self->update;
1215     }
1216    
1217 elmex 1.31 sub key_down {
1218     my ($self, $ev) = @_;
1219    
1220 root 1.137 my $mod = $ev->{mod};
1221     my $sym = $ev->{sym};
1222     my $uni = $ev->{unicode};
1223 elmex 1.31
1224     my $text = $self->get_text;
1225    
1226 root 1.136 if ($sym == 8) {
1227 root 1.68 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1228 root 1.136 } elsif ($sym == 127) {
1229 root 1.68 substr $text, $self->{cursor}, 1, "";
1230 root 1.136 } elsif ($sym == CFClient::SDLK_LEFT) {
1231 root 1.68 --$self->{cursor} if $self->{cursor};
1232 root 1.136 } elsif ($sym == CFClient::SDLK_RIGHT) {
1233 root 1.68 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1234 root 1.136 } elsif ($sym == CFClient::SDLK_HOME) {
1235 root 1.76 $self->{cursor} = 0;
1236 root 1.136 } elsif ($sym == CFClient::SDLK_END) {
1237 root 1.76 $self->{cursor} = length $text;
1238 root 1.136 } elsif ($sym == 27) {
1239 elmex 1.101 $self->emit ('escape');
1240 elmex 1.31 } elsif ($uni) {
1241 root 1.68 substr $text, $self->{cursor}++, 0, chr $uni;
1242 elmex 1.31 }
1243 root 1.51
1244 root 1.68 $self->_set_text ($text);
1245     $self->update;
1246     }
1247    
1248     sub focus_in {
1249     my ($self) = @_;
1250    
1251     $self->{last_activity} = $::NOW;
1252    
1253     $self->SUPER::focus_in;
1254 elmex 1.31 }
1255    
1256 root 1.51 sub button_down {
1257 root 1.68 my ($self, $ev, $x, $y) = @_;
1258    
1259     $self->SUPER::button_down ($ev, $x, $y);
1260    
1261     my $idx = $self->{layout}->xy_to_index ($x, $y);
1262    
1263     # byte-index to char-index
1264 root 1.76 my $text = $self->{text};
1265 root 1.68 utf8::encode $text;
1266     $self->{cursor} = length substr $text, 0, $idx;
1267 root 1.51
1268 root 1.68 $self->_set_text ($self->{text});
1269     $self->update;
1270 root 1.51 }
1271    
1272 root 1.58 sub mouse_motion {
1273     my ($self, $ev, $x, $y) = @_;
1274 root 1.68 # printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1275 root 1.58 }
1276    
1277 root 1.51 sub _draw {
1278     my ($self) = @_;
1279    
1280 root 1.68 local $self->{fg} = $self->{fg};
1281    
1282 root 1.51 if ($FOCUS == $self) {
1283 root 1.68 glColor @{$self->{active_bg}};
1284     $self->{fg} = $self->{active_fg};
1285 root 1.51 } else {
1286 root 1.68 glColor @{$self->{bg}};
1287 root 1.51 }
1288    
1289 root 1.76 glEnable GL_BLEND;
1290     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1291 root 1.51 glBegin GL_QUADS;
1292 root 1.68 glVertex 0 , 0;
1293     glVertex 0 , $self->{h};
1294     glVertex $self->{w}, $self->{h};
1295     glVertex $self->{w}, 0;
1296 root 1.51 glEnd;
1297 root 1.76 glDisable GL_BLEND;
1298 root 1.51
1299     $self->SUPER::_draw;
1300 root 1.68
1301     #TODO: force update every cursor change :(
1302     if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
1303 root 1.121
1304     unless (exists $self->{cur_h}) {
1305     my $text = substr $self->{text}, 0, $self->{cursor};
1306     utf8::encode $text;
1307    
1308     @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1309     }
1310    
1311 root 1.68 glColor @{$self->{fg}};
1312     glBegin GL_LINES;
1313 root 1.122 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1314     glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1315 root 1.68 glEnd;
1316     }
1317     }
1318    
1319 root 1.121 package CFClient::UI::Entry;
1320 elmex 1.99
1321 root 1.121 our @ISA = CFClient::UI::EntryBase::;
1322 elmex 1.99
1323 root 1.138 use CFClient::OpenGL;
1324 elmex 1.99
1325     sub key_down {
1326     my ($self, $ev) = @_;
1327    
1328 root 1.137 my $sym = $ev->{sym};
1329 elmex 1.99
1330 root 1.136 if ($sym == 13) {
1331 elmex 1.99 $self->emit (activate => $self->get_text);
1332     $self->update;
1333    
1334     } else {
1335     $self->SUPER::key_down ($ev);
1336     }
1337    
1338     }
1339    
1340 root 1.68 #############################################################################
1341    
1342 root 1.79 package CFClient::UI::Button;
1343    
1344     our @ISA = CFClient::UI::Label::;
1345    
1346 root 1.138 use CFClient::OpenGL;
1347 root 1.79
1348 elmex 1.85 my @tex =
1349     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1350     qw(b1_button_active.png);
1351    
1352 root 1.79 sub new {
1353     my $class = shift;
1354    
1355     $class->SUPER::new (
1356     padding => 4,
1357     fg => [1, 1, 1],
1358     bg => [1, 1, 1, 0.2],
1359 root 1.123 active_fg => [0, 0, 1],
1360 root 1.97 can_hover => 1,
1361 root 1.126 align => 0,
1362     valign => 0,
1363 root 1.79 @_
1364     )
1365     }
1366    
1367     sub button_up {
1368     my ($self, $ev, $x, $y) = @_;
1369    
1370     if ($x >= 0 && $x < $self->{w}
1371     && $y >= 0 && $y < $self->{h}) {
1372     $self->emit ("activate");
1373     }
1374     }
1375    
1376     sub _draw {
1377     my ($self) = @_;
1378    
1379     local $self->{fg} = $self->{fg};
1380    
1381     if ($GRAB == $self) {
1382     $self->{fg} = $self->{active_fg};
1383     }
1384    
1385 root 1.119 glEnable GL_BLEND;
1386     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1387     glEnable GL_TEXTURE_2D;
1388 elmex 1.85 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1389 root 1.119 glColor 0, 0, 0, 1;
1390 elmex 1.85
1391 root 1.119 $tex[0]->draw_quad (0, 0, $self->{w}, $self->{h});
1392 elmex 1.85
1393     glDisable GL_TEXTURE_2D;
1394 root 1.79 glDisable GL_BLEND;
1395    
1396     $self->SUPER::_draw;
1397     }
1398    
1399     #############################################################################
1400    
1401 root 1.86 package CFClient::UI::CheckBox;
1402    
1403     our @ISA = CFClient::UI::DrawBG::;
1404    
1405 elmex 1.102 my @tex =
1406     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1407     qw(c1_checkbox_bg.png c1_checkbox_active.png);
1408    
1409 root 1.138 use CFClient::OpenGL;
1410 root 1.86
1411     sub new {
1412     my $class = shift;
1413    
1414     $class->SUPER::new (
1415 root 1.87 padding => 2,
1416 root 1.86 fg => [1, 1, 1],
1417     active_fg => [1, 1, 0],
1418     state => 0,
1419 root 1.97 can_hover => 1,
1420 root 1.86 @_
1421     )
1422     }
1423    
1424 root 1.87 sub size_request {
1425     my ($self) = @_;
1426    
1427     ($self->{padding} * 2 + 6) x 2
1428     }
1429    
1430 root 1.86 sub button_down {
1431     my ($self, $ev, $x, $y) = @_;
1432    
1433     if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}
1434     && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {
1435     $self->{state} = !$self->{state};
1436 root 1.87 $self->emit (changed => $self->{state});
1437 root 1.86 }
1438     }
1439    
1440     sub _draw {
1441     my ($self) = @_;
1442    
1443 root 1.87 $self->SUPER::_draw;
1444 root 1.86
1445 root 1.87 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;
1446 root 1.86
1447 root 1.87 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;
1448 elmex 1.102
1449 root 1.87 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1450 root 1.86
1451 elmex 1.102 glEnable GL_BLEND;
1452     glEnable GL_TEXTURE_2D;
1453     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1454 root 1.86
1455 elmex 1.102 my $tex = $self->{state} ? $tex[1] : $tex[0];
1456    
1457     $tex->draw_quad (0, 0, $s, $s);
1458    
1459     glDisable GL_TEXTURE_2D;
1460     glDisable GL_BLEND;
1461 root 1.86 }
1462    
1463     #############################################################################
1464    
1465 elmex 1.124 package CFClient::UI::VGauge;
1466    
1467     our @ISA = CFClient::UI::Base::;
1468    
1469 root 1.138 use CFClient::OpenGL;
1470 elmex 1.124
1471     my %tex = (
1472     food => [
1473     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1474     qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
1475     ],
1476     grace => [
1477     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1478     qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png/
1479     ],
1480     hp => [
1481     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1482     qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
1483     ],
1484     mana => [
1485     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1486     qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png/
1487     ],
1488     );
1489    
1490     # eg. VGauge->new (gauge => 'food'), default gauge: food
1491     sub new {
1492     my $class = shift;
1493    
1494 root 1.140 my $self = $class->SUPER::new (
1495 root 1.141 type => 'food',
1496 root 1.140 @_
1497     );
1498    
1499 root 1.141 $self->{aspect} = $tex{$self->{type}}[0]{w} / $tex{$self->{type}}[0]{h};
1500 elmex 1.124
1501     $self
1502     }
1503    
1504     sub size_request {
1505     my ($self) = @_;
1506    
1507 root 1.143 #my $tex = $tex{$self->{type}}[0];
1508     #@$tex{qw(w h)}
1509     (0, 0)
1510 elmex 1.124 }
1511    
1512     sub set_max {
1513     my ($self, $max) = @_;
1514 root 1.127
1515 elmex 1.124 $self->{max_val} = $max;
1516     }
1517    
1518     sub set_value {
1519     my ($self, $val, $max) = @_;
1520    
1521     $self->set_max ($max)
1522     if defined $max;
1523    
1524     $max = $self->{max_val};
1525     $self->{val} = $val;
1526    
1527     $self->update;
1528     }
1529    
1530     sub _draw {
1531     my ($self) = @_;
1532    
1533 root 1.141 my $tex = $tex{$self->{type}};
1534 elmex 1.124
1535     my ($w, $h) = ($self->{w}, $self->{h});
1536    
1537 elmex 1.142 if ($self->{vertical}) {
1538     glRotate 90, 0, 0, 1;
1539     glTranslate 0, -$self->{w}, 0;
1540    
1541     ($w, $h) = ($h, $w);
1542     }
1543    
1544 elmex 1.124 my $ycut = $self->{val} / ($self->{max_val} || 1);
1545     $ycut = 1 if $self->{val} > $self->{max_val};
1546    
1547     my $t1 = $tex->[0];
1548     my $t2 = $tex->[1];
1549    
1550     glEnable GL_BLEND;
1551     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1552     glEnable GL_TEXTURE_2D;
1553     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1554    
1555     my $h1 = $self->{h} - $ycut * $self->{h};
1556     my $h2 = $ycut * $self->{h};
1557    
1558 root 1.131 glBindTexture GL_TEXTURE_2D, $t1->{name};
1559     glBegin GL_QUADS;
1560 root 1.141 glTexCoord 0 , 0; glVertex 0 , 0;
1561     glTexCoord 0 , $t1->{t} * (1 - $ycut); glVertex 0 , $h1;
1562     glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut); glVertex $w, $h1;
1563     glTexCoord $t1->{s}, 0; glVertex $w, 0;
1564 root 1.131 glEnd;
1565 elmex 1.124
1566 root 1.131 glBindTexture GL_TEXTURE_2D, $t2->{name};
1567     glBegin GL_QUADS;
1568 root 1.141 glTexCoord 0 , $t2->{t} * (1 - $ycut); glVertex 0 , $h1;
1569     glTexCoord 0 , $t2->{t}; glVertex 0 , $h1 + $h2;
1570     glTexCoord $t2->{s}, $t2->{t}; glVertex $w, $h1 + $h2;
1571     glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut); glVertex $w, $h1;
1572 root 1.131 glEnd;
1573 elmex 1.124
1574     glDisable GL_BLEND;
1575     glDisable GL_TEXTURE_2D;
1576     }
1577    
1578     #############################################################################
1579    
1580 root 1.141 package CFClient::UI::Gauge;
1581    
1582     our @ISA = CFClient::UI::VBox::;
1583    
1584     sub new {
1585     my ($class, %arg) = shift;
1586    
1587     my $self = $class->SUPER::new (
1588     @_,
1589     );
1590    
1591     $self->add ($self->{value} = new CFClient::UI::Label valign => 1, align => 0, template => "999");
1592 root 1.143 $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1);
1593 root 1.141 $self->add ($self->{max} = new CFClient::UI::Label valign => 1, align => 0, template => "999");
1594    
1595     $self
1596     }
1597    
1598     sub set_value {
1599     my ($self, $val, $max) = @_;
1600    
1601     $self->set_max ($max)
1602     if defined $max;
1603    
1604     $self->{gauge}->set_value ($val, $max);
1605     $self->{value}->set_text ($val);
1606     }
1607    
1608     sub set_max {
1609     my ($self, $max) = @_;
1610    
1611     $self->{gauge}->set_max ($max);
1612     $self->{max}->set_text ($max);
1613     }
1614    
1615     #############################################################################
1616    
1617 root 1.73 package CFClient::UI::Slider;
1618 root 1.68
1619     use strict;
1620    
1621 root 1.138 use CFClient::OpenGL;
1622 root 1.68
1623 root 1.73 our @ISA = CFClient::UI::DrawBG::;
1624 root 1.68
1625 elmex 1.99 my @tex =
1626     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1627     qw(s1_slider.png s1_slider_bg.png);
1628    
1629 root 1.68 sub new {
1630     my $class = shift;
1631    
1632     # range [value, low, high, page]
1633    
1634 root 1.97 # TODO: 0-width page
1635     # TODO: req_w/h are wrong with vertical
1636     # TODO: calculations are off
1637 root 1.76 my $self = $class->SUPER::new (
1638 root 1.68 fg => [1, 1, 1],
1639     active_fg => [0, 0, 0],
1640     range => [0, 0, 100, 10],
1641 root 1.134 req_w => 20,
1642     req_h => 20,
1643 root 1.76 vertical => 0,
1644 root 1.97 can_hover => 1,
1645 elmex 1.103 inner_pad => 5,
1646 root 1.68 @_
1647 root 1.76 );
1648    
1649     $self
1650     }
1651    
1652     sub size_request {
1653     my ($self) = @_;
1654    
1655     my $w = $self->{req_w};
1656     my $h = $self->{req_h};
1657    
1658     $self->{vertical} ? ($h, $w) : ($w, $h)
1659 root 1.68 }
1660    
1661 root 1.69 sub button_down {
1662     my ($self, $ev, $x, $y) = @_;
1663    
1664     $self->SUPER::button_down ($ev, $x, $y);
1665     $self->mouse_motion ($ev, $x, $y);
1666     }
1667    
1668     sub mouse_motion {
1669     my ($self, $ev, $x, $y) = @_;
1670    
1671     if ($GRAB == $self) {
1672     my ($value, $lo, $hi, $page) = @{$self->{range}};
1673    
1674 root 1.71 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
1675    
1676 elmex 1.103 my $inner_pad_px = $self->_calc_inner_pad_px ($w);
1677     my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
1678    
1679     $x -= $inner_pad_px; # substract the padding
1680     $x = $x * ($hi - $lo) / $inner_w + $lo;
1681 root 1.69 $x = $lo if $x < $lo;
1682     $x = $hi - $page if $x > $hi - $page;
1683     $self->{range}[0] = $x;
1684    
1685 root 1.72 $self->emit (changed => $x);
1686 root 1.69 $self->update;
1687     }
1688     }
1689    
1690 elmex 1.103 # the inner_* stuff is for generating a padding for the slider handle,
1691     # so that the handle doesn't leave the texture. This calculation isn't 100%
1692     # correct propably, but it does the job for now
1693     sub _calc_inner_pad_px {
1694     my ($self, $w) = @_;
1695     ($w / 100) * $self->{inner_pad} # % to pixels
1696     }
1697    
1698 root 1.68 sub _draw {
1699     my ($self) = @_;
1700    
1701     $self->SUPER::_draw ();
1702    
1703     my ($w, $h) = @$self{qw(w h)};
1704    
1705     if ($self->{vertical}) {
1706     # draw a vertical slider like a rotated horizontal slider
1707    
1708     glRotate 90, 0, 0, 1;
1709 root 1.71 glTranslate 0, -$self->{w}, 0;
1710 root 1.68
1711     ($w, $h) = ($h, $w);
1712     }
1713    
1714     my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
1715     my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
1716    
1717 root 1.69 my ($value, $lo, $hi, $page) = @{$self->{range}};
1718    
1719 root 1.107 $hi = $value + 1 if $lo == $hi;
1720    
1721 elmex 1.103 my $inner_pad_px = $self->_calc_inner_pad_px ($w);
1722     my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
1723 elmex 1.99
1724     $page = int $page * $inner_w / ($hi - $lo);
1725     $value = int +($value - $lo) * $inner_w / ($hi - $lo);
1726 root 1.69
1727     $w -= $page;
1728     $page &= ~1;
1729     glTranslate $page * 0.5, 0, 0;
1730 root 1.80 $page ||= 2;
1731 root 1.69
1732 elmex 1.99 my $knob_a = $inner_pad_px + ($value - $page * 0.5);
1733     my $knob_b = $inner_pad_px + ($value + $page * 0.5);
1734    
1735     glEnable GL_BLEND;
1736     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1737     glEnable GL_TEXTURE_2D;
1738     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1739    
1740     # draw background
1741     $tex[1]->draw_quad (0, 0, $w, $h);
1742 root 1.69
1743 elmex 1.99 # draw handle
1744     $tex[0]->draw_quad ($knob_a, 0, $knob_b - $knob_a, $h);
1745 root 1.69
1746 elmex 1.99 glDisable GL_BLEND;
1747     glDisable GL_TEXTURE_2D;
1748 root 1.51 }
1749    
1750 root 1.39 #############################################################################
1751    
1752 root 1.97 package CFClient::UI::TextView;
1753    
1754     our @ISA = CFClient::UI::HBox::;
1755    
1756 root 1.138 use CFClient::OpenGL;
1757 root 1.97
1758     sub new {
1759     my $class = shift;
1760    
1761     my $self = $class->SUPER::new (
1762 root 1.134 fontsize => 1,
1763 root 1.105 @_,
1764    
1765     layout => (new CFClient::Layout),
1766 root 1.97 par => [],
1767 root 1.105 height => 0,
1768 root 1.97 children => [
1769     (new CFClient::UI::Empty expand => 1),
1770     (new CFClient::UI::Slider vertical => 1),
1771     ],
1772     );
1773    
1774 root 1.107 $self->{children}[1]->connect (changed => sub {
1775     $self->update;
1776     });
1777    
1778 root 1.97 $self
1779     }
1780    
1781 root 1.107 sub set_fontsize {
1782     my ($self, $fontsize) = @_;
1783    
1784     $self->{fontsize} = $fontsize;
1785     $self->reflow;
1786     }
1787    
1788 root 1.105 sub text_height {
1789     my ($self, $text) = @_;
1790    
1791     my $layout = $self->{layout};
1792    
1793 root 1.134 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
1794 root 1.105 $layout->set_width ($self->{w});
1795     $layout->set_text ($text);
1796    
1797     ($layout->size)[1]
1798     }
1799    
1800     sub reflow {
1801     my ($self) = @_;
1802    
1803 root 1.107 $self->{need_reflow}++;
1804     $self->update;
1805 root 1.105 }
1806    
1807     sub size_allocate {
1808 root 1.128 my ($self, $w, $h) = @_;
1809 root 1.105
1810 root 1.134 $self->SUPER::size_allocate ($w, $h);
1811    
1812     $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1813     $self->{layout}->set_width ($self->{children}[0]{w});
1814 root 1.105
1815     $self->reflow;
1816     }
1817    
1818 root 1.97 sub add_paragraph {
1819     my ($self, $color, $text) = @_;
1820    
1821 root 1.105 #TODO: intelligently "reformat" paragraph
1822    
1823     my $height = $self->text_height ($text);
1824    
1825     $self->{height} += $height;
1826    
1827     push @{$self->{par}}, [$height, $color, $text];
1828    
1829     $self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}];
1830 root 1.97 $self->{children}[1]->update;
1831     }
1832    
1833 root 1.105 sub update {
1834 root 1.97 my ($self) = @_;
1835    
1836 root 1.105 $self->SUPER::update;
1837    
1838     return unless $self->{h} > 0;
1839    
1840 root 1.107 delete $self->{texture};
1841    
1842 root 1.113 $ROOT->on_refresh ($self, sub {
1843 root 1.107 if (delete $self->{need_reflow}) {
1844     my $height = 0;
1845    
1846     $height += $_->[0] = $self->text_height ($_->[2])
1847     for @{$self->{par}};
1848    
1849     $self->{height} = $height;
1850    
1851     $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];
1852    
1853     delete $self->{texture};
1854     }
1855    
1856     $self->{texture} ||= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
1857     glClearColor 0, 0, 0, 1;
1858     glClear GL_COLOR_BUFFER_BIT;
1859    
1860     glEnable GL_BLEND;
1861     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1862     glEnable GL_TEXTURE_2D;
1863     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1864 root 1.105
1865 root 1.107 my $top = int $self->{children}[1]{range}[0];
1866 root 1.105
1867 root 1.107 my $y0 = $top;
1868     my $y1 = $top + $self->{h};
1869 root 1.105
1870 root 1.107 my $y = 0;
1871 root 1.97
1872 root 1.107 my $layout = $self->{layout};
1873 root 1.97
1874 root 1.107 for my $par (@{$self->{par}}) {
1875     my $h = $par->[0];
1876 root 1.97
1877 root 1.107 if ($y0 < $y + $h && $y < $y1) {
1878     $layout->set_text ($par->[2]);
1879 root 1.105
1880 root 1.107 glColor @{ $par->[1] };
1881     my ($W, $H) = $layout->size;
1882     CFClient::Texture->new_from_layout ($layout)->draw_quad (0, $y - $y0);
1883     }
1884    
1885     $y += $h;
1886 root 1.105 }
1887    
1888 root 1.107 glDisable GL_TEXTURE_2D;
1889     glDisable GL_BLEND;
1890     };
1891     });
1892 root 1.105 }
1893 root 1.97
1894 root 1.105 sub _draw {
1895     my ($self) = @_;
1896 root 1.97
1897 root 1.105 if ($self->{texture}) {
1898     glEnable GL_TEXTURE_2D;
1899     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1900     $self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});
1901     glDisable GL_TEXTURE_2D;
1902 root 1.97 }
1903    
1904 root 1.106 $self->{children}[1]->draw;
1905    
1906 root 1.97 }
1907    
1908     #############################################################################
1909    
1910 root 1.73 package CFClient::UI::Animator;
1911 root 1.35
1912 root 1.138 use CFClient::OpenGL;
1913 root 1.35
1914 root 1.73 our @ISA = CFClient::UI::Bin::;
1915 root 1.35
1916     sub moveto {
1917     my ($self, $x, $y) = @_;
1918    
1919     $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
1920 root 1.56 $self->{speed} = 0.001;
1921 root 1.35 $self->{time} = 1;
1922    
1923     ::animation_start $self;
1924     }
1925    
1926     sub animate {
1927     my ($self, $interval) = @_;
1928    
1929     $self->{time} -= $interval * $self->{speed};
1930     if ($self->{time} <= 0) {
1931     $self->{time} = 0;
1932     ::animation_stop $self;
1933     }
1934    
1935     my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
1936    
1937     $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
1938     $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
1939     }
1940    
1941     sub _draw {
1942     my ($self) = @_;
1943    
1944     glPushMatrix;
1945 root 1.51 glRotate $self->{time} * 1000, 0, 1, 0;
1946 root 1.38 $self->{children}[0]->draw;
1947 root 1.35 glPopMatrix;
1948     }
1949    
1950 root 1.51 #############################################################################
1951    
1952 root 1.96 package CFClient::UI::Flopper;
1953    
1954     our @ISA = CFClient::UI::Button::;
1955    
1956     sub new {
1957     my $class = shift;
1958    
1959     my $self = $class->SUPER::new (
1960     state => 0,
1961     connect_activate => \&toggle_flopper,
1962     @_
1963     );
1964    
1965     if ($self->{state}) {
1966     $self->{state} = 0;
1967     $self->toggle_flopper;
1968     }
1969    
1970     $self
1971     }
1972    
1973     sub toggle_flopper {
1974     my ($self) = @_;
1975    
1976 root 1.97 # TODO: use animation
1977 root 1.96 if ($self->{state} = !$self->{state}) {
1978 root 1.113 $CFClient::UI::ROOT->add ($self->{other});
1979     $self->{other}->move ($self->coord2global (0, $self->{h}));
1980 root 1.114 $self->emit ("open");
1981 root 1.96 } else {
1982 root 1.113 $CFClient::UI::ROOT->remove ($self->{other});
1983 root 1.114 $self->emit ("close");
1984 root 1.96 }
1985 root 1.114
1986     $self->emit (changed => $self->{state});
1987 root 1.96 }
1988    
1989     #############################################################################
1990    
1991 root 1.113 package CFClient::UI::Root;
1992 root 1.51
1993 root 1.73 our @ISA = CFClient::UI::Container::;
1994 root 1.51
1995 root 1.138 use CFClient::OpenGL;
1996 root 1.107
1997 root 1.125 sub check_size {
1998     my ($self) = @_;
1999    
2000 root 1.128 $self->configure (0, 0, $::WITH, $::HEIGHT);
2001 root 1.125 }
2002    
2003 root 1.51 sub size_request {
2004     ($::WIDTH, $::HEIGHT)
2005     }
2006    
2007 root 1.128 sub configure {
2008 root 1.75 my ($self, $x, $y, $w, $h) = @_;
2009 root 1.51
2010 root 1.128 $self->SUPER::configure ($x, $y, $w, $h);
2011 root 1.51
2012 root 1.128 $_->configure ($_->{x}, $_->{y}, $_->size_request)
2013 root 1.51 for @{$self->{children}};
2014     }
2015    
2016 root 1.113 sub _topleft {
2017 root 1.58 my ($self, $x, $y) = @_;
2018    
2019     ($x, $y)
2020     }
2021    
2022 root 1.51 sub update {
2023     my ($self) = @_;
2024    
2025 root 1.125 $self->check_size;
2026 root 1.51 ::refresh ();
2027     }
2028    
2029     sub add {
2030 root 1.128 my ($self, $child) = @_;
2031 root 1.51
2032 root 1.128 $self->SUPER::add ($child);
2033 root 1.51 }
2034    
2035 root 1.107 sub on_refresh {
2036     my ($self, $id, $cb) = @_;
2037    
2038     $self->{refresh_hook}{$id} = $cb;
2039     }
2040    
2041 root 1.51 sub draw {
2042     my ($self) = @_;
2043    
2044 root 1.107 while (my $rcb = delete $self->{refresh_hook}) {
2045     $_->() for values %$rcb;
2046     }
2047    
2048     glViewport 0, 0, $::WIDTH, $::HEIGHT;
2049     glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2050     glClear GL_COLOR_BUFFER_BIT;
2051    
2052     glMatrixMode GL_PROJECTION;
2053     glLoadIdentity;
2054     glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;
2055     glMatrixMode GL_MODELVIEW;
2056     glLoadIdentity;
2057    
2058 root 1.51 $self->_draw;
2059     }
2060    
2061     #############################################################################
2062    
2063 root 1.73 package CFClient::UI;
2064 root 1.51
2065 root 1.113 $ROOT = new CFClient::UI::Root;
2066 root 1.51
2067     1
2068 root 1.5