ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.172 by root, Tue Apr 25 09:52:04 2006 UTC vs.
Revision 1.311 by root, Fri Jun 23 22:35:16 2006 UTC

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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines