ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.366
Committed: Mon Apr 23 19:17:41 2007 UTC (17 years, 1 month ago) by root
Branch: MAIN
Changes since 1.365: +3 -0 lines
Log Message:
implement support for ex cmd, retrieveing item descriptions (immediately right now, and again and again - might want to improve on this, but not sure how)

File Contents

# User Rev Content
1 root 1.340 package CFPlus::UI;
2 root 1.8
3 root 1.194 use utf8;
4 elmex 1.1 use strict;
5 root 1.18
6 root 1.74 use List::Util ();
7 root 1.284 use Event;
8 root 1.18
9 root 1.340 use CFPlus;
10 root 1.341 use CFPlus::Pod;
11 root 1.340 use CFPlus::Texture;
12 root 1.41
13 root 1.51 our ($FOCUS, $HOVER, $GRAB); # various widgets
14    
15 elmex 1.242 our $LAYOUT;
16 root 1.113 our $ROOT;
17 root 1.151 our $TOOLTIP;
18 root 1.51 our $BUTTON_STATE;
19    
20 root 1.202 our %WIDGET; # all widgets, weak-referenced
21    
22 root 1.284 our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
23 root 1.151 if (!$GRAB) {
24     for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
25 root 1.160 if (length $widget->{tooltip}) {
26 root 1.151 if ($TOOLTIP->{owner} != $widget) {
27 root 1.366 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
28 root 1.253 $TOOLTIP->hide;
29    
30 root 1.151 $TOOLTIP->{owner} = $widget;
31 root 1.366 $TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner};
32 root 1.155
33 root 1.285 return if $ENV{CFPLUS_DEBUG} & 8;
34    
35 root 1.155 my $tip = $widget->{tooltip};
36    
37     $tip = $tip->($widget) if CODE:: eq ref $tip;
38    
39 root 1.196 $TOOLTIP->set_tooltip_from ($widget);
40 root 1.252 $TOOLTIP->show;
41 root 1.151 }
42    
43     return;
44     }
45     }
46     }
47    
48     $TOOLTIP->hide;
49 root 1.366 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
50 root 1.151 delete $TOOLTIP->{owner};
51 root 1.284 });
52    
53     sub get_layout {
54     my $layout;
55    
56     for (grep { $_->{name} } values %WIDGET) {
57     my $win = $layout->{$_->{name}} = { };
58    
59     $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
60     $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
61     $win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
62     $win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
63    
64     $win->{show} = $_->{visible} && $_->{is_toplevel};
65     }
66    
67     $layout
68     }
69    
70     sub set_layout {
71     my ($layout) = @_;
72    
73     $LAYOUT = $layout;
74 root 1.151 }
75    
76 elmex 1.1 # class methods for events
77 root 1.51 sub feed_sdl_key_down_event {
78 root 1.231 $FOCUS->emit (key_down => $_[0])
79 root 1.163 if $FOCUS;
80 root 1.51 }
81    
82     sub feed_sdl_key_up_event {
83 root 1.231 $FOCUS->emit (key_up => $_[0])
84 root 1.163 if $FOCUS;
85 root 1.51 }
86    
87 root 1.330 sub check_hover {
88     my ($widget) = @_;
89    
90     if ($widget != $HOVER) {
91     my $hover = $HOVER; $HOVER = $widget;
92    
93     $hover->update if $hover && $hover->{can_hover};
94     $HOVER->update if $HOVER && $HOVER->{can_hover};
95    
96     $TOOLTIP_WATCHER->start;
97     }
98     }
99    
100 root 1.51 sub feed_sdl_button_down_event {
101     my ($ev) = @_;
102 root 1.137 my ($x, $y) = ($ev->{x}, $ev->{y});
103 root 1.51
104 root 1.339 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
105    
106     unless ($GRAB) {
107 root 1.113 my $widget = $ROOT->find_widget ($x, $y);
108 root 1.51
109     $GRAB = $widget;
110     $GRAB->update if $GRAB;
111 root 1.151
112 root 1.284 $TOOLTIP_WATCHER->cb->();
113 root 1.51 }
114    
115 root 1.330 if ($GRAB) {
116     if ($ev->{button} == 4 || $ev->{button} == 5) {
117     # mousewheel
118     $ev->{dx} = 0;
119     $ev->{dy} = $ev->{button} * 2 - 9;
120     $GRAB->emit (mouse_wheel => $ev);
121     } else {
122     $GRAB->emit (button_down => $ev)
123     }
124     }
125 root 1.51 }
126    
127     sub feed_sdl_button_up_event {
128     my ($ev) = @_;
129    
130 root 1.330 my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
131 root 1.51
132 root 1.137 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
133 root 1.51
134 root 1.330 $GRAB->emit (button_up => $ev)
135     if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
136 root 1.58
137 root 1.330 unless ($BUTTON_STATE) {
138 root 1.51 my $grab = $GRAB; undef $GRAB;
139     $grab->update if $grab;
140     $GRAB->update if $GRAB;
141 root 1.151
142 root 1.330 check_hover $widget;
143 root 1.284 $TOOLTIP_WATCHER->cb->();
144 root 1.51 }
145     }
146    
147     sub feed_sdl_motion_event {
148     my ($ev) = @_;
149 root 1.137 my ($x, $y) = ($ev->{x}, $ev->{y});
150 root 1.51
151 root 1.113 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
152 root 1.51
153 root 1.330 check_hover $widget;
154 root 1.51
155 root 1.330 $HOVER->emit (mouse_motion => $ev)
156 root 1.231 if $HOVER;
157 root 1.51 }
158 elmex 1.1
159 root 1.112 # convert position array to integers
160     sub harmonize {
161     my ($vals) = @_;
162    
163     my $rem = 0;
164    
165 root 1.116 for (@$vals) {
166 root 1.112 my $i = int $_ + $rem;
167     $rem += $_ - $i;
168     $_ = $i;
169     }
170     }
171    
172 root 1.220 sub full_refresh {
173     # make a copy, otherwise for complains about freed values.
174     my @widgets = values %WIDGET;
175    
176     $_->update
177     for @widgets;
178     }
179    
180 root 1.230 sub reconfigure_widgets {
181     # make a copy, otherwise C<for> complains about freed values.
182     my @widgets = values %WIDGET;
183    
184     $_->reconfigure
185     for @widgets;
186     }
187    
188 root 1.202 # call when resolution changes etc.
189     sub rescale_widgets {
190     my ($sx, $sy) = @_;
191    
192 root 1.230 for my $widget (values %WIDGET) {
193     if ($widget->{is_toplevel}) {
194 root 1.268 $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
195     $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
196 root 1.256
197     $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
198     $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
199     $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
200     $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
201     $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
202     $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
203    
204 root 1.268 $widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
205     $widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
206 root 1.256
207 root 1.202 }
208 root 1.230 }
209 root 1.202
210 root 1.230 reconfigure_widgets;
211 root 1.202 }
212    
213 root 1.73 #############################################################################
214    
215 root 1.340 package CFPlus::UI::Event;
216 root 1.330
217     sub xy {
218     $_[1]->coord2local ($_[0]{x}, $_[0]{y})
219     }
220    
221     #############################################################################
222    
223 root 1.340 package CFPlus::UI::Base;
224 root 1.73
225     use strict;
226    
227 root 1.340 use CFPlus::OpenGL;
228 root 1.73
229 elmex 1.1 sub new {
230     my $class = shift;
231 root 1.10
232 root 1.79 my $self = bless {
233 root 1.256 x => "center",
234     y => "center",
235 root 1.164 z => 0,
236 root 1.256 w => undef,
237     h => undef,
238 elmex 1.150 can_events => 1,
239 root 1.65 @_
240 root 1.79 }, $class;
241    
242 root 1.362 CFPlus::weaken ($CFPlus::UI::WIDGET{$self+0} = $self);
243 root 1.258
244     for (keys %$self) {
245     if (/^on_(.*)$/) {
246     $self->connect ($1 => delete $self->{$_});
247     }
248     }
249    
250 root 1.340 if (my $layout = $CFPlus::UI::LAYOUT->{$self->{name}}) {
251     $self->{x} = $layout->{x} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{x};
252     $self->{y} = $layout->{y} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{y};
253     $self->{force_w} = $layout->{w} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{w};
254     $self->{force_h} = $layout->{h} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{h};
255 root 1.256
256     $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
257     $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
258    
259 root 1.258 $self->show if $layout->{show};
260 root 1.79 }
261    
262     $self
263 elmex 1.1 }
264    
265 root 1.159 sub destroy {
266     my ($self) = @_;
267    
268     $self->hide;
269 root 1.361 $self->emit ("destroy");
270 root 1.159 %$self = ();
271     }
272    
273 root 1.134 sub show {
274     my ($self) = @_;
275 root 1.248
276 root 1.134 return if $self->{parent};
277    
278 root 1.340 $CFPlus::UI::ROOT->add ($self);
279 root 1.134 }
280    
281 root 1.246 sub set_visible {
282     my ($self) = @_;
283    
284     return if $self->{visible};
285    
286     $self->{root} = $self->{parent}{root};
287     $self->{visible} = $self->{parent}{visible} + 1;
288    
289 root 1.248 $self->emit (visibility_change => 1);
290 root 1.251
291 root 1.252 $self->realloc if !exists $self->{req_w};
292 root 1.251
293     $_->set_visible for $self->children;
294 root 1.246 }
295    
296 root 1.231 sub set_invisible {
297 root 1.134 my ($self) = @_;
298    
299 root 1.244 return unless $self->{visible};
300    
301 root 1.251 $_->set_invisible for $self->children;
302 root 1.231
303 root 1.302 delete $self->{visible};
304 root 1.241 delete $self->{root};
305 root 1.231
306 root 1.163 undef $GRAB if $GRAB == $self;
307     undef $HOVER if $HOVER == $self;
308 root 1.134
309 root 1.340 $CFPlus::UI::TOOLTIP_WATCHER->cb->()
310 root 1.251 if $TOOLTIP->{owner} == $self;
311 root 1.232
312 root 1.305 $self->emit ("focus_out");
313 root 1.244 $self->emit (visibility_change => 0);
314 root 1.231 }
315    
316 root 1.250 sub set_visibility {
317     my ($self, $visible) = @_;
318    
319     return if $self->{visible} == $visible;
320    
321     $visible ? $self->hide
322     : $self->show;
323     }
324    
325     sub toggle_visibility {
326     my ($self) = @_;
327    
328     $self->{visible}
329     ? $self->hide
330     : $self->show;
331     }
332    
333 root 1.231 sub hide {
334     my ($self) = @_;
335    
336     $self->set_invisible;
337    
338 root 1.163 $self->{parent}->remove ($self)
339     if $self->{parent};
340 root 1.134 }
341    
342 root 1.256 sub move_abs {
343 root 1.18 my ($self, $x, $y, $z) = @_;
344 root 1.128
345 root 1.296 $self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
346     $self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
347 root 1.18 $self->{z} = $z if defined $z;
348 root 1.128
349     $self->update;
350 root 1.18 }
351    
352 root 1.158 sub set_size {
353     my ($self, $w, $h) = @_;
354    
355 root 1.256 $self->{force_w} = $w;
356     $self->{force_h} = $h;
357 root 1.158
358 root 1.251 $self->realloc;
359 elmex 1.20 }
360    
361 root 1.14 sub size_request {
362 elmex 1.36 require Carp;
363 root 1.147 Carp::confess "size_request is abstract";
364 elmex 1.36 }
365    
366 root 1.311 sub baseline_shift {
367     0
368     }
369    
370 root 1.128 sub configure {
371 root 1.75 my ($self, $x, $y, $w, $h) = @_;
372    
373 root 1.141 if ($self->{aspect}) {
374 root 1.256 my ($ow, $oh) = ($w, $h);
375    
376 root 1.340 $w = List::Util::min $w, CFPlus::ceil $h * $self->{aspect};
377     $h = List::Util::min $h, CFPlus::ceil $w / $self->{aspect};
378 root 1.141
379     # use alignment to adjust x, y
380 root 1.75
381 root 1.256 $x += int 0.5 * ($ow - $w);
382     $y += int 0.5 * ($oh - $h);
383 root 1.140 }
384    
385 root 1.256 if ($self->{x} ne $x || $self->{y} ne $y) {
386 root 1.141 $self->{x} = $x;
387     $self->{y} = $y;
388     $self->update;
389     }
390 root 1.40
391 root 1.259 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
392 root 1.251 return unless $self->{visible};
393    
394 root 1.259 $self->{alloc_w} = $w;
395     $self->{alloc_h} = $h;
396    
397     $self->{root}{size_alloc}{$self+0} = $self;
398 root 1.141 }
399 root 1.75 }
400    
401 root 1.202 sub children {
402 root 1.272 # nop
403     }
404    
405     sub visible_children {
406     $_[0]->children
407 root 1.202 }
408    
409 root 1.157 sub set_max_size {
410     my ($self, $w, $h) = @_;
411    
412 root 1.281 $self->{max_w} = int $w if defined $w;
413     $self->{max_h} = int $h if defined $h;
414 root 1.280
415     $self->realloc;
416 root 1.157 }
417    
418 root 1.209 sub set_tooltip {
419     my ($self, $tooltip) = @_;
420    
421 root 1.234 $tooltip =~ s/^\s+//;
422     $tooltip =~ s/\s+$//;
423    
424     return if $self->{tooltip} eq $tooltip;
425    
426 root 1.209 $self->{tooltip} = $tooltip;
427    
428 root 1.340 if ($CFPlus::UI::TOOLTIP->{owner} == $self) {
429     delete $CFPlus::UI::TOOLTIP->{owner};
430     $CFPlus::UI::TOOLTIP_WATCHER->cb->();
431 root 1.209 }
432     }
433    
434 root 1.82 # translate global coordinates to local coordinate system
435 root 1.113 sub coord2local {
436 root 1.58 my ($self, $x, $y) = @_;
437    
438 root 1.331 Carp::confess unless $self->{parent};#d#
439    
440 root 1.191 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
441 root 1.113 }
442    
443     # translate local coordinates to global coordinate system
444     sub coord2global {
445     my ($self, $x, $y) = @_;
446    
447 root 1.332 Carp::confess unless $self->{parent};#d#
448    
449 root 1.191 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
450 root 1.58 }
451    
452 root 1.305 sub invoke_focus_in {
453 root 1.51 my ($self) = @_;
454    
455 root 1.68 return if $FOCUS == $self;
456 root 1.97 return unless $self->{can_focus};
457 root 1.68
458 root 1.317 $FOCUS = $self;
459 elmex 1.120
460 root 1.317 $self->update;
461 root 1.305
462     0
463 elmex 1.1 }
464 root 1.4
465 root 1.305 sub invoke_focus_out {
466 root 1.51 my ($self) = @_;
467 root 1.4
468 root 1.51 return unless $FOCUS == $self;
469 root 1.4
470 root 1.317 undef $FOCUS;
471 elmex 1.120
472 root 1.317 $self->update;
473 root 1.231
474 root 1.305 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
475 root 1.231 unless $FOCUS;
476 root 1.305
477     0
478 elmex 1.1 }
479 root 1.4
480 root 1.305 sub grab_focus {
481     my ($self) = @_;
482    
483 root 1.317 $FOCUS->emit ("focus_out") if $FOCUS;
484 root 1.305 $self->emit ("focus_in");
485     }
486    
487 root 1.328 sub invoke_mouse_motion { 0 }
488     sub invoke_button_up { 0 }
489     sub invoke_key_down { 0 }
490     sub invoke_key_up { 0 }
491 root 1.330 sub invoke_mouse_wheel { 0 }
492 root 1.51
493 root 1.305 sub invoke_button_down {
494 root 1.68 my ($self, $ev, $x, $y) = @_;
495    
496 root 1.305 $self->grab_focus;
497    
498 root 1.328 0
499 root 1.305 }
500    
501     sub connect {
502     my ($self, $signal, $cb) = @_;
503    
504     push @{ $self->{signal_cb}{$signal} }, $cb;
505 root 1.332
506 root 1.340 defined wantarray and CFPlus::guard {
507 root 1.332 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
508     @{ $self->{signal_cb}{$signal} };
509     }
510 root 1.305 }
511 root 1.271
512 root 1.361 sub disconnect_all {
513     my ($self, $signal) = @_;
514    
515     delete $self->{signal_cb}{$signal};
516     }
517    
518 root 1.331 my %has_coords = (
519     button_down => 1,
520     button_up => 1,
521     mouse_motion => 1,
522     mouse_wheel => 1,
523     );
524    
525 root 1.305 sub emit {
526     my ($self, $signal, @args) = @_;
527    
528 root 1.354 # I do not really like this solution, but I do not like duplication
529     # and needlessly verbose code, either.
530 root 1.330 my @append
531 root 1.331 = $has_coords{$signal}
532 root 1.330 ? $args[0]->xy ($self)
533     : ();
534    
535 root 1.329 #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
536    
537 root 1.362 for my $cb (
538     @{$self->{signal_cb}{$signal} || []}, # before
539     ($self->can ("invoke_$signal") || sub { 1 }), # closure
540     ) {
541     return $cb->($self, @args, @append) || next;
542     }
543    
544     # parent
545     $self->{parent} && $self->{parent}->emit ($signal, @args)
546 root 1.68 }
547    
548 root 1.251 sub find_widget {
549     my ($self, $x, $y) = @_;
550    
551     return () unless $self->{can_events};
552    
553     return $self
554     if $x >= $self->{x} && $x < $self->{x} + $self->{w}
555     && $y >= $self->{y} && $y < $self->{y} + $self->{h};
556    
557     ()
558     }
559    
560     sub set_parent {
561     my ($self, $parent) = @_;
562    
563 root 1.362 CFPlus::weaken ($self->{parent} = $parent);
564 root 1.251 $self->set_visible if $parent->{visible};
565     }
566    
567     sub realloc {
568     my ($self) = @_;
569    
570 root 1.252 if ($self->{visible}) {
571 root 1.259 return if $self->{root}{realloc}{$self+0};
572 root 1.251
573 root 1.259 $self->{root}{realloc}{$self+0} = $self;
574 root 1.252 $self->{root}->update;
575     } else {
576     delete $self->{req_w};
577 root 1.259 delete $self->{req_h};
578 root 1.252 }
579 root 1.251 }
580    
581     sub update {
582     my ($self) = @_;
583    
584     $self->{parent}->update
585     if $self->{parent};
586     }
587    
588 root 1.256 sub reconfigure {
589     my ($self) = @_;
590    
591     $self->realloc;
592     $self->update;
593     }
594    
595 root 1.267 # using global variables seems a bit hacky, but passing through all drawing
596     # functions seems pointless.
597     our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
598    
599 elmex 1.1 sub draw {
600 elmex 1.11 my ($self) = @_;
601    
602 root 1.68 return unless $self->{h} && $self->{w};
603    
604 root 1.268 # update screen rectangle
605 root 1.267 local $draw_x = $draw_x + $self->{x};
606     local $draw_y = $draw_y + $self->{y};
607    
608 root 1.268 # skip widgets that are entirely outside the drawing area
609     return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
610     || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
611 root 1.267
612 elmex 1.11 glPushMatrix;
613 root 1.12 glTranslate $self->{x}, $self->{y}, 0;
614 root 1.72
615 root 1.97 if ($self == $HOVER && $self->{can_hover}) {
616 root 1.278 glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
617 root 1.50 glEnable GL_BLEND;
618 root 1.278 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
619 root 1.48 glBegin GL_QUADS;
620 root 1.278 glVertex 0 , 0;
621     glVertex $self->{w}, 0;
622     glVertex $self->{w}, $self->{h};
623     glVertex 0 , $self->{h};
624 root 1.47 glEnd;
625 root 1.50 glDisable GL_BLEND;
626 root 1.47 }
627 root 1.162
628 root 1.259 if ($ENV{CFPLUS_DEBUG} & 1) {
629 root 1.162 glPushMatrix;
630     glColor 1, 1, 0, 1;
631 root 1.278 glTranslate 0.375, 0.375;
632 root 1.162 glBegin GL_LINE_LOOP;
633 root 1.234 glVertex 0 , 0;
634     glVertex $self->{w} - 1, 0;
635     glVertex $self->{w} - 1, $self->{h} - 1;
636     glVertex 0 , $self->{h} - 1;
637 root 1.162 glEnd;
638     glPopMatrix;
639 root 1.340 #CFPlus::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
640 root 1.162 }
641 root 1.278
642     $self->_draw;
643     glPopMatrix;
644 elmex 1.11 }
645    
646     sub _draw {
647 root 1.38 my ($self) = @_;
648    
649     warn "no draw defined for $self\n";
650 elmex 1.1 }
651 root 1.4
652 root 1.362 my $cntx;#d#
653 root 1.18 sub DESTROY {
654     my ($self) = @_;
655    
656 root 1.340 return if CFPlus::in_destruct;
657 root 1.324
658 root 1.302 eval { $self->destroy };
659     warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
660 root 1.361
661     delete $WIDGET{$self+0};
662 root 1.18 }
663    
664 root 1.39 #############################################################################
665    
666 root 1.340 package CFPlus::UI::DrawBG;
667 root 1.68
668 root 1.340 our @ISA = CFPlus::UI::Base::;
669 root 1.68
670     use strict;
671 root 1.340 use CFPlus::OpenGL;
672 root 1.68
673     sub new {
674     my $class = shift;
675    
676     # range [value, low, high, page]
677    
678     $class->SUPER::new (
679 root 1.209 #bg => [0, 0, 0, 0.2],
680     #active_bg => [1, 1, 1, 0.5],
681 root 1.68 @_
682     )
683     }
684    
685     sub _draw {
686     my ($self) = @_;
687    
688 root 1.209 my $color = $FOCUS == $self && $self->{active_bg}
689     ? $self->{active_bg}
690     : $self->{bg};
691    
692     if ($color && (@$color < 4 || $color->[3])) {
693     my ($w, $h) = @$self{qw(w h)};
694 root 1.68
695 root 1.209 glEnable GL_BLEND;
696 root 1.278 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
697     glColor_premultiply @$color;
698 root 1.76
699 root 1.209 glBegin GL_QUADS;
700     glVertex 0 , 0;
701     glVertex 0 , $h;
702     glVertex $w, $h;
703     glVertex $w, 0;
704     glEnd;
705 root 1.76
706 root 1.209 glDisable GL_BLEND;
707     }
708 root 1.68 }
709    
710     #############################################################################
711    
712 root 1.340 package CFPlus::UI::Empty;
713 root 1.66
714 root 1.340 our @ISA = CFPlus::UI::Base::;
715 root 1.66
716 elmex 1.150 sub new {
717     my ($class, %arg) = @_;
718     $class->SUPER::new (can_events => 0, %arg);
719     }
720    
721 root 1.66 sub size_request {
722 root 1.256 my ($self) = @_;
723    
724     ($self->{w} + 0, $self->{h} + 0)
725 root 1.66 }
726    
727 root 1.67 sub draw { }
728 root 1.66
729     #############################################################################
730    
731 root 1.340 package CFPlus::UI::Container;
732 elmex 1.15
733 root 1.340 our @ISA = CFPlus::UI::Base::;
734 elmex 1.15
735 root 1.38 sub new {
736 root 1.64 my ($class, %arg) = @_;
737    
738 root 1.272 my $children = delete $arg{children};
739 root 1.38
740 root 1.166 my $self = $class->SUPER::new (
741     children => [],
742     can_events => 0,
743     %arg,
744     );
745 root 1.272
746     $self->add (@$children)
747     if $children;
748 root 1.38
749     $self
750     }
751    
752 root 1.332 sub realloc {
753     my ($self) = @_;
754    
755     $self->{force_realloc} = 1;
756     $self->{force_size_alloc} = 1;
757     $self->SUPER::realloc;
758     }
759    
760 root 1.38 sub add {
761 root 1.188 my ($self, @widgets) = @_;
762 root 1.113
763 root 1.188 $_->set_parent ($self)
764     for @widgets;
765 root 1.38
766 root 1.113 use sort 'stable';
767 root 1.38
768 root 1.66 $self->{children} = [
769 root 1.38 sort { $a->{z} <=> $b->{z} }
770 root 1.188 @{$self->{children}}, @widgets
771 root 1.66 ];
772 root 1.38
773 root 1.251 $self->realloc;
774 root 1.38 }
775 root 1.35
776 root 1.172 sub children {
777     @{ $_[0]{children} }
778     }
779    
780 elmex 1.32 sub remove {
781 root 1.134 my ($self, $child) = @_;
782    
783     delete $child->{parent};
784 root 1.163 $child->hide;
785 root 1.38
786 root 1.134 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
787 root 1.38
788 root 1.251 $self->realloc;
789 root 1.38 }
790    
791 root 1.162 sub clear {
792     my ($self) = @_;
793    
794 root 1.163 my $children = delete $self->{children};
795     $self->{children} = [];
796 root 1.162
797 root 1.163 for (@$children) {
798     delete $_->{parent};
799     $_->hide;
800     }
801 root 1.182
802 root 1.251 $self->realloc;
803 root 1.162 }
804    
805 root 1.38 sub find_widget {
806     my ($self, $x, $y) = @_;
807    
808 root 1.45 $x -= $self->{x};
809     $y -= $self->{y};
810    
811 root 1.38 my $res;
812    
813 root 1.272 for (reverse $self->visible_children) {
814 root 1.45 $res = $_->find_widget ($x, $y)
815 root 1.38 and return $res;
816     }
817    
818 root 1.46 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
819 elmex 1.32 }
820 elmex 1.15
821 root 1.35 sub _draw {
822     my ($self) = @_;
823    
824 root 1.38 $_->draw for @{$self->{children}};
825 root 1.35 }
826 elmex 1.15
827 root 1.39 #############################################################################
828    
829 root 1.340 package CFPlus::UI::Bin;
830 elmex 1.32
831 root 1.340 our @ISA = CFPlus::UI::Container::;
832 elmex 1.32
833 root 1.66 sub new {
834     my ($class, %arg) = @_;
835    
836 root 1.340 my $child = (delete $arg{child}) || new CFPlus::UI::Empty::;
837 root 1.66
838     $class->SUPER::new (children => [$child], %arg)
839     }
840    
841     sub add {
842 root 1.134 my ($self, $child) = @_;
843 root 1.66
844 root 1.302 $self->SUPER::remove ($_) for @{ $self->{children} };
845 root 1.134 $self->SUPER::add ($child);
846 root 1.66 }
847    
848     sub remove {
849     my ($self, $widget) = @_;
850    
851     $self->SUPER::remove ($widget);
852    
853 root 1.340 $self->{children} = [new CFPlus::UI::Empty]
854 root 1.66 unless @{$self->{children}};
855     }
856    
857 root 1.39 sub child { $_[0]->{children}[0] }
858 elmex 1.32
859 root 1.38 sub size_request {
860 root 1.68 $_[0]{children}[0]->size_request
861 root 1.38 }
862 elmex 1.32
863 root 1.305 sub invoke_size_allocate {
864 root 1.259 my ($self, $w, $h) = @_;
865 root 1.42
866 root 1.128 $self->{children}[0]->configure (0, 0, $w, $h);
867 root 1.305
868     1
869 root 1.38 }
870 elmex 1.32
871 root 1.39 #############################################################################
872    
873 root 1.274 # back-buffered drawing area
874    
875 root 1.340 package CFPlus::UI::Window;
876 elmex 1.20
877 root 1.340 our @ISA = CFPlus::UI::Bin::;
878 elmex 1.20
879 root 1.340 use CFPlus::OpenGL;
880 elmex 1.20
881 root 1.42 sub new {
882 root 1.64 my ($class, %arg) = @_;
883 elmex 1.32
884 root 1.64 my $self = $class->SUPER::new (%arg);
885 elmex 1.32 }
886    
887     sub update {
888     my ($self) = @_;
889 root 1.42
890 root 1.198 $ROOT->on_post_alloc ($self => sub { $self->render_child });
891 root 1.42 $self->SUPER::update;
892 elmex 1.20 }
893    
894 root 1.305 sub invoke_size_allocate {
895 root 1.259 my ($self, $w, $h) = @_;
896 root 1.174
897 root 1.259 $self->update;
898 root 1.305
899     $self->SUPER::invoke_size_allocate ($w, $h)
900 root 1.174 }
901    
902 root 1.182 sub _render {
903 root 1.267 my ($self) = @_;
904    
905     $self->{children}[0]->draw;
906 root 1.182 }
907    
908 root 1.174 sub render_child {
909 elmex 1.20 my ($self) = @_;
910    
911 root 1.340 $self->{texture} = new_from_opengl CFPlus::Texture $self->{w}, $self->{h}, sub {
912 root 1.216 glClearColor 0, 0, 0, 0;
913 root 1.105 glClear GL_COLOR_BUFFER_BIT;
914 root 1.182
915 root 1.267 {
916 root 1.340 package CFPlus::UI::Base;
917 root 1.267
918 root 1.351 local ($draw_x, $draw_y, $draw_w, $draw_h) =
919 root 1.267 (0, 0, $self->{w}, $self->{h});
920 root 1.352
921     $self->_render;
922 root 1.267 }
923 root 1.105 };
924 elmex 1.36 }
925    
926 elmex 1.20 sub _draw {
927     my ($self) = @_;
928    
929     my $tex = $self->{texture}
930     or return;
931    
932     glEnable GL_TEXTURE_2D;
933 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
934 root 1.278 glColor 0, 0, 0, 1;
935 elmex 1.20
936 root 1.344 $tex->draw_quad_alpha_premultiplied (0, 0);
937 elmex 1.20
938     glDisable GL_TEXTURE_2D;
939     }
940    
941 root 1.39 #############################################################################
942    
943 root 1.340 package CFPlus::UI::ViewPort;
944 root 1.125
945 root 1.340 our @ISA = CFPlus::UI::Window::;
946 root 1.125
947 root 1.234 sub new {
948     my $class = shift;
949    
950     $class->SUPER::new (
951     scroll_x => 0,
952     scroll_y => 1,
953     @_,
954     )
955     }
956    
957 root 1.125 sub size_request {
958     my ($self) = @_;
959    
960 root 1.259 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
961 root 1.247
962     $w = 10 if $self->{scroll_x};
963     $h = 10 if $self->{scroll_y};
964 root 1.125
965 root 1.247 ($w, $h)
966 root 1.125 }
967    
968 root 1.305 sub invoke_size_allocate {
969 root 1.259 my ($self, $w, $h) = @_;
970    
971     my $child = $self->child;
972 root 1.182
973 root 1.259 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
974     $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
975 root 1.234
976     $self->child->configure (0, 0, $w, $h);
977 root 1.182 $self->update;
978 root 1.305
979     1
980 root 1.182 }
981    
982     sub set_offset {
983     my ($self, $x, $y) = @_;
984    
985     $self->{view_x} = int $x;
986     $self->{view_y} = int $y;
987    
988     $self->update;
989     }
990    
991 root 1.191 # hmm, this does not work for topleft of $self... but we should not ask for that
992     sub coord2local {
993     my ($self, $x, $y) = @_;
994    
995     $self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
996     }
997    
998     sub coord2global {
999 root 1.184 my ($self, $x, $y) = @_;
1000    
1001 root 1.191 $x = List::Util::min $self->{w}, $x - $self->{view_x};
1002     $y = List::Util::min $self->{h}, $y - $self->{view_y};
1003    
1004     $self->SUPER::coord2global ($x, $y)
1005 root 1.184 }
1006    
1007     sub find_widget {
1008     my ($self, $x, $y) = @_;
1009    
1010     if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
1011     && $y >= $self->{y} && $y < $self->{y} + $self->{h}
1012     ) {
1013     $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
1014     } else {
1015 root 1.340 $self->CFPlus::UI::Base::find_widget ($x, $y)
1016 root 1.184 }
1017     }
1018    
1019 root 1.182 sub _render {
1020 root 1.125 my ($self) = @_;
1021    
1022 root 1.340 local $CFPlus::UI::Base::draw_x = $CFPlus::UI::Base::draw_x - $self->{view_x};
1023     local $CFPlus::UI::Base::draw_y = $CFPlus::UI::Base::draw_y - $self->{view_y};
1024 root 1.267
1025 root 1.340 CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
1026 root 1.182
1027     $self->SUPER::_render;
1028     }
1029    
1030     #############################################################################
1031    
1032 root 1.340 package CFPlus::UI::ScrolledWindow;
1033 root 1.182
1034 root 1.340 our @ISA = CFPlus::UI::HBox::;
1035 root 1.182
1036     sub new {
1037 root 1.273 my ($class, %arg) = @_;
1038    
1039     my $child = delete $arg{child};
1040 root 1.182
1041     my $self;
1042    
1043 root 1.340 my $slider = new CFPlus::UI::Slider
1044 root 1.243 vertical => 1,
1045     range => [0, 0, 1, 0.01], # HACK fix
1046     on_changed => sub {
1047 root 1.229 $self->{vp}->set_offset (0, $_[1]);
1048 root 1.182 },
1049     ;
1050    
1051     $self = $class->SUPER::new (
1052 root 1.340 vp => (new CFPlus::UI::ViewPort expand => 1),
1053 root 1.330 can_events => 1,
1054     slider => $slider,
1055 root 1.273 %arg,
1056 root 1.182 );
1057    
1058 root 1.273 $self->SUPER::add ($self->{vp}, $self->{slider});
1059     $self->add ($child) if $child;
1060 root 1.182
1061     $self
1062 root 1.125 }
1063    
1064 root 1.314 #TODO# update range on size_allocate depending on child
1065    
1066 root 1.273 sub add {
1067     my ($self, $widget) = @_;
1068    
1069     $self->{vp}->add ($self->{child} = $widget);
1070     }
1071    
1072 root 1.330 sub invoke_mouse_wheel {
1073 root 1.328 my ($self, $ev) = @_;
1074    
1075 root 1.330 return 0 unless $ev->{dy}; # only vertical movements
1076    
1077     $self->{slider}->emit (mouse_wheel => $ev);
1078    
1079     1
1080 root 1.328 }
1081    
1082 root 1.314 sub update_slider {
1083     my ($self) = @_;
1084    
1085     $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
1086     }
1087    
1088 root 1.239 sub update {
1089     my ($self) = @_;
1090    
1091     $self->SUPER::update;
1092    
1093 root 1.314 $self->update_slider;
1094 root 1.239 }
1095    
1096 root 1.305 sub invoke_size_allocate {
1097 root 1.259 my ($self, $w, $h) = @_;
1098 root 1.229
1099 root 1.314 $self->update_slider;
1100 root 1.305
1101     $self->SUPER::invoke_size_allocate ($w, $h)
1102 root 1.229 }
1103    
1104 root 1.125 #############################################################################
1105    
1106 root 1.340 package CFPlus::UI::Frame;
1107 elmex 1.15
1108 root 1.340 our @ISA = CFPlus::UI::Bin::;
1109 elmex 1.15
1110 root 1.340 use CFPlus::OpenGL;
1111 elmex 1.15
1112 root 1.199 sub new {
1113     my $class = shift;
1114    
1115     $class->SUPER::new (
1116     bg => undef,
1117     @_,
1118     )
1119     }
1120    
1121     sub _draw {
1122     my ($self) = @_;
1123    
1124     if ($self->{bg}) {
1125     my ($w, $h) = @$self{qw(w h)};
1126    
1127     glEnable GL_BLEND;
1128 root 1.278 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1129     glColor_premultiply @{ $self->{bg} };
1130 root 1.199
1131     glBegin GL_QUADS;
1132     glVertex 0 , 0;
1133     glVertex 0 , $h;
1134     glVertex $w, $h;
1135     glVertex $w, 0;
1136     glEnd;
1137    
1138     glDisable GL_BLEND;
1139     }
1140    
1141     $self->SUPER::_draw;
1142     }
1143    
1144 root 1.39 #############################################################################
1145    
1146 root 1.340 package CFPlus::UI::FancyFrame;
1147 elmex 1.31
1148 root 1.340 our @ISA = CFPlus::UI::Bin::;
1149 elmex 1.31
1150 root 1.340 use CFPlus::OpenGL;
1151 elmex 1.31
1152 root 1.346 sub new {
1153     my ($class, %arg) = @_;
1154    
1155     if ((exists $arg{label}) && !ref $arg{label}) {
1156     $arg{label} = new CFPlus::UI::Label
1157     align => 1,
1158 root 1.347 valign => 0,
1159 root 1.346 text => $arg{label},
1160     fontsize => ($arg{border} || 0.8) * 0.75;
1161     }
1162    
1163     my $self = $class->SUPER::new (
1164     # label => "",
1165     fg => [0.6, 0.3, 0.1],
1166     border => 0.8,
1167     style => 'single',
1168     %arg,
1169     );
1170    
1171     $self
1172     }
1173    
1174     sub add {
1175     my ($self, @widgets) = @_;
1176    
1177     $self->SUPER::add (@widgets);
1178     $self->CFPlus::UI::Container::add ($self->{label}) if $self->{label};
1179     }
1180    
1181     sub border {
1182     int $_[0]{border} * $::FONTSIZE
1183     }
1184    
1185     sub size_request {
1186     my ($self) = @_;
1187    
1188     ($self->{label_w}, undef) = $self->{label}->size_request
1189     if $self->{label};
1190    
1191     my ($w, $h) = $self->SUPER::size_request;
1192    
1193     (
1194     $w + $self->border * 2,
1195     $h + $self->border * 2,
1196     )
1197     }
1198    
1199     sub invoke_size_allocate {
1200     my ($self, $w, $h) = @_;
1201    
1202     my $border = $self->border;
1203    
1204     $w -= List::Util::max 0, $border * 2;
1205     $h -= List::Util::max 0, $border * 2;
1206    
1207     if (my $label = $self->{label}) {
1208     $label->{w} = List::Util::max 0, List::Util::min $self->{label_w}, $w - $border * 2;
1209     $label->{h} = List::Util::min $h, $border;
1210     $label->invoke_size_allocate ($label->{w}, $label->{h});
1211     }
1212    
1213     $self->child->configure ($border, $border, $w, $h);
1214    
1215     1
1216     }
1217    
1218     sub _draw {
1219     my ($self) = @_;
1220    
1221     my $child = $self->{children}[0];
1222    
1223     my $border = $self->border;
1224     my ($w, $h) = ($self->{w}, $self->{h});
1225    
1226     $child->draw;
1227    
1228     glColor @{$self->{fg}};
1229     glBegin GL_LINE_STRIP;
1230     glVertex $border * 1.5 , $border * 0.5 + 0.5;
1231     glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5;
1232     glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
1233     glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
1234     glVertex $w - $border * 0.5 + 0.5, $border * 0.5 + 0.5;
1235     glVertex $self->{label} ? $border * 2 + $self->{label}{w} : $border * 1.5, $border * 0.5 + 0.5;
1236     glEnd;
1237    
1238     if ($self->{label}) {
1239     glTranslate $border * 2, 0;
1240     $self->{label}->_draw;
1241     }
1242     }
1243    
1244     #############################################################################
1245    
1246     package CFPlus::UI::Toplevel;
1247    
1248     our @ISA = CFPlus::UI::Bin::;
1249    
1250     use CFPlus::OpenGL;
1251    
1252 root 1.255 my $bg =
1253 root 1.340 new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png",
1254 root 1.255 mipmap => 1, wrap => 1;
1255    
1256     my @border =
1257 root 1.340 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1258 root 1.255 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1259 elmex 1.34
1260 root 1.97 sub new {
1261 root 1.269 my ($class, %arg) = @_;
1262    
1263 root 1.141 my $self = $class->SUPER::new (
1264 root 1.230 bg => [1, 1, 1, 1],
1265     border_bg => [1, 1, 1, 1],
1266     border => 0.6,
1267     can_events => 1,
1268 root 1.326 min_w => 64,
1269     min_h => 32,
1270 root 1.269 %arg,
1271 root 1.141 );
1272    
1273 root 1.340 $self->{title_widget} = new CFPlus::UI::Label
1274 root 1.141 align => 0,
1275     valign => 1,
1276 root 1.302 text => $self->{title},
1277     fontsize => $self->{border},
1278     if exists $self->{title};
1279 root 1.141
1280 root 1.305 if ($self->{has_close_button}) {
1281     $self->{close_button} =
1282 root 1.340 new CFPlus::UI::ImageButton
1283 root 1.310 path => 'x1_close.png',
1284 root 1.317 on_activate => sub { $self->emit ("delete") };
1285 elmex 1.303
1286 root 1.340 $self->CFPlus::UI::Container::add ($self->{close_button});
1287 elmex 1.303 }
1288    
1289 root 1.141 $self
1290 root 1.97 }
1291    
1292 root 1.269 sub add {
1293     my ($self, @widgets) = @_;
1294    
1295     $self->SUPER::add (@widgets);
1296 root 1.340 $self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button};
1297     $self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1298 root 1.269 }
1299    
1300 root 1.134 sub border {
1301     int $_[0]{border} * $::FONTSIZE
1302     }
1303    
1304 elmex 1.34 sub size_request {
1305     my ($self) = @_;
1306 root 1.39
1307 root 1.302 $self->{title_widget}->size_request
1308     if $self->{title_widget};
1309 root 1.269
1310 root 1.305 $self->{close_button}->size_request
1311     if $self->{close_button};
1312 elmex 1.303
1313 root 1.78 my ($w, $h) = $self->SUPER::size_request;
1314 elmex 1.34
1315 root 1.97 (
1316 root 1.134 $w + $self->border * 2,
1317     $h + $self->border * 2,
1318 root 1.97 )
1319 elmex 1.36 }
1320    
1321 root 1.305 sub invoke_size_allocate {
1322 root 1.259 my ($self, $w, $h) = @_;
1323 root 1.40
1324 root 1.302 if ($self->{title_widget}) {
1325     $self->{title_widget}{w} = $w;
1326     $self->{title_widget}{h} = $h;
1327 root 1.305 $self->{title_widget}->invoke_size_allocate ($w, $h);
1328 root 1.269 }
1329 elmex 1.36
1330 root 1.269 my $border = $self->border;
1331 root 1.141
1332 root 1.269 $h -= List::Util::max 0, $border * 2;
1333     $w -= List::Util::max 0, $border * 2;
1334 elmex 1.303
1335 root 1.269 $self->child->configure ($border, $border, $w, $h);
1336 elmex 1.303
1337 root 1.305 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1338     if $self->{close_button};
1339    
1340     1
1341 elmex 1.34 }
1342    
1343 root 1.317 sub invoke_delete {
1344     my ($self) = @_;
1345    
1346     $self->hide;
1347    
1348     1
1349     }
1350    
1351 root 1.305 sub invoke_button_down {
1352 root 1.77 my ($self, $ev, $x, $y) = @_;
1353    
1354 root 1.176 my ($w, $h) = @$self{qw(w h)};
1355 root 1.134 my $border = $self->border;
1356    
1357 root 1.176 my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
1358     my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
1359 root 1.77
1360 root 1.176 if ($lr & $td) {
1361     my ($wx, $wy) = ($self->{x}, $self->{y});
1362 root 1.139 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1363 root 1.77 my ($bw, $bh) = ($self->{w}, $self->{h});
1364    
1365 root 1.176 my $mx = $x < $border;
1366     my $my = $y < $border;
1367    
1368 root 1.77 $self->{motion} = sub {
1369     my ($ev, $x, $y) = @_;
1370    
1371 root 1.176 my $dx = $ev->{x} - $ox;
1372     my $dy = $ev->{y} - $oy;
1373 root 1.77
1374 root 1.256 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1375     $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1376    
1377 root 1.277 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1378 root 1.251 $self->realloc;
1379 root 1.77 };
1380    
1381 root 1.176 } elsif ($lr ^ $td) {
1382 root 1.139 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1383 root 1.77 my ($bx, $by) = ($self->{x}, $self->{y});
1384    
1385     $self->{motion} = sub {
1386     my ($ev, $x, $y) = @_;
1387    
1388 root 1.139 ($x, $y) = ($ev->{x}, $ev->{y});
1389 root 1.77
1390 root 1.256 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1391 root 1.277 # HACK: the next line is required to enforce placement
1392 root 1.305 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1393 root 1.77 };
1394 root 1.271 } else {
1395     return 0;
1396 root 1.77 }
1397 root 1.271
1398     1
1399 root 1.77 }
1400    
1401 root 1.305 sub invoke_button_up {
1402 root 1.77 my ($self, $ev, $x, $y) = @_;
1403    
1404 root 1.305 ! ! delete $self->{motion}
1405 root 1.77 }
1406    
1407 root 1.305 sub invoke_mouse_motion {
1408 root 1.77 my ($self, $ev, $x, $y) = @_;
1409    
1410     $self->{motion}->($ev, $x, $y) if $self->{motion};
1411 root 1.271
1412 root 1.305 ! ! $self->{motion}
1413 root 1.77 }
1414    
1415 root 1.339 sub invoke_visibility_change {
1416     my ($self, $visible) = @_;
1417    
1418     delete $self->{motion} unless $visible;
1419    
1420     0
1421     }
1422    
1423 elmex 1.34 sub _draw {
1424     my ($self) = @_;
1425    
1426 root 1.269 my $child = $self->{children}[0];
1427    
1428 root 1.97 my ($w, $h ) = ($self->{w}, $self->{h});
1429 root 1.269 my ($cw, $ch) = ($child->{w}, $child->{h});
1430 elmex 1.34
1431     glEnable GL_TEXTURE_2D;
1432 root 1.97 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1433 elmex 1.34
1434 root 1.134 my $border = $self->border;
1435    
1436 root 1.97 glColor @{ $self->{border_bg} };
1437 root 1.255 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1438     $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1439     $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1440     $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1441 elmex 1.34
1442 root 1.177 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1443 root 1.255 glColor @{ $self->{bg} };
1444 root 1.76
1445 root 1.177 # TODO: repeat texture not scale
1446 root 1.255 # solve this better(?)
1447     $bg->{s} = $cw / $bg->{w};
1448     $bg->{t} = $ch / $bg->{h};
1449 root 1.197 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1450     }
1451 elmex 1.34
1452 root 1.197 glDisable GL_TEXTURE_2D;
1453 elmex 1.36
1454 root 1.269 $child->draw;
1455 root 1.177
1456 root 1.302 if ($self->{title_widget}) {
1457 root 1.269 glTranslate 0, $border - $self->{h};
1458 root 1.302 $self->{title_widget}->_draw;
1459 elmex 1.303
1460     glTranslate 0, - ($border - $self->{h});
1461 root 1.269 }
1462 elmex 1.303
1463 root 1.305 $self->{close_button}->draw
1464     if $self->{close_button};
1465 elmex 1.34 }
1466 elmex 1.31
1467 root 1.39 #############################################################################
1468    
1469 root 1.340 package CFPlus::UI::Table;
1470 elmex 1.15
1471 root 1.340 our @ISA = CFPlus::UI::Base::;
1472 elmex 1.15
1473 root 1.75 use List::Util qw(max sum);
1474    
1475 root 1.340 use CFPlus::OpenGL;
1476 elmex 1.15
1477 root 1.78 sub new {
1478     my $class = shift;
1479    
1480     $class->SUPER::new (
1481     col_expand => [],
1482 root 1.234 @_,
1483 root 1.78 )
1484     }
1485    
1486 root 1.236 sub children {
1487     grep $_, map @$_, grep $_, @{ $_[0]{children} }
1488     }
1489    
1490 elmex 1.15 sub add {
1491 root 1.332 my ($self) = shift;
1492 elmex 1.32
1493 root 1.332 while (@_) {
1494     my ($x, $y, $child) = splice @_, 0, 3, ();
1495     $child->set_parent ($self);
1496     $self->{children}[$y][$x] = $child;
1497     }
1498 root 1.75
1499 root 1.332 $self->{force_realloc} = 1;
1500     $self->{force_size_alloc} = 1;
1501 root 1.251 $self->realloc;
1502 root 1.172 }
1503    
1504 root 1.302 sub remove {
1505     my ($self, $child) = @_;
1506    
1507     # TODO: not yet implemented
1508     }
1509    
1510 root 1.236 # TODO: move to container class maybe? send children a signal on removal?
1511 root 1.115 sub clear {
1512     my ($self) = @_;
1513    
1514 root 1.172 my @children = $self->children;
1515     delete $self->{children};
1516 root 1.163
1517 root 1.172 for (@children) {
1518 root 1.163 delete $_->{parent};
1519     $_->hide;
1520     }
1521    
1522 root 1.251 $self->realloc;
1523 root 1.115 }
1524    
1525 root 1.75 sub get_wh {
1526     my ($self) = @_;
1527    
1528     my (@w, @h);
1529 elmex 1.15
1530 root 1.75 for my $y (0 .. $#{$self->{children}}) {
1531     my $row = $self->{children}[$y]
1532     or next;
1533 elmex 1.15
1534 root 1.75 for my $x (0 .. $#$row) {
1535     my $widget = $row->[$x]
1536     or next;
1537 root 1.149 my ($w, $h) = @$widget{qw(req_w req_h)};
1538 elmex 1.15
1539 root 1.75 $w[$x] = max $w[$x], $w;
1540     $h[$y] = max $h[$y], $h;
1541 elmex 1.17 }
1542 elmex 1.15 }
1543 root 1.75
1544     (\@w, \@h)
1545 elmex 1.15 }
1546    
1547     sub size_request {
1548     my ($self) = @_;
1549    
1550 root 1.75 my ($ws, $hs) = $self->get_wh;
1551 elmex 1.15
1552 root 1.75 (
1553 root 1.78 (sum @$ws),
1554     (sum @$hs),
1555 root 1.75 )
1556     }
1557    
1558 root 1.305 sub invoke_size_allocate {
1559 root 1.259 my ($self, $w, $h) = @_;
1560 root 1.75
1561     my ($ws, $hs) = $self->get_wh;
1562    
1563 root 1.238 my $req_w = (sum @$ws) || 1;
1564     my $req_h = (sum @$hs) || 1;
1565 root 1.78
1566     # TODO: nicer code && do row_expand
1567     my @col_expand = @{$self->{col_expand}};
1568     @col_expand = (1) x @$ws unless @col_expand;
1569     my $col_expand = (sum @col_expand) || 1;
1570 elmex 1.15
1571 root 1.75 # linearly scale sizes
1572 root 1.78 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1573     $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1574 elmex 1.15
1575 root 1.340 CFPlus::UI::harmonize $ws;
1576     CFPlus::UI::harmonize $hs;
1577 root 1.106
1578 root 1.75 my $y;
1579 elmex 1.15
1580 root 1.75 for my $r (0 .. $#{$self->{children}}) {
1581     my $row = $self->{children}[$r]
1582     or next;
1583 elmex 1.15
1584     my $x = 0;
1585 root 1.75 my $row_h = $hs->[$r];
1586    
1587     for my $c (0 .. $#$row) {
1588     my $col_w = $ws->[$c];
1589 elmex 1.15
1590 root 1.83 if (my $widget = $row->[$c]) {
1591 root 1.128 $widget->configure ($x, $y, $col_w, $row_h);
1592 root 1.83 }
1593 elmex 1.15
1594 root 1.75 $x += $col_w;
1595 elmex 1.15 }
1596    
1597 root 1.75 $y += $row_h;
1598     }
1599    
1600 root 1.305 1
1601 root 1.75 }
1602    
1603 root 1.76 sub find_widget {
1604     my ($self, $x, $y) = @_;
1605    
1606     $x -= $self->{x};
1607     $y -= $self->{y};
1608    
1609     my $res;
1610    
1611     for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
1612     $res = $_->find_widget ($x, $y)
1613     and return $res;
1614     }
1615    
1616     $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
1617     }
1618    
1619 root 1.75 sub _draw {
1620     my ($self) = @_;
1621    
1622     for (grep $_, @{$self->{children}}) {
1623     $_->draw for grep $_, @$_;
1624 elmex 1.15 }
1625     }
1626    
1627 root 1.39 #############################################################################
1628    
1629 root 1.340 package CFPlus::UI::Box;
1630 root 1.76
1631 root 1.340 our @ISA = CFPlus::UI::Container::;
1632 root 1.76
1633     sub size_request {
1634     my ($self) = @_;
1635    
1636 root 1.246 $self->{vertical}
1637     ? (
1638     (List::Util::max map $_->{req_w}, @{$self->{children}}),
1639     (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1640     )
1641     : (
1642     (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1643     (List::Util::max map $_->{req_h}, @{$self->{children}}),
1644     )
1645 root 1.76 }
1646    
1647 root 1.305 sub invoke_size_allocate {
1648 root 1.259 my ($self, $w, $h) = @_;
1649 root 1.76
1650 root 1.246 my $space = $self->{vertical} ? $h : $w;
1651 root 1.310 my @children = $self->visible_children;
1652 root 1.76
1653 root 1.247 my @req;
1654 root 1.76
1655 root 1.247 if ($self->{homogeneous}) {
1656 root 1.310 @req = ($space / (@children || 1)) x @children;
1657 root 1.76 } else {
1658 root 1.310 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1659 root 1.247 my $req = List::Util::sum @req;
1660    
1661     if ($req > $space) {
1662     # ah well, not enough space
1663     $_ *= $space / $req for @req;
1664     } else {
1665 root 1.310 my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1666 root 1.247
1667     $space = ($space - $req) / $expand; # remaining space to give away
1668    
1669 root 1.310 $req[$_] += $space * $children[$_]{expand}
1670     for 0 .. $#children;
1671 root 1.247 }
1672 root 1.76 }
1673    
1674 root 1.340 CFPlus::UI::harmonize \@req;
1675 root 1.112
1676 root 1.246 my $pos = 0;
1677 root 1.310 for (0 .. $#children) {
1678 root 1.246 my $alloc = $req[$_];
1679 root 1.310 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1680 root 1.76
1681 root 1.246 $pos += $alloc;
1682 root 1.76 }
1683 root 1.125
1684     1
1685 root 1.76 }
1686    
1687     #############################################################################
1688    
1689 root 1.340 package CFPlus::UI::HBox;
1690 elmex 1.15
1691 root 1.340 our @ISA = CFPlus::UI::Box::;
1692 root 1.76
1693 root 1.246 sub new {
1694     my $class = shift;
1695 elmex 1.15
1696 root 1.246 $class->SUPER::new (
1697     vertical => 0,
1698     @_,
1699 root 1.43 )
1700     }
1701    
1702 root 1.246 #############################################################################
1703 root 1.68
1704 root 1.340 package CFPlus::UI::VBox;
1705 root 1.193
1706 root 1.340 our @ISA = CFPlus::UI::Box::;
1707 root 1.68
1708 root 1.246 sub new {
1709     my $class = shift;
1710 root 1.68
1711 root 1.246 $class->SUPER::new (
1712     vertical => 1,
1713     @_,
1714     )
1715 elmex 1.36 }
1716    
1717 root 1.39 #############################################################################
1718    
1719 root 1.340 package CFPlus::UI::Label;
1720 root 1.10
1721 root 1.340 our @ISA = CFPlus::UI::DrawBG::;
1722 root 1.12
1723 root 1.340 use CFPlus::OpenGL;
1724 root 1.10
1725     sub new {
1726 root 1.64 my ($class, %arg) = @_;
1727 root 1.51
1728 root 1.59 my $self = $class->SUPER::new (
1729 root 1.164 fg => [1, 1, 1],
1730 root 1.209 #bg => none
1731     #active_bg => none
1732 root 1.164 #font => default_font
1733 root 1.194 #text => initial text
1734     #markup => initial narkup
1735 root 1.213 #max_w => maximum pixel width
1736 root 1.343 #style => 0, # render flags
1737 root 1.213 ellipsise => 3, # end
1738 root 1.340 layout => (new CFPlus::Layout),
1739 root 1.164 fontsize => 1,
1740     align => -1,
1741     valign => -1,
1742 root 1.258 padding_x => 2,
1743     padding_y => 2,
1744 elmex 1.150 can_events => 0,
1745 root 1.64 %arg
1746 root 1.59 );
1747 root 1.10
1748 root 1.141 if (exists $self->{template}) {
1749 root 1.340 my $layout = new CFPlus::Layout;
1750 root 1.141 $layout->set_text (delete $self->{template});
1751     $self->{template} = $layout;
1752     }
1753 root 1.121
1754 root 1.194 if (exists $self->{markup}) {
1755     $self->set_markup (delete $self->{markup});
1756     } else {
1757     $self->set_text (delete $self->{text});
1758     }
1759 root 1.10
1760     $self
1761     }
1762    
1763 root 1.173 sub update {
1764     my ($self) = @_;
1765    
1766     delete $self->{texture};
1767     $self->SUPER::update;
1768     }
1769    
1770 root 1.282 sub realloc {
1771     my ($self) = @_;
1772    
1773     delete $self->{ox};
1774     $self->SUPER::realloc;
1775     }
1776    
1777 elmex 1.15 sub set_text {
1778     my ($self, $text) = @_;
1779 root 1.28
1780 root 1.173 return if $self->{text} eq "T$text";
1781     $self->{text} = "T$text";
1782    
1783 root 1.121 $self->{layout}->set_text ($text);
1784 root 1.288
1785 root 1.289 delete $self->{size_req};
1786 root 1.251 $self->realloc;
1787 root 1.252 $self->update;
1788 elmex 1.15 }
1789    
1790 root 1.121 sub set_markup {
1791     my ($self, $markup) = @_;
1792    
1793 root 1.173 return if $self->{text} eq "M$markup";
1794     $self->{text} = "M$markup";
1795    
1796 root 1.194 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1797    
1798 root 1.121 $self->{layout}->set_markup ($markup);
1799 root 1.288
1800 root 1.289 delete $self->{size_req};
1801 root 1.251 $self->realloc;
1802 root 1.252 $self->update;
1803 elmex 1.15 }
1804    
1805 root 1.14 sub size_request {
1806     my ($self) = @_;
1807    
1808 root 1.289 $self->{size_req} ||= do {
1809 root 1.282 $self->{layout}->set_font ($self->{font}) if $self->{font};
1810     $self->{layout}->set_width ($self->{max_w} || -1);
1811     $self->{layout}->set_ellipsise ($self->{ellipsise});
1812     $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1813     $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1814    
1815     my ($w, $h) = $self->{layout}->size;
1816 root 1.121
1817 root 1.282 if (exists $self->{template}) {
1818     $self->{template}->set_font ($self->{font}) if $self->{font};
1819 root 1.323 $self->{template}->set_width ($self->{max_w} || -1);
1820 root 1.282 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1821 root 1.76
1822 root 1.282 my ($w2, $h2) = $self->{template}->size;
1823 root 1.141
1824 root 1.282 $w = List::Util::max $w, $w2;
1825     $h = List::Util::max $h, $h2;
1826     }
1827 root 1.141
1828 root 1.289 [$w, $h]
1829     };
1830    
1831     @{ $self->{size_req} }
1832 root 1.59 }
1833 root 1.51
1834 root 1.311 sub baseline_shift {
1835     $_[0]{layout}->descent
1836     }
1837    
1838 root 1.305 sub invoke_size_allocate {
1839 root 1.259 my ($self, $w, $h) = @_;
1840 root 1.68
1841 root 1.269 delete $self->{ox};
1842    
1843 root 1.264 delete $self->{texture}
1844 root 1.266 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1845 root 1.305
1846     1
1847 root 1.14 }
1848    
1849 elmex 1.146 sub set_fontsize {
1850     my ($self, $fontsize) = @_;
1851    
1852     $self->{fontsize} = $fontsize;
1853 root 1.316 delete $self->{size_req};
1854 root 1.152 delete $self->{texture};
1855 root 1.186
1856 root 1.251 $self->realloc;
1857 elmex 1.146 }
1858    
1859 root 1.289 sub reconfigure {
1860     my ($self) = @_;
1861    
1862     delete $self->{size_req};
1863 root 1.320 delete $self->{texture};
1864 root 1.289
1865     $self->SUPER::reconfigure;
1866     }
1867    
1868 elmex 1.11 sub _draw {
1869 root 1.10 my ($self) = @_;
1870    
1871 root 1.209 $self->SUPER::_draw; # draw background, if applicable
1872    
1873 root 1.320 my $size = $self->{texture} ||= do {
1874 root 1.194 $self->{layout}->set_foreground (@{$self->{fg}});
1875 root 1.157 $self->{layout}->set_font ($self->{font}) if $self->{font};
1876 root 1.59 $self->{layout}->set_width ($self->{w});
1877 root 1.213 $self->{layout}->set_ellipsise ($self->{ellipsise});
1878     $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1879     $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1880 root 1.194
1881 root 1.323 [$self->{layout}->size]
1882 root 1.269 };
1883 root 1.194
1884 root 1.269 unless (exists $self->{ox}) {
1885 root 1.258 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1886 root 1.320 : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1887     : ($self->{w} - $size->[0]) * 0.5);
1888 root 1.208
1889 root 1.258 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1890 root 1.320 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1891     : ($self->{h} - $size->[1]) * 0.5);
1892 root 1.59 };
1893 root 1.10
1894 root 1.320 my $w = List::Util::min $self->{w} + 4, $size->[0];
1895     my $h = List::Util::min $self->{h} + 2, $size->[1];
1896 root 1.294
1897 root 1.343 $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1898 root 1.10 }
1899    
1900 root 1.39 #############################################################################
1901    
1902 root 1.340 package CFPlus::UI::EntryBase;
1903 elmex 1.31
1904 root 1.340 our @ISA = CFPlus::UI::Label::;
1905 elmex 1.31
1906 root 1.340 use CFPlus::OpenGL;
1907 elmex 1.31
1908 root 1.68 sub new {
1909     my $class = shift;
1910    
1911     $class->SUPER::new (
1912 root 1.164 fg => [1, 1, 1],
1913     bg => [0, 0, 0, 0.2],
1914     active_bg => [1, 1, 1, 0.5],
1915     active_fg => [0, 0, 0],
1916     can_hover => 1,
1917     can_focus => 1,
1918     valign => 0,
1919 elmex 1.150 can_events => 1,
1920 root 1.358 ellipsise => 0,
1921 root 1.225 #text => ...
1922 root 1.291 #hidden => "*",
1923 root 1.68 @_
1924     )
1925     }
1926    
1927     sub _set_text {
1928     my ($self, $text) = @_;
1929    
1930 root 1.121 delete $self->{cur_h};
1931    
1932     return if $self->{text} eq $text;
1933 elmex 1.100
1934 root 1.68 $self->{last_activity} = $::NOW;
1935     $self->{text} = $text;
1936 root 1.72
1937     $text =~ s/./*/g if $self->{hidden};
1938 root 1.121 $self->{layout}->set_text ("$text ");
1939 root 1.289 delete $self->{size_req};
1940 root 1.72
1941 root 1.305 $self->emit (changed => $self->{text});
1942 root 1.283
1943     $self->realloc;
1944 root 1.276 $self->update;
1945 root 1.121 }
1946 root 1.68
1947 root 1.194 sub set_text {
1948     my ($self, $text) = @_;
1949    
1950     $self->{cursor} = length $text;
1951     $self->_set_text ($text);
1952     }
1953    
1954 root 1.121 sub get_text {
1955     $_[0]{text}
1956 root 1.68 }
1957    
1958     sub size_request {
1959     my ($self) = @_;
1960    
1961     my ($w, $h) = $self->SUPER::size_request;
1962    
1963     ($w + 1, $h) # add 1 for cursor
1964     }
1965    
1966 root 1.305 sub invoke_key_down {
1967 elmex 1.31 my ($self, $ev) = @_;
1968    
1969 root 1.137 my $mod = $ev->{mod};
1970     my $sym = $ev->{sym};
1971     my $uni = $ev->{unicode};
1972 elmex 1.31
1973     my $text = $self->get_text;
1974    
1975 root 1.200 if ($uni == 8) {
1976 root 1.68 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1977 root 1.200 } elsif ($uni == 127) {
1978 root 1.68 substr $text, $self->{cursor}, 1, "";
1979 root 1.340 } elsif ($sym == CFPlus::SDLK_LEFT) {
1980 root 1.68 --$self->{cursor} if $self->{cursor};
1981 root 1.340 } elsif ($sym == CFPlus::SDLK_RIGHT) {
1982 root 1.68 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1983 root 1.340 } elsif ($sym == CFPlus::SDLK_HOME) {
1984 root 1.363 # what a hack
1985     $self->{cursor} =
1986     (substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
1987     ? length $1
1988     : 0;
1989 root 1.340 } elsif ($sym == CFPlus::SDLK_END) {
1990 root 1.363 # uh, again
1991     $self->{cursor} =
1992     (substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
1993     ? $self->{cursor} + length $1
1994     : length $self->{text};
1995 root 1.360 } elsif ($uni == 21) { # ctrl-u
1996 root 1.348 $text = "";
1997 root 1.349 $self->{cursor} = 0;
1998 root 1.200 } elsif ($uni == 27) {
1999 root 1.305 $self->emit ('escape');
2000 root 1.363 } elsif ($uni == 0x0d) {
2001     substr $text, $self->{cursor}++, 0, "\012";
2002     } elsif ($uni >= 0x20) {
2003 root 1.68 substr $text, $self->{cursor}++, 0, chr $uni;
2004 root 1.271 } else {
2005     return 0;
2006 elmex 1.31 }
2007 root 1.51
2008 root 1.68 $self->_set_text ($text);
2009 root 1.251
2010     $self->realloc;
2011 root 1.358 $self->update;
2012 root 1.271
2013     1
2014 root 1.68 }
2015    
2016 root 1.305 sub invoke_focus_in {
2017 root 1.68 my ($self) = @_;
2018    
2019     $self->{last_activity} = $::NOW;
2020    
2021 root 1.305 $self->SUPER::invoke_focus_in
2022 elmex 1.31 }
2023    
2024 root 1.305 sub invoke_button_down {
2025 root 1.68 my ($self, $ev, $x, $y) = @_;
2026    
2027 root 1.305 $self->SUPER::invoke_button_down ($ev, $x, $y);
2028 root 1.68
2029     my $idx = $self->{layout}->xy_to_index ($x, $y);
2030    
2031     # byte-index to char-index
2032 root 1.76 my $text = $self->{text};
2033 root 1.325 utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
2034     $self->{cursor} = length $text;
2035 root 1.51
2036 root 1.68 $self->_set_text ($self->{text});
2037     $self->update;
2038 root 1.271
2039     1
2040 root 1.51 }
2041    
2042 root 1.305 sub invoke_mouse_motion {
2043 root 1.58 my ($self, $ev, $x, $y) = @_;
2044 root 1.68 # printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
2045 root 1.271
2046 root 1.305 1
2047 root 1.58 }
2048    
2049 root 1.51 sub _draw {
2050     my ($self) = @_;
2051    
2052 root 1.68 local $self->{fg} = $self->{fg};
2053    
2054 root 1.51 if ($FOCUS == $self) {
2055 root 1.278 glColor_premultiply @{$self->{active_bg}};
2056 root 1.68 $self->{fg} = $self->{active_fg};
2057 root 1.51 } else {
2058 root 1.278 glColor_premultiply @{$self->{bg}};
2059 root 1.51 }
2060    
2061 root 1.76 glEnable GL_BLEND;
2062 root 1.278 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2063 root 1.51 glBegin GL_QUADS;
2064 root 1.68 glVertex 0 , 0;
2065     glVertex 0 , $self->{h};
2066     glVertex $self->{w}, $self->{h};
2067     glVertex $self->{w}, 0;
2068 root 1.51 glEnd;
2069 root 1.76 glDisable GL_BLEND;
2070 root 1.51
2071     $self->SUPER::_draw;
2072 root 1.68
2073     #TODO: force update every cursor change :(
2074     if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
2075 root 1.121
2076     unless (exists $self->{cur_h}) {
2077     my $text = substr $self->{text}, 0, $self->{cursor};
2078     utf8::encode $text;
2079    
2080     @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
2081     }
2082    
2083 root 1.68 glBegin GL_LINES;
2084 root 1.344 glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
2085     glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
2086 root 1.68 glEnd;
2087     }
2088     }
2089    
2090 root 1.358 #############################################################################
2091    
2092 root 1.340 package CFPlus::UI::Entry;
2093 elmex 1.99
2094 root 1.340 our @ISA = CFPlus::UI::EntryBase::;
2095 elmex 1.99
2096 root 1.340 use CFPlus::OpenGL;
2097 elmex 1.99
2098 root 1.305 sub invoke_key_down {
2099 elmex 1.99 my ($self, $ev) = @_;
2100    
2101 root 1.137 my $sym = $ev->{sym};
2102 elmex 1.99
2103 root 1.360 if ($ev->{uni} == 0x0d || $sym == 13) {
2104 elmex 1.167 unshift @{$self->{history}},
2105     my $txt = $self->get_text;
2106 root 1.306
2107 elmex 1.167 $self->{history_pointer} = -1;
2108 elmex 1.169 $self->{history_saveback} = '';
2109 root 1.305 $self->emit (activate => $txt);
2110 elmex 1.99 $self->update;
2111    
2112 root 1.340 } elsif ($sym == CFPlus::SDLK_UP) {
2113 elmex 1.167 if ($self->{history_pointer} < 0) {
2114     $self->{history_saveback} = $self->get_text;
2115     }
2116 elmex 1.169 if (@{$self->{history} || []} > 0) {
2117     $self->{history_pointer}++;
2118     if ($self->{history_pointer} >= @{$self->{history} || []}) {
2119     $self->{history_pointer} = @{$self->{history} || []} - 1;
2120     }
2121     $self->set_text ($self->{history}->[$self->{history_pointer}]);
2122 elmex 1.167 }
2123    
2124 root 1.340 } elsif ($sym == CFPlus::SDLK_DOWN) {
2125 elmex 1.167 $self->{history_pointer}--;
2126     $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
2127    
2128     if ($self->{history_pointer} >= 0) {
2129     $self->set_text ($self->{history}->[$self->{history_pointer}]);
2130     } else {
2131     $self->set_text ($self->{history_saveback});
2132     }
2133    
2134 root 1.360 } else {
2135 root 1.305 return $self->SUPER::invoke_key_down ($ev)
2136 elmex 1.99 }
2137    
2138 root 1.271 1
2139 elmex 1.99 }
2140    
2141 root 1.68 #############################################################################
2142    
2143 root 1.358 package CFPlus::UI::TextEdit;
2144    
2145     our @ISA = CFPlus::UI::EntryBase::;
2146    
2147     use CFPlus::OpenGL;
2148    
2149     sub move_cursor_ver {
2150     my ($self, $dy) = @_;
2151    
2152     my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
2153    
2154 root 1.359 $y += $dy;
2155    
2156     if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
2157     $self->{cursor} = $index;
2158     delete $self->{cur_h};
2159     $self->update;
2160     return;
2161     }
2162 root 1.358 }
2163    
2164     sub invoke_key_down {
2165     my ($self, $ev) = @_;
2166    
2167     my $sym = $ev->{sym};
2168    
2169     if ($sym == CFPlus::SDLK_UP) {
2170     $self->move_cursor_ver (-1);
2171     } elsif ($sym == CFPlus::SDLK_DOWN) {
2172     $self->move_cursor_ver (+1);
2173     } else {
2174     return $self->SUPER::invoke_key_down ($ev)
2175     }
2176    
2177     1
2178     }
2179    
2180     #############################################################################
2181    
2182 root 1.340 package CFPlus::UI::Button;
2183 root 1.79
2184 root 1.340 our @ISA = CFPlus::UI::Label::;
2185 root 1.79
2186 root 1.340 use CFPlus::OpenGL;
2187 root 1.79
2188 elmex 1.85 my @tex =
2189 root 1.340 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2190 elmex 1.85 qw(b1_button_active.png);
2191    
2192 root 1.79 sub new {
2193     my $class = shift;
2194    
2195     $class->SUPER::new (
2196 root 1.258 padding_x => 4,
2197     padding_y => 4,
2198 root 1.164 fg => [1, 1, 1],
2199     active_fg => [0, 0, 1],
2200     can_hover => 1,
2201     align => 0,
2202     valign => 0,
2203 elmex 1.150 can_events => 1,
2204 root 1.79 @_
2205     )
2206     }
2207    
2208 root 1.305 sub invoke_button_up {
2209 root 1.79 my ($self, $ev, $x, $y) = @_;
2210    
2211 root 1.231 $self->emit ("activate")
2212     if $x >= 0 && $x < $self->{w}
2213     && $y >= 0 && $y < $self->{h};
2214 root 1.271
2215     1
2216 root 1.79 }
2217    
2218     sub _draw {
2219     my ($self) = @_;
2220    
2221 root 1.279 local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
2222 root 1.79
2223 root 1.119 glEnable GL_TEXTURE_2D;
2224 elmex 1.85 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2225 root 1.119 glColor 0, 0, 0, 1;
2226 elmex 1.85
2227 root 1.195 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2228 elmex 1.85
2229     glDisable GL_TEXTURE_2D;
2230 root 1.79
2231     $self->SUPER::_draw;
2232     }
2233    
2234     #############################################################################
2235    
2236 root 1.340 package CFPlus::UI::CheckBox;
2237 root 1.86
2238 root 1.340 our @ISA = CFPlus::UI::DrawBG::;
2239 root 1.86
2240 elmex 1.102 my @tex =
2241 root 1.340 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2242 elmex 1.102 qw(c1_checkbox_bg.png c1_checkbox_active.png);
2243    
2244 root 1.340 use CFPlus::OpenGL;
2245 root 1.86
2246     sub new {
2247     my $class = shift;
2248    
2249     $class->SUPER::new (
2250 root 1.258 padding_x => 2,
2251     padding_y => 2,
2252 root 1.86 fg => [1, 1, 1],
2253     active_fg => [1, 1, 0],
2254 root 1.209 bg => [0, 0, 0, 0.2],
2255     active_bg => [1, 1, 1, 0.5],
2256 root 1.86 state => 0,
2257 root 1.97 can_hover => 1,
2258 root 1.86 @_
2259     )
2260     }
2261    
2262 root 1.87 sub size_request {
2263     my ($self) = @_;
2264    
2265 root 1.258 (6) x 2
2266 root 1.87 }
2267    
2268 root 1.319 sub toggle {
2269     my ($self) = @_;
2270    
2271     $self->{state} = !$self->{state};
2272     $self->emit (changed => $self->{state});
2273     $self->update;
2274     }
2275    
2276 root 1.305 sub invoke_button_down {
2277 root 1.86 my ($self, $ev, $x, $y) = @_;
2278    
2279 root 1.258 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2280     && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2281 root 1.319 $self->toggle;
2282 root 1.271 } else {
2283     return 0
2284 root 1.86 }
2285 root 1.271
2286     1
2287 root 1.86 }
2288    
2289     sub _draw {
2290     my ($self) = @_;
2291    
2292 root 1.87 $self->SUPER::_draw;
2293 root 1.86
2294 root 1.258 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
2295 root 1.86
2296 root 1.258 my ($w, $h) = @$self{qw(w h)};
2297    
2298     my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2299 elmex 1.102
2300 root 1.87 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
2301 root 1.86
2302 elmex 1.102 my $tex = $self->{state} ? $tex[1] : $tex[0];
2303    
2304 root 1.197 glEnable GL_TEXTURE_2D;
2305 root 1.195 $tex->draw_quad_alpha (0, 0, $s, $s);
2306 elmex 1.102 glDisable GL_TEXTURE_2D;
2307 root 1.86 }
2308    
2309     #############################################################################
2310    
2311 root 1.340 package CFPlus::UI::Image;
2312 elmex 1.145
2313 root 1.340 our @ISA = CFPlus::UI::Base::;
2314 elmex 1.145
2315 root 1.340 use CFPlus::OpenGL;
2316 elmex 1.145
2317 root 1.310 our %texture_cache;
2318 elmex 1.145
2319     sub new {
2320     my $class = shift;
2321    
2322 root 1.310 my $self = $class->SUPER::new (
2323     can_events => 0,
2324     @_,
2325     );
2326 elmex 1.145
2327 root 1.327 $self->{path} || $self->{tex}
2328     or Carp::croak "'path' or 'tex' attributes required";
2329 elmex 1.145
2330 root 1.327 $self->{tex} ||= $texture_cache{$self->{path}} ||=
2331 root 1.340 new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
2332 elmex 1.145
2333 root 1.362 CFPlus::weaken $texture_cache{$self->{path}};
2334 root 1.147
2335 root 1.310 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2336 elmex 1.145
2337     $self
2338     }
2339    
2340 root 1.334 sub STORABLE_freeze {
2341     my ($self, $cloning) = @_;
2342    
2343     $self->{path}
2344 root 1.340 or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
2345 root 1.334
2346     $self->{path}
2347     }
2348    
2349     sub STORABLE_attach {
2350     my ($self, $cloning, $path) = @_;
2351    
2352     $self->new (path => $path)
2353     }
2354    
2355 elmex 1.145 sub size_request {
2356     my ($self) = @_;
2357    
2358 root 1.310 ($self->{tex}{w}, $self->{tex}{h})
2359 elmex 1.145 }
2360    
2361     sub _draw {
2362     my ($self) = @_;
2363    
2364     my $tex = $self->{tex};
2365    
2366     my ($w, $h) = ($self->{w}, $self->{h});
2367    
2368     if ($self->{rot90}) {
2369     glRotate 90, 0, 0, 1;
2370     glTranslate 0, -$self->{w}, 0;
2371    
2372     ($w, $h) = ($h, $w);
2373     }
2374    
2375     glEnable GL_TEXTURE_2D;
2376     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2377    
2378 root 1.334 $tex->draw_quad (0, 0, $w, $h);
2379 elmex 1.145
2380     glDisable GL_TEXTURE_2D;
2381     }
2382    
2383     #############################################################################
2384    
2385 root 1.340 package CFPlus::UI::ImageButton;
2386 root 1.336
2387 root 1.340 our @ISA = CFPlus::UI::Image::;
2388 root 1.336
2389 root 1.340 use CFPlus::OpenGL;
2390 root 1.336
2391     my %textures;
2392    
2393     sub new {
2394     my $class = shift;
2395    
2396     my $self = $class->SUPER::new (
2397     padding_x => 4,
2398     padding_y => 4,
2399     fg => [1, 1, 1],
2400     active_fg => [0, 0, 1],
2401     can_hover => 1,
2402     align => 0,
2403     valign => 0,
2404     can_events => 1,
2405     @_
2406     );
2407     }
2408    
2409     sub invoke_button_up {
2410     my ($self, $ev, $x, $y) = @_;
2411    
2412     $self->emit ("activate")
2413     if $x >= 0 && $x < $self->{w}
2414     && $y >= 0 && $y < $self->{h};
2415    
2416     1
2417     }
2418    
2419     #############################################################################
2420    
2421 root 1.340 package CFPlus::UI::VGauge;
2422 elmex 1.124
2423 root 1.340 our @ISA = CFPlus::UI::Base::;
2424 elmex 1.124
2425 root 1.158 use List::Util qw(min max);
2426    
2427 root 1.340 use CFPlus::OpenGL;
2428 elmex 1.124
2429     my %tex = (
2430     food => [
2431 root 1.340 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2432 elmex 1.124 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2433     ],
2434     grace => [
2435 root 1.340 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2436 root 1.158 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2437 elmex 1.124 ],
2438     hp => [
2439 root 1.340 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2440 elmex 1.124 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2441     ],
2442     mana => [
2443 root 1.340 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2444 root 1.158 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2445 elmex 1.124 ],
2446     );
2447    
2448     # eg. VGauge->new (gauge => 'food'), default gauge: food
2449     sub new {
2450     my $class = shift;
2451    
2452 root 1.140 my $self = $class->SUPER::new (
2453 root 1.141 type => 'food',
2454 root 1.140 @_
2455     );
2456    
2457 root 1.141 $self->{aspect} = $tex{$self->{type}}[0]{w} / $tex{$self->{type}}[0]{h};
2458 elmex 1.124
2459     $self
2460     }
2461    
2462     sub size_request {
2463     my ($self) = @_;
2464    
2465 root 1.143 #my $tex = $tex{$self->{type}}[0];
2466     #@$tex{qw(w h)}
2467     (0, 0)
2468 elmex 1.124 }
2469    
2470     sub set_max {
2471     my ($self, $max) = @_;
2472 root 1.127
2473 root 1.173 return if $self->{max_val} == $max;
2474    
2475 elmex 1.124 $self->{max_val} = $max;
2476 root 1.173 $self->update;
2477 elmex 1.124 }
2478    
2479     sub set_value {
2480     my ($self, $val, $max) = @_;
2481    
2482     $self->set_max ($max)
2483     if defined $max;
2484    
2485 root 1.173 return if $self->{val} == $val;
2486    
2487 elmex 1.124 $self->{val} = $val;
2488     $self->update;
2489     }
2490    
2491     sub _draw {
2492     my ($self) = @_;
2493    
2494 root 1.141 my $tex = $tex{$self->{type}};
2495 root 1.158 my ($t1, $t2, $t3) = @$tex;
2496 elmex 1.124
2497     my ($w, $h) = ($self->{w}, $self->{h});
2498    
2499 elmex 1.142 if ($self->{vertical}) {
2500     glRotate 90, 0, 0, 1;
2501     glTranslate 0, -$self->{w}, 0;
2502    
2503     ($w, $h) = ($h, $w);
2504     }
2505    
2506 elmex 1.124 my $ycut = $self->{val} / ($self->{max_val} || 1);
2507    
2508 root 1.158 my $ycut1 = max 0, min 1, $ycut;
2509     my $ycut2 = max 0, min 1, $ycut - 1;
2510    
2511     my $h1 = $self->{h} * (1 - $ycut1);
2512     my $h2 = $self->{h} * (1 - $ycut2);
2513 root 1.317 my $h3 = $self->{h};
2514    
2515     $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2516 elmex 1.124
2517     glEnable GL_BLEND;
2518 root 1.278 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2519     GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2520 elmex 1.124 glEnable GL_TEXTURE_2D;
2521     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2522    
2523 root 1.131 glBindTexture GL_TEXTURE_2D, $t1->{name};
2524     glBegin GL_QUADS;
2525 root 1.158 glTexCoord 0 , 0; glVertex 0 , 0;
2526     glTexCoord 0 , $t1->{t} * (1 - $ycut1); glVertex 0 , $h1;
2527     glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut1); glVertex $w, $h1;
2528     glTexCoord $t1->{s}, 0; glVertex $w, 0;
2529 root 1.131 glEnd;
2530 elmex 1.124
2531 root 1.158 my $ycut1 = List::Util::min 1, $ycut;
2532 root 1.131 glBindTexture GL_TEXTURE_2D, $t2->{name};
2533     glBegin GL_QUADS;
2534 root 1.158 glTexCoord 0 , $t2->{t} * (1 - $ycut1); glVertex 0 , $h1;
2535     glTexCoord 0 , $t2->{t} * (1 - $ycut2); glVertex 0 , $h2;
2536     glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut2); glVertex $w, $h2;
2537     glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut1); glVertex $w, $h1;
2538 root 1.131 glEnd;
2539 elmex 1.124
2540 root 1.158 if ($t3) {
2541     glBindTexture GL_TEXTURE_2D, $t3->{name};
2542     glBegin GL_QUADS;
2543     glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2544 root 1.317 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2545     glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2546 root 1.158 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2547     glEnd;
2548     }
2549    
2550 elmex 1.124 glDisable GL_BLEND;
2551     glDisable GL_TEXTURE_2D;
2552     }
2553    
2554     #############################################################################
2555    
2556 root 1.340 package CFPlus::UI::Gauge;
2557 root 1.141
2558 root 1.340 our @ISA = CFPlus::UI::VBox::;
2559 root 1.141
2560     sub new {
2561 root 1.151 my ($class, %arg) = @_;
2562 root 1.141
2563     my $self = $class->SUPER::new (
2564 root 1.171 tooltip => $arg{type},
2565     can_hover => 1,
2566     can_events => 1,
2567 root 1.151 %arg,
2568 root 1.141 );
2569    
2570 root 1.340 $self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999");
2571     $self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2572     $self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2573 root 1.141
2574     $self
2575     }
2576    
2577 elmex 1.146 sub set_fontsize {
2578     my ($self, $fsize) = @_;
2579    
2580     $self->{value}->set_fontsize ($fsize);
2581     $self->{max} ->set_fontsize ($fsize);
2582     }
2583    
2584 root 1.173 sub set_max {
2585     my ($self, $max) = @_;
2586    
2587     $self->{gauge}->set_max ($max);
2588     $self->{max}->set_text ($max);
2589     }
2590    
2591 root 1.141 sub set_value {
2592     my ($self, $val, $max) = @_;
2593    
2594     $self->set_max ($max)
2595     if defined $max;
2596    
2597     $self->{gauge}->set_value ($val, $max);
2598     $self->{value}->set_text ($val);
2599     }
2600    
2601     #############################################################################
2602    
2603 root 1.340 package CFPlus::UI::Slider;
2604 root 1.68
2605     use strict;
2606    
2607 root 1.340 use CFPlus::OpenGL;
2608 root 1.68
2609 root 1.340 our @ISA = CFPlus::UI::DrawBG::;
2610 root 1.68
2611 elmex 1.99 my @tex =
2612 root 1.340 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2613 elmex 1.99 qw(s1_slider.png s1_slider_bg.png);
2614    
2615 root 1.68 sub new {
2616     my $class = shift;
2617    
2618 root 1.206 # range [value, low, high, page, unit]
2619 root 1.68
2620 root 1.97 # TODO: 0-width page
2621     # TODO: req_w/h are wrong with vertical
2622     # TODO: calculations are off
2623 root 1.76 my $self = $class->SUPER::new (
2624 root 1.68 fg => [1, 1, 1],
2625     active_fg => [0, 0, 0],
2626 root 1.209 bg => [0, 0, 0, 0.2],
2627     active_bg => [1, 1, 1, 0.5],
2628 root 1.227 range => [0, 0, 100, 10, 0],
2629 root 1.257 min_w => $::WIDTH / 80,
2630     min_h => $::WIDTH / 80,
2631 root 1.76 vertical => 0,
2632 root 1.97 can_hover => 1,
2633 root 1.217 inner_pad => 0.02,
2634 root 1.68 @_
2635 root 1.76 );
2636    
2637 root 1.206 $self->set_value ($self->{range}[0]);
2638     $self->update;
2639    
2640 root 1.76 $self
2641     }
2642    
2643 root 1.225 sub set_range {
2644     my ($self, $range) = @_;
2645    
2646 root 1.239 ($range, $self->{range}) = ($self->{range}, $range);
2647 root 1.225
2648 root 1.295 if ("@$range" ne "@{$self->{range}}") {
2649     $self->update;
2650     $self->set_value ($self->{range}[0]);
2651     }
2652 root 1.225 }
2653    
2654 root 1.206 sub set_value {
2655     my ($self, $value) = @_;
2656    
2657     my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2658    
2659     $hi = $lo + 1 if $hi <= $lo;
2660    
2661 root 1.227 $page = $hi - $lo if $page > $hi - $lo;
2662    
2663     $value = $lo if $value < $lo;
2664     $value = $hi - $page if $value > $hi - $page;
2665 root 1.206
2666     $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2667     if $unit;
2668    
2669     @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2670    
2671     if ($value != $old_value) {
2672 root 1.305 $self->emit (changed => $value);
2673 root 1.206 $self->update;
2674     }
2675     }
2676    
2677 root 1.76 sub size_request {
2678     my ($self) = @_;
2679    
2680 root 1.257 ($self->{req_w}, $self->{req_h})
2681 root 1.68 }
2682    
2683 root 1.305 sub invoke_button_down {
2684 root 1.69 my ($self, $ev, $x, $y) = @_;
2685    
2686 root 1.305 $self->SUPER::invoke_button_down ($ev, $x, $y);
2687 root 1.227
2688     $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2689    
2690 root 1.307 $self->invoke_mouse_motion ($ev, $x, $y)
2691 root 1.69 }
2692    
2693 root 1.305 sub invoke_mouse_motion {
2694 root 1.69 my ($self, $ev, $x, $y) = @_;
2695    
2696     if ($GRAB == $self) {
2697 root 1.71 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2698    
2699 root 1.206 my (undef, $lo, $hi, $page) = @{$self->{range}};
2700 elmex 1.103
2701 root 1.227 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2702 root 1.69
2703 root 1.227 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2704 root 1.271 } else {
2705     return 0;
2706 root 1.69 }
2707 root 1.271
2708     1
2709 root 1.69 }
2710    
2711 root 1.330 sub invoke_mouse_wheel {
2712     my ($self, $ev) = @_;
2713    
2714     my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
2715    
2716 root 1.364 my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;
2717    
2718     $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
2719 root 1.330
2720     ! ! $delta
2721     }
2722    
2723 root 1.206 sub update {
2724     my ($self) = @_;
2725    
2726 root 1.275 delete $self->{knob_w};
2727     $self->SUPER::update;
2728     }
2729    
2730     sub _draw {
2731     my ($self) = @_;
2732    
2733     unless ($self->{knob_w}) {
2734 root 1.206 $self->set_value ($self->{range}[0]);
2735    
2736     my ($value, $lo, $hi, $page) = @{$self->{range}};
2737 root 1.227 my $range = ($hi - $page - $lo) || 1e-100;
2738 root 1.206
2739 root 1.227 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2740 root 1.206
2741 root 1.227 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2742     $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2743 root 1.206
2744 root 1.227 $value = ($value - $lo) / $range;
2745     $value = $value * $self->{scale} + $self->{offset};
2746 root 1.206
2747 root 1.227 $self->{knob_x} = $value - $knob_w * 0.5;
2748     $self->{knob_w} = $knob_w;
2749 root 1.275 }
2750 root 1.68
2751     $self->SUPER::_draw ();
2752    
2753 root 1.206 glScale $self->{w}, $self->{h};
2754 root 1.68
2755     if ($self->{vertical}) {
2756     # draw a vertical slider like a rotated horizontal slider
2757    
2758 root 1.214 glTranslate 1, 0, 0;
2759 root 1.68 glRotate 90, 0, 0, 1;
2760     }
2761    
2762     my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2763     my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2764    
2765 elmex 1.99 glEnable GL_TEXTURE_2D;
2766     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2767    
2768     # draw background
2769 root 1.206 $tex[1]->draw_quad_alpha (0, 0, 1, 1);
2770 root 1.69
2771 elmex 1.99 # draw handle
2772 root 1.206 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2773 root 1.69
2774 elmex 1.99 glDisable GL_TEXTURE_2D;
2775 root 1.51 }
2776    
2777 root 1.39 #############################################################################
2778    
2779 root 1.340 package CFPlus::UI::ValSlider;
2780 root 1.225
2781 root 1.340 our @ISA = CFPlus::UI::HBox::;
2782 root 1.225
2783     sub new {
2784     my ($class, %arg) = @_;
2785    
2786     my $range = delete $arg{range};
2787    
2788     my $self = $class->SUPER::new (
2789 root 1.340 slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2790     entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2791 root 1.225 to_value => sub { shift },
2792     from_value => sub { shift },
2793     %arg,
2794     );
2795    
2796     $self->{slider}->connect (changed => sub {
2797     my ($self, $value) = @_;
2798     $self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
2799     $self->{parent}->emit (changed => $value);
2800     });
2801    
2802     # $self->{entry}->connect (changed => sub {
2803     # my ($self, $value) = @_;
2804     # $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
2805     # $self->{parent}->emit (changed => $value);
2806     # });
2807    
2808     $self->add ($self->{slider}, $self->{entry});
2809    
2810     $self->{slider}->emit (changed => $self->{slider}{range}[0]);
2811    
2812     $self
2813     }
2814    
2815     sub set_range { shift->{slider}->set_range (@_) }
2816     sub set_value { shift->{slider}->set_value (@_) }
2817    
2818     #############################################################################
2819    
2820 root 1.340 package CFPlus::UI::TextScroller;
2821 root 1.97
2822 root 1.340 our @ISA = CFPlus::UI::HBox::;
2823 root 1.97
2824 root 1.340 use CFPlus::OpenGL;
2825 root 1.97
2826     sub new {
2827     my $class = shift;
2828    
2829     my $self = $class->SUPER::new (
2830 root 1.164 fontsize => 1,
2831 root 1.330 can_events => 1,
2832 root 1.293 indent => 0,
2833 root 1.164 #font => default_font
2834 root 1.105 @_,
2835 root 1.164
2836 root 1.340 layout => (new CFPlus::Layout),
2837 root 1.164 par => [],
2838 root 1.365 max_par => 0,
2839 root 1.164 height => 0,
2840     children => [
2841 root 1.340 (new CFPlus::UI::Empty expand => 1),
2842     (new CFPlus::UI::Slider vertical => 1),
2843 root 1.97 ],
2844     );
2845    
2846 root 1.176 $self->{children}[1]->connect (changed => sub { $self->update });
2847 root 1.107
2848 root 1.97 $self
2849     }
2850    
2851 root 1.107 sub set_fontsize {
2852     my ($self, $fontsize) = @_;
2853    
2854     $self->{fontsize} = $fontsize;
2855     $self->reflow;
2856     }
2857    
2858 root 1.312 sub size_request {
2859 root 1.310 my ($self) = @_;
2860    
2861 root 1.312 my ($empty, $slider) = @{ $self->{children} };
2862    
2863     local $self->{children} = [$empty, $slider];
2864     $self->SUPER::size_request
2865 root 1.310 }
2866    
2867 root 1.305 sub invoke_size_allocate {
2868 root 1.259 my ($self, $w, $h) = @_;
2869 root 1.220
2870 root 1.311 my ($empty, $slider, @other) = @{ $self->{children} };
2871 root 1.310 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2872    
2873 root 1.220 $self->{layout}->set_font ($self->{font}) if $self->{font};
2874     $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2875 root 1.311 $self->{layout}->set_width ($empty->{w});
2876 root 1.293 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2877 root 1.220
2878     $self->reflow;
2879 root 1.305
2880 root 1.312 local $self->{children} = [$empty, $slider];
2881 root 1.305 $self->SUPER::invoke_size_allocate ($w, $h)
2882 root 1.220 }
2883    
2884 root 1.330 sub invoke_mouse_wheel {
2885     my ($self, $ev) = @_;
2886    
2887     return 0 unless $ev->{dy}; # only vertical movements
2888    
2889     $self->{children}[1]->emit (mouse_wheel => $ev);
2890    
2891     1
2892     }
2893    
2894 root 1.310 sub get_layout {
2895     my ($self, $para) = @_;
2896 root 1.105
2897     my $layout = $self->{layout};
2898    
2899 root 1.310 $layout->set_font ($self->{font}) if $self->{font};
2900 root 1.311 $layout->set_foreground (@{$para->{fg}});
2901 root 1.134 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2902 root 1.310 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2903 root 1.293 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2904 root 1.310 $layout->set_markup ($para->{markup});
2905 root 1.311
2906     $layout->set_shapes (
2907     map
2908     +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
2909     @{$para->{widget}}
2910     );
2911 root 1.310
2912     $layout
2913 root 1.105 }
2914    
2915     sub reflow {
2916     my ($self) = @_;
2917    
2918 root 1.107 $self->{need_reflow}++;
2919     $self->update;
2920 root 1.105 }
2921    
2922 root 1.227 sub set_offset {
2923     my ($self, $offset) = @_;
2924    
2925     # todo: base offset on lines or so, not on pixels
2926     $self->{children}[1]->set_value ($offset);
2927     }
2928    
2929 root 1.345 sub current_paragraph {
2930     my ($self) = @_;
2931    
2932     $self->{top_paragraph} - 1
2933     }
2934    
2935     sub scroll_to {
2936     my ($self, $para) = @_;
2937    
2938     $para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
2939    
2940 root 1.347 $self->{scroll_to} = $para;
2941     $self->update;
2942 root 1.345 }
2943    
2944 root 1.226 sub clear {
2945     my ($self) = @_;
2946    
2947 root 1.310 my (undef, undef, @other) = @{ $self->{children} };
2948     $self->remove ($_) for @other;
2949    
2950 root 1.226 $self->{par} = [];
2951     $self->{height} = 0;
2952 root 1.227 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2953 root 1.226 }
2954    
2955 root 1.97 sub add_paragraph {
2956 root 1.338 my $self = shift;
2957 root 1.310
2958 root 1.338 for my $para (@_) {
2959     $para = {
2960     fg => [1, 1, 1, 1],
2961     indent => 0,
2962     markup => "",
2963     widget => [],
2964     ref $para ? %$para : (markup => $para),
2965     w => 1e10,
2966     wrapped => 1,
2967     };
2968 root 1.310
2969 root 1.338 $self->add (@{ $para->{widget} }) if @{ $para->{widget} };
2970     push @{$self->{par}}, $para;
2971     }
2972 root 1.97
2973 root 1.365 if (my $max = $self->{max_par}) {
2974     shift @{$self->{par}} while @{$self->{par}} > $max;
2975     }
2976    
2977 root 1.310 $self->{need_reflow}++;
2978     $self->update;
2979     }
2980    
2981     sub scroll_to_bottom {
2982     my ($self) = @_;
2983 root 1.105
2984 root 1.347 $self->{scroll_to} = $#{$self->{par}};
2985 root 1.310 $self->update;
2986 root 1.97 }
2987    
2988 root 1.345 sub force_uptodate {
2989 root 1.97 my ($self) = @_;
2990    
2991 root 1.345 if (delete $self->{need_reflow}) {
2992     my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2993    
2994     my $height = 0;
2995    
2996     for my $para (@{$self->{par}}) {
2997     if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2998     my $layout = $self->get_layout ($para);
2999     my ($w, $h) = $layout->size;
3000    
3001     $para->{w} = $w + $para->{indent};
3002     $para->{h} = $h;
3003     $para->{wrapped} = $layout->has_wrapped;
3004     }
3005    
3006     $para->{y} = $height;
3007     $height += $para->{h};
3008     }
3009 root 1.105
3010 root 1.345 $self->{height} = $height;
3011     $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
3012 root 1.228
3013 root 1.345 delete $self->{texture};
3014     }
3015 root 1.107
3016 root 1.347 if (my $paridx = delete $self->{scroll_to}) {
3017     $self->{children}[1]->set_value ($self->{par}[$paridx]{y});
3018 root 1.345 }
3019     }
3020 root 1.228
3021 root 1.345 sub update {
3022     my ($self) = @_;
3023 root 1.228
3024 root 1.345 $self->SUPER::update;
3025 root 1.107
3026 root 1.345 return unless $self->{h} > 0;
3027 root 1.107
3028 root 1.345 delete $self->{texture};
3029 root 1.295
3030 root 1.345 $ROOT->on_post_alloc ($self => sub {
3031     $self->force_uptodate;
3032 root 1.107
3033 root 1.345 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
3034 root 1.310
3035 root 1.340 $self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
3036 root 1.279 glClearColor 0, 0, 0, 0;
3037 root 1.107 glClear GL_COLOR_BUFFER_BIT;
3038    
3039 root 1.352 package CFPlus::UI::Base;
3040     local ($draw_x, $draw_y, $draw_w, $draw_h) =
3041     (0, 0, $self->{w}, $self->{h});
3042 root 1.351
3043 root 1.107 my $top = int $self->{children}[1]{range}[0];
3044 root 1.105
3045 root 1.347 my $paridx = 0;
3046     my $top_paragraph;
3047     my $top = int $self->{children}[1]{range}[0];
3048    
3049 root 1.107 my $y0 = $top;
3050 root 1.228 my $y1 = $top + $H;
3051 root 1.105
3052 root 1.310 for my $para (@{$self->{par}}) {
3053     my $h = $para->{h};
3054 root 1.345 my $y = $para->{y};
3055 root 1.97
3056 root 1.107 if ($y0 < $y + $h && $y < $y1) {
3057 root 1.310 my $layout = $self->get_layout ($para);
3058 root 1.220
3059 root 1.320 $layout->render ($para->{indent}, $y - $y0);
3060 root 1.310
3061     if (my @w = @{ $para->{widget} }) {
3062     my @s = $layout->get_shapes;
3063    
3064     for (@w) {
3065     my ($dx, $dy) = splice @s, 0, 2, ();
3066    
3067     $_->{x} = $dx + $para->{indent};
3068     $_->{y} = $dy + $y - $y0;
3069    
3070     $_->draw;
3071     }
3072     }
3073 root 1.107 }
3074 root 1.347
3075     $paridx++;
3076     $top_paragraph ||= $paridx if $y >= $top;
3077 root 1.105 }
3078 root 1.347
3079     $self->{top_paragraph} = $top_paragraph;
3080 root 1.107 };
3081     });
3082 root 1.105 }
3083 root 1.97
3084 root 1.310 sub reconfigure {
3085     my ($self) = @_;
3086    
3087     $self->SUPER::reconfigure;
3088    
3089     $_->{w} = 1e10 for @{ $self->{par} };
3090     $self->reflow;
3091     }
3092    
3093 root 1.105 sub _draw {
3094     my ($self) = @_;
3095 root 1.97
3096 root 1.176 glEnable GL_TEXTURE_2D;
3097     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
3098 root 1.279 glColor 0, 0, 0, 1;
3099     $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
3100 root 1.176 glDisable GL_TEXTURE_2D;
3101 root 1.97
3102 root 1.106 $self->{children}[1]->draw;
3103 root 1.97 }
3104    
3105     #############################################################################
3106    
3107 root 1.340 package CFPlus::UI::Animator;
3108 root 1.35
3109 root 1.340 use CFPlus::OpenGL;
3110 root 1.35
3111 root 1.340 our @ISA = CFPlus::UI::Bin::;
3112 root 1.35
3113     sub moveto {
3114     my ($self, $x, $y) = @_;
3115    
3116     $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
3117 root 1.56 $self->{speed} = 0.001;
3118 root 1.35 $self->{time} = 1;
3119    
3120     ::animation_start $self;
3121     }
3122    
3123     sub animate {
3124     my ($self, $interval) = @_;
3125    
3126     $self->{time} -= $interval * $self->{speed};
3127     if ($self->{time} <= 0) {
3128     $self->{time} = 0;
3129     ::animation_stop $self;
3130     }
3131    
3132     my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
3133    
3134     $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
3135     $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
3136     }
3137    
3138     sub _draw {
3139     my ($self) = @_;
3140    
3141     glPushMatrix;
3142 root 1.51 glRotate $self->{time} * 1000, 0, 1, 0;
3143 root 1.38 $self->{children}[0]->draw;
3144 root 1.35 glPopMatrix;
3145     }
3146    
3147 root 1.51 #############################################################################
3148    
3149 root 1.340 package CFPlus::UI::Flopper;
3150 root 1.96
3151 root 1.340 our @ISA = CFPlus::UI::Button::;
3152 root 1.96
3153     sub new {
3154     my $class = shift;
3155    
3156     my $self = $class->SUPER::new (
3157 root 1.243 state => 0,
3158     on_activate => \&toggle_flopper,
3159 root 1.96 @_
3160     );
3161    
3162     $self
3163     }
3164    
3165     sub toggle_flopper {
3166     my ($self) = @_;
3167    
3168 elmex 1.245 $self->{other}->toggle_visibility;
3169 root 1.96 }
3170    
3171     #############################################################################
3172    
3173 root 1.340 package CFPlus::UI::Tooltip;
3174 root 1.153
3175 root 1.340 our @ISA = CFPlus::UI::Bin::;
3176 root 1.153
3177 root 1.340 use CFPlus::OpenGL;
3178 root 1.153
3179     sub new {
3180     my $class = shift;
3181    
3182     $class->SUPER::new (
3183     @_,
3184     can_events => 0,
3185     )
3186     }
3187    
3188 root 1.196 sub set_tooltip_from {
3189     my ($self, $widget) = @_;
3190 root 1.195
3191 root 1.342 $widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
3192 root 1.341 if $widget->{tooltip} =~ /^#(.*)$/;
3193    
3194 root 1.259 my $tooltip = $widget->{tooltip};
3195    
3196     if ($ENV{CFPLUS_DEBUG} & 2) {
3197     $tooltip .= "\n\n" . (ref $widget) . "\n"
3198     . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
3199     . "req $widget->{req_w} $widget->{req_h}\n"
3200     . "visible $widget->{visible}";
3201     }
3202    
3203 root 1.298 $tooltip =~ s/^\n+//;
3204     $tooltip =~ s/\n+$//;
3205    
3206 root 1.340 $self->add (new CFPlus::UI::Label
3207 root 1.259 markup => $tooltip,
3208 root 1.213 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
3209     fontsize => 0.8,
3210 root 1.343 style => 1, # FLAG_INVERSE
3211 root 1.213 ellipsise => 0,
3212     font => ($widget->{tooltip_font} || $::FONT_PROP),
3213 root 1.197 );
3214 root 1.153 }
3215    
3216     sub size_request {
3217     my ($self) = @_;
3218    
3219     my ($w, $h) = @{$self->child}{qw(req_w req_h)};
3220    
3221 root 1.154 ($w + 4, $h + 4)
3222     }
3223    
3224 root 1.305 sub invoke_size_allocate {
3225 root 1.259 my ($self, $w, $h) = @_;
3226 root 1.162
3227 root 1.305 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
3228 root 1.162 }
3229    
3230 root 1.305 sub invoke_visibility_change {
3231 root 1.253 my ($self, $visible) = @_;
3232    
3233     return unless $visible;
3234    
3235     $self->{root}->on_post_alloc ("move_$self" => sub {
3236 root 1.254 my $widget = $self->{owner}
3237     or return;
3238 root 1.253
3239 root 1.332 if ($widget->{visible}) {
3240     my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
3241 root 1.253
3242 root 1.332 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
3243     if $x + $self->{w} > $self->{root}{w};
3244 root 1.253
3245 root 1.332 $self->move_abs ($x, $y);
3246     } else {
3247     $self->hide;
3248     }
3249 root 1.253 });
3250     }
3251    
3252 root 1.154 sub _draw {
3253     my ($self) = @_;
3254    
3255     glTranslate 0.375, 0.375;
3256    
3257     my ($w, $h) = @$self{qw(w h)};
3258    
3259     glColor 1, 0.8, 0.4;
3260     glBegin GL_QUADS;
3261     glVertex 0 , 0;
3262     glVertex 0 , $h;
3263     glVertex $w, $h;
3264     glVertex $w, 0;
3265     glEnd;
3266    
3267     glColor 0, 0, 0;
3268     glBegin GL_LINE_LOOP;
3269     glVertex 0 , 0;
3270     glVertex 0 , $h;
3271     glVertex $w, $h;
3272     glVertex $w, 0;
3273     glEnd;
3274    
3275 root 1.197 glTranslate 2 - 0.375, 2 - 0.375;
3276 root 1.252
3277 root 1.154 $self->SUPER::_draw;
3278 root 1.153 }
3279    
3280     #############################################################################
3281    
3282 root 1.340 package CFPlus::UI::Face;
3283 root 1.162
3284 root 1.340 our @ISA = CFPlus::UI::DrawBG::;
3285 root 1.162
3286 root 1.340 use CFPlus::OpenGL;
3287 root 1.162
3288     sub new {
3289     my $class = shift;
3290    
3291 root 1.217 my $self = $class->SUPER::new (
3292 root 1.234 aspect => 1,
3293     can_events => 0,
3294 root 1.162 @_,
3295 root 1.217 );
3296    
3297     if ($self->{anim} && $self->{animspeed}) {
3298 root 1.362 CFPlus::weaken (my $widget = $self);
3299 root 1.217
3300     $self->{timer} = Event->timer (
3301     at => $self->{animspeed} * int $::NOW / $self->{animspeed},
3302     hard => 1,
3303     interval => $self->{animspeed},
3304     cb => sub {
3305     ++$widget->{frame};
3306     $widget->update;
3307     },
3308     );
3309     }
3310    
3311     $self
3312 root 1.162 }
3313    
3314     sub size_request {
3315     (32, 8)
3316     }
3317    
3318 root 1.222 sub update {
3319     my ($self) = @_;
3320    
3321     return unless $self->{visible};
3322    
3323     $self->SUPER::update;
3324     }
3325    
3326 elmex 1.179 sub _draw {
3327 root 1.162 my ($self) = @_;
3328    
3329 root 1.227 return unless $::CONN;
3330 root 1.162
3331 root 1.337 $self->SUPER::_draw;
3332    
3333 root 1.217 my $face;
3334    
3335     if ($self->{frame}) {
3336     my $anim = $::CONN->{anim}[$self->{anim}];
3337    
3338     $face = $anim->[ $self->{frame} % @$anim ]
3339     if $anim && @$anim;
3340     }
3341    
3342     my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
3343    
3344 root 1.162 if ($tex) {
3345     glEnable GL_TEXTURE_2D;
3346     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
3347 root 1.279 glColor 0, 0, 0, 1;
3348 root 1.195 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
3349 root 1.162 glDisable GL_TEXTURE_2D;
3350     }
3351     }
3352    
3353 root 1.302 sub destroy {
3354 root 1.217 my ($self) = @_;
3355    
3356     $self->{timer}->cancel
3357     if $self->{timer};
3358    
3359 root 1.302 $self->SUPER::destroy;
3360 root 1.217 }
3361    
3362 root 1.162 #############################################################################
3363    
3364 root 1.340 package CFPlus::UI::Buttonbar;
3365 root 1.272
3366 root 1.340 our @ISA = CFPlus::UI::HBox::;
3367 root 1.272
3368 root 1.353 # TODO: should actually wrap buttons and other goodies.
3369 root 1.272
3370     #############################################################################
3371    
3372 root 1.340 package CFPlus::UI::Menu;
3373 root 1.178
3374 root 1.346 our @ISA = CFPlus::UI::Toplevel::;
3375 root 1.178
3376 root 1.340 use CFPlus::OpenGL;
3377 root 1.178
3378     sub new {
3379     my $class = shift;
3380    
3381     my $self = $class->SUPER::new (
3382     items => [],
3383     z => 100,
3384     @_,
3385     );
3386    
3387 root 1.340 $self->add ($self->{vbox} = new CFPlus::UI::VBox);
3388 root 1.178
3389     for my $item (@{ $self->{items} }) {
3390 root 1.291 my ($widget, $cb, $tooltip) = @$item;
3391 root 1.178
3392     # handle various types of items, only text for now
3393     if (!ref $widget) {
3394 root 1.322 if ($widget =~ /\t/) {
3395     my ($left, $right) = split /\t/, $widget, 2;
3396    
3397 root 1.340 $widget = new CFPlus::UI::HBox
3398 root 1.322 can_hover => 1,
3399     can_events => 1,
3400     tooltip => $tooltip,
3401     children => [
3402 root 1.340 (new CFPlus::UI::Label markup => $left, expand => 1),
3403     (new CFPlus::UI::Label markup => $right, align => +1),
3404 root 1.322 ],
3405     ;
3406    
3407     } else {
3408 root 1.340 $widget = new CFPlus::UI::Label
3409 root 1.322 can_hover => 1,
3410     can_events => 1,
3411     markup => $widget,
3412     tooltip => $tooltip;
3413     }
3414 root 1.178 }
3415    
3416     $self->{item}{$widget} = $item;
3417    
3418     $self->{vbox}->add ($widget);
3419     }
3420    
3421     $self
3422     }
3423    
3424     # popup given the event (must be a mouse button down event currently)
3425     sub popup {
3426     my ($self, $ev) = @_;
3427    
3428 root 1.305 $self->emit ("popdown");
3429 root 1.178
3430     # maybe save $GRAB? must be careful about events...
3431     $GRAB = $self;
3432     $self->{button} = $ev->{button};
3433    
3434     $self->show;
3435 root 1.258 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
3436 root 1.178 }
3437    
3438 root 1.305 sub invoke_mouse_motion {
3439 root 1.178 my ($self, $ev, $x, $y) = @_;
3440    
3441 root 1.182 # TODO: should use vbox->find_widget or so
3442 root 1.178 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
3443     $self->{hover} = $self->{item}{$HOVER};
3444 root 1.271
3445     0
3446 root 1.178 }
3447    
3448 root 1.305 sub invoke_button_up {
3449 root 1.178 my ($self, $ev, $x, $y) = @_;
3450    
3451     if ($ev->{button} == $self->{button}) {
3452     undef $GRAB;
3453     $self->hide;
3454    
3455 root 1.305 $self->emit ("popdown");
3456 root 1.178 $self->{hover}[1]->() if $self->{hover};
3457 root 1.271 } else {
3458     return 0
3459 root 1.178 }
3460 root 1.271
3461     1
3462 root 1.178 }
3463    
3464     #############################################################################
3465    
3466 root 1.340 package CFPlus::UI::Multiplexer;
3467 root 1.272
3468 root 1.340 our @ISA = CFPlus::UI::Container::;
3469 root 1.272
3470     sub new {
3471     my $class = shift;
3472    
3473     my $self = $class->SUPER::new (
3474     @_,
3475     );
3476    
3477     $self->{current} = $self->{children}[0]
3478     if @{ $self->{children} };
3479    
3480     $self
3481     }
3482    
3483     sub add {
3484     my ($self, @widgets) = @_;
3485    
3486     $self->SUPER::add (@widgets);
3487    
3488     $self->{current} = $self->{children}[0]
3489     if @{ $self->{children} };
3490     }
3491    
3492 root 1.319 sub get_current_page {
3493     my ($self) = @_;
3494    
3495     $self->{current}
3496     }
3497    
3498 root 1.272 sub set_current_page {
3499     my ($self, $page_or_widget) = @_;
3500    
3501     my $widget = ref $page_or_widget
3502     ? $page_or_widget
3503     : $self->{children}[$page_or_widget];
3504    
3505     $self->{current} = $widget;
3506     $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3507    
3508 root 1.305 $self->emit (page_changed => $self->{current});
3509 root 1.272
3510     $self->realloc;
3511     }
3512    
3513     sub visible_children {
3514     $_[0]{current}
3515     }
3516    
3517     sub size_request {
3518     my ($self) = @_;
3519    
3520     $self->{current}->size_request
3521     }
3522    
3523 root 1.305 sub invoke_size_allocate {
3524 root 1.272 my ($self, $w, $h) = @_;
3525    
3526     $self->{current}->configure (0, 0, $w, $h);
3527 root 1.305
3528     1
3529 root 1.272 }
3530    
3531     sub _draw {
3532     my ($self) = @_;
3533    
3534     $self->{current}->draw;
3535     }
3536    
3537     #############################################################################
3538    
3539 root 1.340 package CFPlus::UI::Notebook;
3540 root 1.272
3541 root 1.340 our @ISA = CFPlus::UI::VBox::;
3542 root 1.272
3543     sub new {
3544     my $class = shift;
3545    
3546     my $self = $class->SUPER::new (
3547 root 1.340 buttonbar => (new CFPlus::UI::Buttonbar),
3548     multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
3549 root 1.273 # filter => # will be put between multiplexer and $self
3550 root 1.272 @_,
3551     );
3552 root 1.273
3553     $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3554     $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
3555 root 1.272
3556     $self
3557     }
3558    
3559     sub add {
3560     my ($self, $title, $widget, $tooltip) = @_;
3561    
3562 root 1.362 CFPlus::weaken $self;
3563 root 1.272
3564 root 1.340 $self->{buttonbar}->add (new CFPlus::UI::Button
3565 root 1.272 markup => $title,
3566     tooltip => $tooltip,
3567     on_activate => sub { $self->set_current_page ($widget) },
3568     );
3569    
3570     $self->{multiplexer}->add ($widget);
3571     }
3572    
3573 root 1.319 sub get_current_page {
3574     my ($self) = @_;
3575    
3576     $self->{multiplexer}->get_current_page
3577     }
3578    
3579 root 1.272 sub set_current_page {
3580     my ($self, $page) = @_;
3581    
3582     $self->{multiplexer}->set_current_page ($page);
3583 root 1.305 $self->emit (page_changed => $self->{multiplexer}{current});
3584 root 1.272 }
3585    
3586     #############################################################################
3587    
3588 root 1.340 package CFPlus::UI::Selector;
3589 root 1.291
3590     use utf8;
3591    
3592 root 1.340 our @ISA = CFPlus::UI::Button::;
3593 root 1.291
3594     sub new {
3595     my $class = shift;
3596    
3597     my $self = $class->SUPER::new (
3598 root 1.297 options => [], # [value, title, longdesc], ...
3599 root 1.291 value => undef,
3600     @_,
3601     );
3602    
3603     $self->_set_value ($self->{value});
3604    
3605     $self
3606     }
3607    
3608 root 1.305 sub invoke_button_down {
3609 root 1.291 my ($self, $ev) = @_;
3610    
3611     my @menu_items;
3612    
3613     for (@{ $self->{options} }) {
3614 root 1.297 my ($value, $title, $tooltip) = @$_;
3615 root 1.291
3616 root 1.297 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3617 root 1.291 }
3618    
3619 root 1.340 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
3620 root 1.291 }
3621    
3622     sub _set_value {
3623     my ($self, $value) = @_;
3624    
3625 root 1.297 my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
3626 root 1.291 or return;
3627    
3628 root 1.297 $self->{value} = $item->[0];
3629     $self->set_markup ("$item->[1] ⇓");
3630 root 1.291 $self->set_tooltip ($item->[2]);
3631     }
3632    
3633     sub set_value {
3634     my ($self, $value) = @_;
3635    
3636     return unless $self->{value} ne $value;
3637    
3638     $self->_set_value ($value);
3639 root 1.305 $self->emit (changed => $value);
3640 root 1.291 }
3641    
3642     #############################################################################
3643    
3644 root 1.340 package CFPlus::UI::Statusbox;
3645 root 1.194
3646 root 1.340 our @ISA = CFPlus::UI::VBox::;
3647 root 1.194
3648 root 1.210 sub new {
3649     my $class = shift;
3650    
3651 root 1.280 my $self = $class->SUPER::new (
3652 root 1.210 fontsize => 0.8,
3653     @_,
3654 root 1.280 );
3655    
3656 root 1.362 CFPlus::weaken (my $this = $self);
3657 root 1.280
3658 root 1.281 $self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
3659 root 1.280
3660     $self
3661 root 1.210 }
3662    
3663 root 1.194 sub reorder {
3664     my ($self) = @_;
3665 root 1.280 my $NOW = Time::HiRes::time;
3666 root 1.194
3667 root 1.281 # freeze display when hovering over any label
3668 root 1.340 return if $CFPlus::UI::TOOLTIP->{owner}
3669     && grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
3670 root 1.281 values %{ $self->{item} };
3671    
3672 root 1.194 while (my ($k, $v) = each %{ $self->{item} }) {
3673     delete $self->{item}{$k} if $v->{timeout} < $NOW;
3674     }
3675    
3676     my @widgets;
3677 root 1.197
3678     my @items = sort {
3679     $a->{pri} <=> $b->{pri}
3680     or $b->{id} <=> $a->{id}
3681     } values %{ $self->{item} };
3682    
3683 root 1.280 $self->{timer}->interval (1);
3684    
3685 root 1.194 my $count = 10 + 1;
3686     for my $item (@items) {
3687     last unless --$count;
3688    
3689 root 1.281 my $label = $item->{label} ||= do {
3690 root 1.194 # TODO: doesn't handle markup well (read as: at all)
3691 root 1.197 my $short = $item->{count} > 1
3692     ? "<b>$item->{count} ×</b> $item->{text}"
3693     : $item->{text};
3694    
3695 root 1.194 for ($short) {
3696     s/^\s+//;
3697 root 1.205 s/\s+/ /g;
3698 root 1.194 }
3699    
3700 root 1.340 new CFPlus::UI::Label
3701 root 1.196 markup => $short,
3702 root 1.197 tooltip => $item->{tooltip},
3703 root 1.196 tooltip_font => $::FONT_PROP,
3704 root 1.197 tooltip_width => 0.67,
3705 root 1.213 fontsize => $item->{fontsize} || $self->{fontsize},
3706     max_w => $::WIDTH * 0.44,
3707 root 1.281 fg => [@{ $item->{fg} }],
3708 root 1.196 can_events => 1,
3709 root 1.197 can_hover => 1
3710 root 1.194 };
3711 root 1.280
3712     if ((my $diff = $item->{timeout} - $NOW) < 2) {
3713 root 1.281 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
3714     $label->update;
3715     $label->set_max_size (undef, $label->{req_h} * $diff)
3716     if $diff < 1;
3717 root 1.280 $self->{timer}->interval (1/30);
3718 root 1.281 } else {
3719     $label->{fg}[3] = $item->{fg}[3] || 1;
3720 root 1.280 }
3721 root 1.281
3722     push @widgets, $label;
3723 root 1.194 }
3724    
3725     $self->clear;
3726 root 1.197 $self->SUPER::add (reverse @widgets);
3727 root 1.194 }
3728    
3729     sub add {
3730     my ($self, $text, %arg) = @_;
3731    
3732 root 1.198 $text =~ s/^\s+//;
3733     $text =~ s/\s+$//;
3734    
3735 root 1.233 return unless $text;
3736    
3737 root 1.280 my $timeout = (int time) + ((delete $arg{timeout}) || 60);
3738 root 1.194
3739 root 1.197 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
3740 root 1.194
3741 root 1.197 if (my $item = $self->{item}{$group}) {
3742     if ($item->{text} eq $text) {
3743     $item->{count}++;
3744     } else {
3745     $item->{count} = 1;
3746     $item->{text} = $item->{tooltip} = $text;
3747     }
3748 root 1.300 $item->{id} += 0.2;#d#
3749 root 1.197 $item->{timeout} = $timeout;
3750     delete $item->{label};
3751     } else {
3752     $self->{item}{$group} = {
3753     id => ++$self->{id},
3754     text => $text,
3755     timeout => $timeout,
3756     tooltip => $text,
3757 root 1.205 fg => [0.8, 0.8, 0.8, 0.8],
3758 root 1.197 pri => 0,
3759     count => 1,
3760     %arg,
3761     };
3762     }
3763 root 1.194
3764 root 1.315 $ROOT->on_refresh (reorder => sub {
3765     $self->reorder;
3766     });
3767 root 1.194 }
3768    
3769 root 1.213 sub reconfigure {
3770     my ($self) = @_;
3771    
3772     delete $_->{label}
3773     for values %{ $self->{item} || {} };
3774    
3775     $self->reorder;
3776     $self->SUPER::reconfigure;
3777     }
3778    
3779 root 1.302 sub destroy {
3780 root 1.280 my ($self) = @_;
3781    
3782     $self->{timer}->cancel;
3783    
3784 root 1.302 $self->SUPER::destroy;
3785 root 1.280 }
3786    
3787 root 1.194 #############################################################################
3788    
3789 root 1.340 package CFPlus::UI::Root;
3790 root 1.265
3791 root 1.340 our @ISA = CFPlus::UI::Container::;
3792 elmex 1.260
3793 root 1.280 use List::Util qw(min max);
3794    
3795 root 1.340 use CFPlus::OpenGL;
3796 elmex 1.260
3797     sub new {
3798     my $class = shift;
3799    
3800 root 1.265 my $self = $class->SUPER::new (
3801     visible => 1,
3802     @_,
3803     );
3804    
3805 root 1.362 CFPlus::weaken ($self->{root} = $self);
3806 root 1.265
3807     $self
3808     }
3809    
3810     sub size_request {
3811     my ($self) = @_;
3812    
3813     ($self->{w}, $self->{h})
3814     }
3815 elmex 1.260
3816 root 1.265 sub _to_pixel {
3817     my ($coord, $size, $max) = @_;
3818 elmex 1.260
3819 root 1.265 $coord =
3820     $coord eq "center" ? ($max - $size) * 0.5
3821     : $coord eq "max" ? $max
3822     : $coord;
3823 elmex 1.260
3824 root 1.265 $coord = 0 if $coord < 0;
3825     $coord = $max - $size if $coord > $max - $size;
3826 elmex 1.260
3827 root 1.265 int $coord + 0.5
3828     }
3829 elmex 1.260
3830 root 1.305 sub invoke_size_allocate {
3831 root 1.265 my ($self, $w, $h) = @_;
3832 elmex 1.261
3833 root 1.265 for my $child ($self->children) {
3834     my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3835 elmex 1.260
3836 root 1.265 $X = $child->{force_x} if exists $child->{force_x};
3837     $Y = $child->{force_y} if exists $child->{force_y};
3838 elmex 1.260
3839 root 1.265 $X = _to_pixel $X, $W, $self->{w};
3840     $Y = _to_pixel $Y, $H, $self->{h};
3841 elmex 1.260
3842 root 1.265 $child->configure ($X, $Y, $W, $H);
3843     }
3844 root 1.305
3845     1
3846 elmex 1.260 }
3847    
3848 root 1.265 sub coord2local {
3849     my ($self, $x, $y) = @_;
3850    
3851     ($x, $y)
3852 elmex 1.260 }
3853    
3854 root 1.265 sub coord2global {
3855     my ($self, $x, $y) = @_;
3856 elmex 1.260
3857 root 1.265 ($x, $y)
3858 elmex 1.260 }
3859    
3860 root 1.265 sub update {
3861 elmex 1.260 my ($self) = @_;
3862    
3863 root 1.265 $::WANT_REFRESH++;
3864     }
3865 elmex 1.260
3866 root 1.265 sub add {
3867     my ($self, @children) = @_;
3868 elmex 1.260
3869 root 1.265 $_->{is_toplevel} = 1
3870     for @children;
3871 elmex 1.260
3872 root 1.265 $self->SUPER::add (@children);
3873 elmex 1.260 }
3874    
3875 root 1.265 sub remove {
3876     my ($self, @children) = @_;
3877    
3878     $self->SUPER::remove (@children);
3879 elmex 1.260
3880 root 1.265 delete $self->{is_toplevel}
3881     for @children;
3882 elmex 1.260
3883 root 1.265 while (@children) {
3884     my $w = pop @children;
3885     push @children, $w->children;
3886     $w->set_invisible;
3887     }
3888     }
3889 elmex 1.260
3890 root 1.265 sub on_refresh {
3891     my ($self, $id, $cb) = @_;
3892 elmex 1.260
3893 root 1.265 $self->{refresh_hook}{$id} = $cb;
3894 elmex 1.260 }
3895    
3896 root 1.265 sub on_post_alloc {
3897     my ($self, $id, $cb) = @_;
3898    
3899     $self->{post_alloc_hook}{$id} = $cb;
3900 elmex 1.262 }
3901    
3902 root 1.265 sub draw {
3903 elmex 1.260 my ($self) = @_;
3904    
3905 root 1.265 while ($self->{refresh_hook}) {
3906     $_->()
3907     for values %{delete $self->{refresh_hook}};
3908     }
3909    
3910     if ($self->{realloc}) {
3911 root 1.266 my %queue;
3912 root 1.265 my @queue;
3913 root 1.266 my $widget;
3914 root 1.265
3915 root 1.266 outer:
3916 root 1.265 while () {
3917 root 1.266 if (my $realloc = delete $self->{realloc}) {
3918     for $widget (values %$realloc) {
3919     $widget->{visible} or next; # do not resize invisible widgets
3920 root 1.265
3921 root 1.266 $queue{$widget+0}++ and next; # duplicates are common
3922 root 1.265
3923 root 1.266 push @{ $queue[$widget->{visible}] }, $widget;
3924     }
3925 root 1.265 }
3926    
3927 root 1.266 while () {
3928     @queue or last outer;
3929    
3930     $widget = pop @{ $queue[-1] || [] }
3931     and last;
3932    
3933     pop @queue;
3934     }
3935 root 1.265
3936 root 1.266 delete $queue{$widget+0};
3937 root 1.265
3938     my ($w, $h) = $widget->size_request;
3939    
3940 root 1.280 $w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3941     $h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3942    
3943     $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3944     $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3945 root 1.265
3946     $w = $widget->{force_w} if exists $widget->{force_w};
3947     $h = $widget->{force_h} if exists $widget->{force_h};
3948    
3949     if ($widget->{req_w} != $w || $widget->{req_h} != $h
3950     || delete $widget->{force_realloc}) {
3951     $widget->{req_w} = $w;
3952     $widget->{req_h} = $h;
3953    
3954     $self->{size_alloc}{$widget+0} = $widget;
3955    
3956     if (my $parent = $widget->{parent}) {
3957 root 1.266 $self->{realloc}{$parent+0} = $parent
3958     unless $queue{$parent+0};
3959    
3960 root 1.265 $parent->{force_size_alloc} = 1;
3961     $self->{size_alloc}{$parent+0} = $parent;
3962     }
3963     }
3964    
3965     delete $self->{realloc}{$widget+0};
3966     }
3967     }
3968 elmex 1.260
3969 root 1.265 while (my $size_alloc = delete $self->{size_alloc}) {
3970     my @queue = sort { $b->{visible} <=> $a->{visible} }
3971     values %$size_alloc;
3972 elmex 1.260
3973 root 1.265 while () {
3974     my $widget = pop @queue || last;
3975 elmex 1.260
3976 root 1.265 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3977 elmex 1.260
3978 root 1.265 $w = 0 if $w < 0;
3979     $h = 0 if $h < 0;
3980 elmex 1.260
3981 root 1.326 $w = max $widget->{min_w}, $w;
3982     $h = max $widget->{min_h}, $h;
3983    
3984 root 1.337 # $w = min $self->{w} - $widget->{x}, $w if $self->{w};
3985     # $h = min $self->{h} - $widget->{y}, $h if $self->{h};
3986    
3987 root 1.326 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3988     $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3989    
3990 root 1.265 $w = int $w + 0.5;
3991     $h = int $h + 0.5;
3992 elmex 1.260
3993 root 1.265 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3994 root 1.266 $widget->{old_w} = $widget->{w};
3995     $widget->{old_h} = $widget->{h};
3996    
3997 root 1.265 $widget->{w} = $w;
3998     $widget->{h} = $h;
3999 elmex 1.260
4000 root 1.265 $widget->emit (size_allocate => $w, $h);
4001     }
4002     }
4003     }
4004 elmex 1.260
4005 root 1.265 while ($self->{post_alloc_hook}) {
4006     $_->()
4007     for values %{delete $self->{post_alloc_hook}};
4008 elmex 1.260 }
4009 root 1.265
4010    
4011     glViewport 0, 0, $::WIDTH, $::HEIGHT;
4012     glClearColor +($::CFG->{fow_intensity}) x 3, 1;
4013     glClear GL_COLOR_BUFFER_BIT;
4014    
4015     glMatrixMode GL_PROJECTION;
4016     glLoadIdentity;
4017     glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
4018     glMatrixMode GL_MODELVIEW;
4019     glLoadIdentity;
4020    
4021 root 1.267 {
4022 root 1.340 package CFPlus::UI::Base;
4023 root 1.267
4024 root 1.351 local ($draw_x, $draw_y, $draw_w, $draw_h) =
4025 root 1.267 (0, 0, $self->{w}, $self->{h});
4026 root 1.352
4027     $self->_draw;
4028 root 1.267 }
4029 elmex 1.260 }
4030    
4031 elmex 1.262 #############################################################################
4032    
4033 root 1.340 package CFPlus::UI;
4034 root 1.51
4035 root 1.340 $ROOT = new CFPlus::UI::Root;
4036     $TOOLTIP = new CFPlus::UI::Tooltip z => 900;
4037 root 1.51
4038     1
4039 root 1.5