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.241 by root, Fri May 26 20:50:35 2006 UTC vs.
Revision 1.311 by root, Fri Jun 23 22:35:16 2006 UTC

… …
3use utf8; 3use utf8;
4use strict; 4use strict;
5 5
6use Scalar::Util (); 6use Scalar::Util ();
7use List::Util (); 7use List::Util ();
8use Event;
8 9
9use CFClient; 10use CFClient;
10use CFClient::Texture; 11use CFClient::Texture;
11 12
12our ($FOCUS, $HOVER, $GRAB); # various widgets 13our ($FOCUS, $HOVER, $GRAB); # various widgets
13 14
15our $LAYOUT;
14our $ROOT; 16our $ROOT;
15our $TOOLTIP; 17our $TOOLTIP;
16our $BUTTON_STATE; 18our $BUTTON_STATE;
17 19
18our %WIDGET; # all widgets, weak-referenced 20our %WIDGET; # all widgets, weak-referenced
19 21
20sub check_tooltip { 22our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
21 if (!$GRAB) { 23 if (!$GRAB) {
22 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 24 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
23 if (length $widget->{tooltip}) { 25 if (length $widget->{tooltip}) {
24
25 if ($TOOLTIP->{owner} != $widget) { 26 if ($TOOLTIP->{owner} != $widget) {
27 $TOOLTIP->hide;
28
26 $TOOLTIP->{owner} = $widget; 29 $TOOLTIP->{owner} = $widget;
30
31 return if $ENV{CFPLUS_DEBUG} & 8;
27 32
28 my $tip = $widget->{tooltip}; 33 my $tip = $widget->{tooltip};
29 34
30 $tip = $tip->($widget) if CODE:: eq ref $tip; 35 $tip = $tip->($widget) if CODE:: eq ref $tip;
31 36
32 $TOOLTIP->set_tooltip_from ($widget); 37 $TOOLTIP->set_tooltip_from ($widget);
33 $TOOLTIP->show; 38 $TOOLTIP->show;
34
35 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
36
37 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
38 if $x + $TOOLTIP->{w} > $::WIDTH;
39
40 $TOOLTIP->move ($x, $y);
41 $TOOLTIP->check_size;
42 $TOOLTIP->update;
43 } 39 }
44 40
45 return; 41 return;
46 } 42 }
47 } 43 }
48 } 44 }
49 45
50 $TOOLTIP->hide; 46 $TOOLTIP->hide;
51 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;
52} 71}
53 72
54# class methods for events 73# class methods for events
55sub feed_sdl_key_down_event { 74sub feed_sdl_key_down_event {
56 $FOCUS->emit (key_down => $_[0]) 75 $FOCUS->emit (key_down => $_[0])
… …
70 my $widget = $ROOT->find_widget ($x, $y); 89 my $widget = $ROOT->find_widget ($x, $y);
71 90
72 $GRAB = $widget; 91 $GRAB = $widget;
73 $GRAB->update if $GRAB; 92 $GRAB->update if $GRAB;
74 93
75 check_tooltip; 94 $TOOLTIP_WATCHER->cb->();
76 } 95 }
77 96
78 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 97 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
79 98
80 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y)) 99 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
… …
95 if (!$BUTTON_STATE) { 114 if (!$BUTTON_STATE) {
96 my $grab = $GRAB; undef $GRAB; 115 my $grab = $GRAB; undef $GRAB;
97 $grab->update if $grab; 116 $grab->update if $grab;
98 $GRAB->update if $GRAB; 117 $GRAB->update if $GRAB;
99 118
100 check_tooltip; 119 $TOOLTIP_WATCHER->cb->();
101 } 120 }
102} 121}
103 122
104sub feed_sdl_motion_event { 123sub feed_sdl_motion_event {
105 my ($ev) = @_; 124 my ($ev) = @_;
… …
111 my $hover = $HOVER; $HOVER = $widget; 130 my $hover = $HOVER; $HOVER = $widget;
112 131
113 $hover->update if $hover && $hover->{can_hover}; 132 $hover->update if $hover && $hover->{can_hover};
114 $HOVER->update if $HOVER && $HOVER->{can_hover}; 133 $HOVER->update if $HOVER && $HOVER->{can_hover};
115 134
116 check_tooltip; 135 $TOOLTIP_WATCHER->start;
117 } 136 }
118 137
119 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y)) 138 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
120 if $HOVER; 139 if $HOVER;
121} 140}
… …
153sub rescale_widgets { 172sub rescale_widgets {
154 my ($sx, $sy) = @_; 173 my ($sx, $sy) = @_;
155 174
156 for my $widget (values %WIDGET) { 175 for my $widget (values %WIDGET) {
157 if ($widget->{is_toplevel}) { 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
158 $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x}; 180 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
159 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 181 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
160 $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w}; 182 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
161 $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
162 $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y}; 183 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
163 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 184 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
164 $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h}; 185 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
165 $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_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
166 } 190 }
167 } 191 }
168 192
169 reconfigure_widgets; 193 reconfigure_widgets;
170} 194}
… …
179 203
180sub new { 204sub new {
181 my $class = shift; 205 my $class = shift;
182 206
183 my $self = bless { 207 my $self = bless {
184 x => 0, 208 x => "center",
185 y => 0, 209 y => "center",
186 z => 0, 210 z => 0,
211 w => undef,
212 h => undef,
187 can_events => 1, 213 can_events => 1,
188 @_ 214 @_
189 }, $class; 215 }, $class;
190 216
217 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
218
191 for (keys %$self) { 219 for (keys %$self) {
192 if (/^connect_(.*)$/) { 220 if (/^on_(.*)$/) {
193 $self->connect ($1 => delete $self->{$_}); 221 $self->connect ($1 => delete $self->{$_});
194 } 222 }
195 } 223 }
196 224
197 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 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 }
198 236
199 $self 237 $self
200} 238}
201 239
202sub destroy { 240sub destroy {
… …
206 %$self = (); 244 %$self = ();
207} 245}
208 246
209sub show { 247sub show {
210 my ($self) = @_; 248 my ($self) = @_;
249
211 return if $self->{parent}; 250 return if $self->{parent};
212 251
213 $CFClient::UI::ROOT->add ($self); 252 $CFClient::UI::ROOT->add ($self);
214} 253}
215 254
216sub show_centered { 255sub set_visible {
217 my ($self) = @_; 256 my ($self) = @_;
257
218 return if $self->{parent}; 258 return if $self->{visible};
219 259
220 $self->show; 260 $self->{root} = $self->{parent}{root};
261 $self->{visible} = $self->{parent}{visible} + 1;
221 262
222 $CFClient::UI::ROOT->on_post_alloc ( 263 $self->emit (visibility_change => 1);
223 "centered $self" => sub { 264
224 $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5); 265 $self->realloc if !exists $self->{req_w};
225 }, 266
226 ); 267 $_->set_visible for $self->children;
227} 268}
228 269
229sub set_invisible { 270sub set_invisible {
230 my ($self) = @_; 271 my ($self) = @_;
231 272
232 # broken show/hide model 273 return unless $self->{visible};
233 274
275 $_->set_invisible for $self->children;
276
277 delete $self->{visible};
234 delete $self->{root}; 278 delete $self->{root};
235 delete $self->{visible};
236 279
237 undef $GRAB if $GRAB == $self; 280 undef $GRAB if $GRAB == $self;
238 undef $HOVER if $HOVER == $self; 281 undef $HOVER if $HOVER == $self;
239 282
240 CFClient::UI::check_tooltip 283 $CFClient::UI::TOOLTIP_WATCHER->cb->()
241 if $CFClient::UI::TOOLTIP->{owner} == $self; 284 if $TOOLTIP->{owner} == $self;
242 285
243 $self->focus_out; 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;
244} 305}
245 306
246sub hide { 307sub hide {
247 my ($self) = @_; 308 my ($self) = @_;
248 309
… …
250 311
251 $self->{parent}->remove ($self) 312 $self->{parent}->remove ($self)
252 if $self->{parent}; 313 if $self->{parent};
253} 314}
254 315
255sub move { 316sub move_abs {
256 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
257 318
258 $self->{x} = int $x; 319 $self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
259 $self->{y} = int $y; 320 $self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
260 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
261 322
262 $self->update; 323 $self->update;
263} 324}
264 325
265sub set_size { 326sub set_size {
266 my ($self, $w, $h) = @_; 327 my ($self, $w, $h) = @_;
267 328
268 $self->{user_w} = $w; 329 $self->{force_w} = $w;
269 $self->{user_h} = $h; 330 $self->{force_h} = $h;
270 331
271 $self->check_size; 332 $self->realloc;
272} 333}
273 334
274sub size_request { 335sub size_request {
275 require Carp; 336 require Carp;
276 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
277} 338}
278 339
340sub baseline_shift {
341 0
342}
343
279sub configure { 344sub configure {
280 my ($self, $x, $y, $w, $h) = @_; 345 my ($self, $x, $y, $w, $h) = @_;
281 346
282 if ($self->{aspect}) { 347 if ($self->{aspect}) {
348 my ($ow, $oh) = ($w, $h);
349
283 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 350 $w = List::Util::min $w, int $h * $self->{aspect};
284 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 351 $h = List::Util::min $h, int $w / $self->{aspect};
285 352
286 # use alignment to adjust x, y 353 # use alignment to adjust x, y
287 354
288 $x += int +($w - $w2) * 0.5; 355 $x += int 0.5 * ($ow - $w);
289 $y += int +($h - $h2) * 0.5; 356 $y += int 0.5 * ($oh - $h);
290
291 ($w, $h) = ($w2, $h2);
292 } 357 }
293 358
294 if ($self->{x} != $x || $self->{y} != $y) { 359 if ($self->{x} ne $x || $self->{y} ne $y) {
295 $self->{x} = $x; 360 $self->{x} = $x;
296 $self->{y} = $y; 361 $self->{y} = $y;
297 $self->update; 362 $self->update;
298 } 363 }
299 364
300 if ($self->{w} != $w || $self->{h} != $h) { 365 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
301 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h]; 366 return unless $self->{visible};
302 }
303}
304 367
305sub size_allocate { 368 $self->{alloc_w} = $w;
306 # nothing to be done 369 $self->{alloc_h} = $h;
307}
308 370
309sub reconfigure { 371 $self->{root}{size_alloc}{$self+0} = $self;
310 my ($self) = @_; 372 }
311
312 $self->check_size (1);
313 $self->update;
314} 373}
315 374
316sub children { 375sub children {
376 # nop
377}
378
379sub visible_children {
380 $_[0]->children
317} 381}
318 382
319sub set_max_size { 383sub set_max_size {
320 my ($self, $w, $h) = @_; 384 my ($self, $w, $h) = @_;
321 385
322 delete $self->{max_w}; $self->{max_w} = $w if $w; 386 $self->{max_w} = int $w if defined $w;
323 delete $self->{max_h}; $self->{max_h} = $h if $h; 387 $self->{max_h} = int $h if defined $h;
388
389 $self->realloc;
324} 390}
325 391
326sub set_tooltip { 392sub set_tooltip {
327 my ($self, $tooltip) = @_; 393 my ($self, $tooltip) = @_;
328 394
… …
333 399
334 $self->{tooltip} = $tooltip; 400 $self->{tooltip} = $tooltip;
335 401
336 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 402 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
337 delete $CFClient::UI::TOOLTIP->{owner}; 403 delete $CFClient::UI::TOOLTIP->{owner};
338 CFClient::UI::check_tooltip; 404 $CFClient::UI::TOOLTIP_WATCHER->cb->();
339 } 405 }
340} 406}
341 407
342# translate global coordinates to local coordinate system 408# translate global coordinates to local coordinate system
343sub coord2local { 409sub coord2local {
… …
351 my ($self, $x, $y) = @_; 417 my ($self, $x, $y) = @_;
352 418
353 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 419 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
354} 420}
355 421
356sub focus_in { 422sub invoke_focus_in {
357 my ($self) = @_; 423 my ($self) = @_;
358 424
359 return if $FOCUS == $self; 425 return if $FOCUS == $self;
360 return unless $self->{can_focus}; 426 return unless $self->{can_focus};
361 427
362 my $focus = $FOCUS; $FOCUS = $self; 428 my $focus = $FOCUS; $FOCUS = $self;
363 429
364 $self->_emit (focus_in => $focus);
365
366 $focus->update if $focus; 430 $focus->update if $focus;
367 $FOCUS->update; 431 $FOCUS->update;
368}
369 432
433 0
434}
435
370sub focus_out { 436sub invoke_focus_out {
371 my ($self) = @_; 437 my ($self) = @_;
372 438
373 return unless $FOCUS == $self; 439 return unless $FOCUS == $self;
374 440
375 my $focus = $FOCUS; undef $FOCUS; 441 my $focus = $FOCUS; undef $FOCUS;
376 442
377 $self->_emit (focus_out => $focus);
378
379 $focus->update if $focus; #? 443 $focus->update if $focus; #?
380 444
381 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus 445 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
382 unless $FOCUS; 446 unless $FOCUS;
383}
384 447
448 0
449}
450
451sub grab_focus {
452 my ($self) = @_;
453
454 $self->emit ("focus_in");
455}
456
385sub mouse_motion { } 457sub invoke_mouse_motion { 1 }
386sub button_up { } 458sub invoke_button_up { 1 }
387sub key_down { } 459sub invoke_key_down { 1 }
388sub key_up { } 460sub invoke_key_up { 1 }
389 461
390sub button_down { 462sub invoke_button_down {
391 my ($self, $ev, $x, $y) = @_; 463 my ($self, $ev, $x, $y) = @_;
392 464
393 $self->focus_in; 465 $self->grab_focus;
394}
395 466
396sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 467 1
397sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 468}
398sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 469
399sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 470sub connect {
400sub 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
401 535
402sub draw { 536sub draw {
403 my ($self) = @_; 537 my ($self) = @_;
404 538
405 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);
406 550
407 glPushMatrix; 551 glPushMatrix;
408 glTranslate $self->{x}, $self->{y}, 0; 552 glTranslate $self->{x}, $self->{y}, 0;
409 $self->_draw;
410 glPopMatrix;
411 553
412 if ($self == $HOVER && $self->{can_hover}) { 554 if ($self == $HOVER && $self->{can_hover}) {
413 my ($x, $y) = @$self{qw(x y)};
414
415 glColor 1, 0.8, 0.5, 0.2; 555 glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
416 glEnable GL_BLEND; 556 glEnable GL_BLEND;
417 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 557 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
418 glBegin GL_QUADS; 558 glBegin GL_QUADS;
419 glVertex $x , $y; 559 glVertex 0 , 0;
420 glVertex $x + $self->{w}, $y; 560 glVertex $self->{w}, 0;
421 glVertex $x + $self->{w}, $y + $self->{h}; 561 glVertex $self->{w}, $self->{h};
422 glVertex $x , $y + $self->{h}; 562 glVertex 0 , $self->{h};
423 glEnd; 563 glEnd;
424 glDisable GL_BLEND; 564 glDisable GL_BLEND;
425 } 565 }
426 566
427 if ($ENV{PCLIENT_DEBUG}) { 567 if ($ENV{CFPLUS_DEBUG} & 1) {
428 glPushMatrix; 568 glPushMatrix;
429 glColor 1, 1, 0, 1; 569 glColor 1, 1, 0, 1;
430 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 570 glTranslate 0.375, 0.375;
431 glBegin GL_LINE_LOOP; 571 glBegin GL_LINE_LOOP;
432 glVertex 0 , 0; 572 glVertex 0 , 0;
433 glVertex $self->{w} - 1, 0; 573 glVertex $self->{w} - 1, 0;
434 glVertex $self->{w} - 1, $self->{h} - 1; 574 glVertex $self->{w} - 1, $self->{h} - 1;
435 glVertex 0 , $self->{h} - 1; 575 glVertex 0 , $self->{h} - 1;
436 glEnd; 576 glEnd;
437 glPopMatrix; 577 glPopMatrix;
438 #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;
439 } 579 }
580
581 $self->_draw;
582 glPopMatrix;
440} 583}
441 584
442sub _draw { 585sub _draw {
443 my ($self) = @_; 586 my ($self) = @_;
444 587
445 warn "no draw defined for $self\n"; 588 warn "no draw defined for $self\n";
446} 589}
447 590
448sub find_widget {
449 my ($self, $x, $y) = @_;
450
451 return () unless $self->{can_events};
452
453 return $self
454 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
455 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
456
457 ()
458}
459
460sub set_parent {
461 my ($self, $parent) = @_;
462
463 Scalar::Util::weaken ($self->{parent} = $parent);
464
465 $self->{root} = $parent->{root};
466 $self->{visible} = $parent->{visible} + 1;
467
468 # TODO: req_w _does_change after ->reconfigure
469 $self->check_size
470 unless exists $self->{req_w};
471
472 $self->show;
473}
474
475sub check_size {
476 my ($self, $forced) = @_;
477
478 $self->{force_alloc} = 1 if $forced;
479 $CFClient::UI::ROOT->{check_size}{$self} = $self;
480}
481
482sub update {
483 my ($self) = @_;
484
485 $self->{parent}->update
486 if $self->{parent};
487}
488
489sub connect {
490 my ($self, $signal, $cb) = @_;
491
492 push @{ $self->{signal_cb}{$signal} }, $cb;
493}
494
495sub _emit {
496 my ($self, $signal, @args) = @_;
497
498 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
499}
500
501sub emit {
502 my ($self, $signal, @args) = @_;
503
504 $self->_emit ($signal, @args)
505 || $self->$signal (@args);
506}
507
508sub DESTROY { 591sub DESTROY {
509 my ($self) = @_; 592 my ($self) = @_;
510 593
511 delete $WIDGET{$self+0}; 594 delete $WIDGET{$self+0};
512 #$self->deactivate; 595
596 eval { $self->destroy };
597 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
513} 598}
514 599
515############################################################################# 600#############################################################################
516 601
517package CFClient::UI::DrawBG; 602package CFClient::UI::DrawBG;
… …
542 627
543 if ($color && (@$color < 4 || $color->[3])) { 628 if ($color && (@$color < 4 || $color->[3])) {
544 my ($w, $h) = @$self{qw(w h)}; 629 my ($w, $h) = @$self{qw(w h)};
545 630
546 glEnable GL_BLEND; 631 glEnable GL_BLEND;
547 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 632 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
548 glColor @$color; 633 glColor_premultiply @$color;
549 634
550 glBegin GL_QUADS; 635 glBegin GL_QUADS;
551 glVertex 0 , 0; 636 glVertex 0 , 0;
552 glVertex 0 , $h; 637 glVertex 0 , $h;
553 glVertex $w, $h; 638 glVertex $w, $h;
… …
568 my ($class, %arg) = @_; 653 my ($class, %arg) = @_;
569 $class->SUPER::new (can_events => 0, %arg); 654 $class->SUPER::new (can_events => 0, %arg);
570} 655}
571 656
572sub size_request { 657sub size_request {
573 (0, 0) 658 my ($self) = @_;
659
660 ($self->{w} + 0, $self->{h} + 0)
574} 661}
575 662
576sub draw { } 663sub draw { }
577 664
578############################################################################# 665#############################################################################
… …
582our @ISA = CFClient::UI::Base::; 669our @ISA = CFClient::UI::Base::;
583 670
584sub new { 671sub new {
585 my ($class, %arg) = @_; 672 my ($class, %arg) = @_;
586 673
587 my $children = delete $arg{children} || []; 674 my $children = delete $arg{children};
588 675
589 my $self = $class->SUPER::new ( 676 my $self = $class->SUPER::new (
590 children => [], 677 children => [],
591 can_events => 0, 678 can_events => 0,
592 %arg, 679 %arg,
593 ); 680 );
681
594 $self->add ($_) for @$children; 682 $self->add (@$children)
683 if $children;
595 684
596 $self 685 $self
597} 686}
598 687
599sub add { 688sub add {
… …
607 $self->{children} = [ 696 $self->{children} = [
608 sort { $a->{z} <=> $b->{z} } 697 sort { $a->{z} <=> $b->{z} }
609 @{$self->{children}}, @widgets 698 @{$self->{children}}, @widgets
610 ]; 699 ];
611 700
612 $self->check_size (1); 701 $self->realloc;
613 $self->update;
614} 702}
615 703
616sub children { 704sub children {
617 @{ $_[0]{children} } 705 @{ $_[0]{children} }
618} 706}
… …
623 delete $child->{parent}; 711 delete $child->{parent};
624 $child->hide; 712 $child->hide;
625 713
626 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 714 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
627 715
628 $self->check_size (1); 716 $self->realloc;
629 $self->update;
630} 717}
631 718
632sub clear { 719sub clear {
633 my ($self) = @_; 720 my ($self) = @_;
634 721
… …
638 for (@$children) { 725 for (@$children) {
639 delete $_->{parent}; 726 delete $_->{parent};
640 $_->hide; 727 $_->hide;
641 } 728 }
642 729
643 $self->check_size; 730 $self->realloc;
644 $self->update;
645} 731}
646 732
647sub find_widget { 733sub find_widget {
648 my ($self, $x, $y) = @_; 734 my ($self, $x, $y) = @_;
649 735
650 $x -= $self->{x}; 736 $x -= $self->{x};
651 $y -= $self->{y}; 737 $y -= $self->{y};
652 738
653 my $res; 739 my $res;
654 740
655 for (reverse @{ $self->{children} }) { 741 for (reverse $self->visible_children) {
656 $res = $_->find_widget ($x, $y) 742 $res = $_->find_widget ($x, $y)
657 and return $res; 743 and return $res;
658 } 744 }
659 745
660 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y}) 746 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
… …
681} 767}
682 768
683sub add { 769sub add {
684 my ($self, $child) = @_; 770 my ($self, $child) = @_;
685 771
686 $self->{children} = []; 772 $self->SUPER::remove ($_) for @{ $self->{children} };
687
688 $self->SUPER::add ($child); 773 $self->SUPER::add ($child);
689} 774}
690 775
691sub remove { 776sub remove {
692 my ($self, $widget) = @_; 777 my ($self, $widget) = @_;
… …
701 786
702sub size_request { 787sub size_request {
703 $_[0]{children}[0]->size_request 788 $_[0]{children}[0]->size_request
704} 789}
705 790
706sub size_allocate { 791sub invoke_size_allocate {
707 my ($self, $w, $h) = @_; 792 my ($self, $w, $h) = @_;
708 793
709 $self->{children}[0]->configure (0, 0, $w, $h); 794 $self->{children}[0]->configure (0, 0, $w, $h);
795
796 1
710} 797}
711 798
712############################################################################# 799#############################################################################
800
801# back-buffered drawing area
713 802
714package CFClient::UI::Window; 803package CFClient::UI::Window;
715 804
716our @ISA = CFClient::UI::Bin::; 805our @ISA = CFClient::UI::Bin::;
717 806
… …
728 817
729 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 818 $ROOT->on_post_alloc ($self => sub { $self->render_child });
730 $self->SUPER::update; 819 $self->SUPER::update;
731} 820}
732 821
733sub size_allocate { 822sub invoke_size_allocate {
734 my ($self, $w, $h) = @_; 823 my ($self, $w, $h) = @_;
735 824
736 $self->SUPER::size_allocate ($w, $h);
737 $self->update; 825 $self->update;
826
827 $self->SUPER::invoke_size_allocate ($w, $h)
738} 828}
739 829
740sub _render { 830sub _render {
831 my ($self) = @_;
832
741 $_[0]{children}[0]->draw; 833 $self->{children}[0]->draw;
742} 834}
743 835
744sub render_child { 836sub render_child {
745 my ($self) = @_; 837 my ($self) = @_;
746 838
747 $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 {
748 glClearColor 0, 0, 0, 0; 840 glClearColor 0, 0, 0, 0;
749 glClear GL_COLOR_BUFFER_BIT; 841 glClear GL_COLOR_BUFFER_BIT;
750 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
751 $self->_render; 850 $self->_render;
752 }; 851 };
753} 852}
754 853
755sub _draw { 854sub _draw {
756 my ($self) = @_; 855 my ($self) = @_;
757 856
758 my ($w, $h) = ($self->w, $self->h); 857 my ($w, $h) = @$self{qw(w h)};
759 858
760 my $tex = $self->{texture} 859 my $tex = $self->{texture}
761 or return; 860 or return;
762 861
763 glEnable GL_TEXTURE_2D; 862 glEnable GL_TEXTURE_2D;
764 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 863 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
765 glColor 1, 1, 1, 1; 864 glColor 0, 0, 0, 1;
766 865
767 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h); 866 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
768 867
769 glDisable GL_TEXTURE_2D; 868 glDisable GL_TEXTURE_2D;
770} 869}
… …
786} 885}
787 886
788sub size_request { 887sub size_request {
789 my ($self) = @_; 888 my ($self) = @_;
790 889
791 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 890 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
792 891
793 @$self{qw(child_w child_h)} 892 $w = 10 if $self->{scroll_x};
794} 893 $h = 10 if $self->{scroll_y};
795 894
895 ($w, $h)
896}
897
796sub size_allocate { 898sub invoke_size_allocate {
797 my ($self, $w, $h) = @_; 899 my ($self, $w, $h) = @_;
798 900
901 my $child = $self->child;
902
799 $w = $self->{child_w} if $self->{scroll_x} && $self->{child_w}; 903 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
800 $h = $self->{child_h} if $self->{scroll_y} && $self->{child_h}; 904 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
801 905
802 $self->child->configure (0, 0, $w, $h); 906 $self->child->configure (0, 0, $w, $h);
803 $self->update; 907 $self->update;
908
909 1
804} 910}
805 911
806sub set_offset { 912sub set_offset {
807 my ($self, $x, $y) = @_; 913 my ($self, $x, $y) = @_;
808 914
… …
841} 947}
842 948
843sub _render { 949sub _render {
844 my ($self) = @_; 950 my ($self) = @_;
845 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
846 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 955 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
847 956
848 $self->SUPER::_render; 957 $self->SUPER::_render;
849} 958}
850 959
… …
853package CFClient::UI::ScrolledWindow; 962package CFClient::UI::ScrolledWindow;
854 963
855our @ISA = CFClient::UI::HBox::; 964our @ISA = CFClient::UI::HBox::;
856 965
857sub new { 966sub new {
858 my $class = shift; 967 my ($class, %arg) = @_;
968
969 my $child = delete $arg{child};
859 970
860 my $self; 971 my $self;
861 972
862 my $slider = new CFClient::UI::Slider 973 my $slider = new CFClient::UI::Slider
863 vertical => 1, 974 vertical => 1,
864 range => [0, 0, 1, 0.01], # HACK fix 975 range => [0, 0, 1, 0.01], # HACK fix
865 connect_changed => sub { 976 on_changed => sub {
866 $self->{vp}->set_offset (0, $_[1]); 977 $self->{vp}->set_offset (0, $_[1]);
867 }, 978 },
868 ; 979 ;
869 980
870 $self = $class->SUPER::new ( 981 $self = $class->SUPER::new (
871 vp => (new CFClient::UI::ViewPort expand => 1), 982 vp => (new CFClient::UI::ViewPort expand => 1),
872 slider => $slider, 983 slider => $slider,
873 @_, 984 %arg,
874 ); 985 );
875 986
876 $self->{vp}->add ($self->{scrolled});
877 $self->add ($self->{vp});
878 $self->add ($self->{slider}); 987 $self->SUPER::add ($self->{vp}, $self->{slider});
988 $self->add ($child) if $child;
879 989
880 $self 990 $self
991}
992
993sub add {
994 my ($self, $widget) = @_;
995
996 $self->{vp}->add ($self->{child} = $widget);
881} 997}
882 998
883sub update { 999sub update {
884 my ($self) = @_; 1000 my ($self) = @_;
885 1001
… …
888 # todo: overwrite size_allocate of child 1004 # todo: overwrite size_allocate of child
889 my $child = $self->{vp}->child; 1005 my $child = $self->{vp}->child;
890 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); 1006 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
891} 1007}
892 1008
893sub size_allocate { 1009sub invoke_size_allocate {
894 my ($self, $w, $h) = @_; 1010 my ($self, $w, $h) = @_;
895
896 $self->SUPER::size_allocate ($w, $h);
897 1011
898 my $child = $self->{vp}->child; 1012 my $child = $self->{vp}->child;
899 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); 1013 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1014
1015 $self->SUPER::invoke_size_allocate ($w, $h)
900} 1016}
901 1017
902#TODO# update range on size_allocate depending on child 1018#TODO# update range on size_allocate depending on child
903# update viewport offset on scroll 1019# update viewport offset on scroll
904 1020
… …
924 1040
925 if ($self->{bg}) { 1041 if ($self->{bg}) {
926 my ($w, $h) = @$self{qw(w h)}; 1042 my ($w, $h) = @$self{qw(w h)};
927 1043
928 glEnable GL_BLEND; 1044 glEnable GL_BLEND;
929 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 1045 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
930 glColor @{ $self->{bg} }; 1046 glColor_premultiply @{ $self->{bg} };
931 1047
932 glBegin GL_QUADS; 1048 glBegin GL_QUADS;
933 glVertex 0 , 0; 1049 glVertex 0 , 0;
934 glVertex 0 , $h; 1050 glVertex 0 , $h;
935 glVertex $w, $h; 1051 glVertex $w, $h;
… …
948 1064
949our @ISA = CFClient::UI::Bin::; 1065our @ISA = CFClient::UI::Bin::;
950 1066
951use CFClient::OpenGL; 1067use CFClient::OpenGL;
952 1068
953my @tex = 1069my $bg =
1070 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1071 mipmap => 1, wrap => 1;
1072
1073my @border =
954 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1074 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
955 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1075 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
956 1076
957sub new { 1077sub new {
958 my $class = shift; 1078 my ($class, %arg) = @_;
959
960 # TODO: user_x, user_y, overwrite moveto?
961 1079
962 my $self = $class->SUPER::new ( 1080 my $self = $class->SUPER::new (
963 bg => [1, 1, 1, 1], 1081 bg => [1, 1, 1, 1],
964 border_bg => [1, 1, 1, 1], 1082 border_bg => [1, 1, 1, 1],
965 border => 0.6, 1083 border => 0.6,
966 is_toplevel => 1,
967 can_events => 1, 1084 can_events => 1,
968 @_ 1085 min_w => 16,
1086 min_h => 16,
1087 %arg,
969 ); 1088 );
970 1089
971 $self->{title} &&= new CFClient::UI::Label 1090 $self->{title_widget} = new CFClient::UI::Label
972 align => 0, 1091 align => 0,
973 valign => 1, 1092 valign => 1,
974 text => $self->{title}, 1093 text => $self->{title},
975 fontsize => $self->{border}; 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 }
976 1105
977 $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};
978} 1115}
979 1116
980sub border { 1117sub border {
981 int $_[0]{border} * $::FONTSIZE 1118 int $_[0]{border} * $::FONTSIZE
982} 1119}
983 1120
984sub size_request { 1121sub size_request {
985 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};
986 1129
987 my ($w, $h) = $self->SUPER::size_request; 1130 my ($w, $h) = $self->SUPER::size_request;
988 1131
989 ( 1132 (
990 $w + $self->border * 2, 1133 $w + $self->border * 2,
991 $h + $self->border * 2, 1134 $h + $self->border * 2,
992 ) 1135 )
993} 1136}
994 1137
995sub size_allocate { 1138sub invoke_size_allocate {
996 my ($self, $w, $h) = @_; 1139 my ($self, $w, $h) = @_;
997 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
998 $h -= List::Util::max 0, $self->border * 2; 1149 $h -= List::Util::max 0, $border * 2;
999 $w -= List::Util::max 0, $self->border * 2; 1150 $w -= List::Util::max 0, $border * 2;
1000 1151
1001 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1002 if $self->{title};
1003
1004 $self->child->configure ($self->border, $self->border, $w, $h); 1152 $self->child->configure ($border, $border, $w, $h);
1005}
1006 1153
1154 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1155 if $self->{close_button};
1156
1157 1
1158}
1159
1007sub button_down { 1160sub invoke_button_down {
1008 my ($self, $ev, $x, $y) = @_; 1161 my ($self, $ev, $x, $y) = @_;
1009 1162
1010 my ($w, $h) = @$self{qw(w h)}; 1163 my ($w, $h) = @$self{qw(w h)};
1011 my $border = $self->border; 1164 my $border = $self->border;
1012 1165
… …
1025 my ($ev, $x, $y) = @_; 1178 my ($ev, $x, $y) = @_;
1026 1179
1027 my $dx = $ev->{x} - $ox; 1180 my $dx = $ev->{x} - $ox;
1028 my $dy = $ev->{y} - $oy; 1181 my $dy = $ev->{y} - $oy;
1029 1182
1030 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1183 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1031 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1184 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1185
1032 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1186 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1033 $self->check_size; 1187 $self->realloc;
1034 }; 1188 };
1035 1189
1036 } elsif ($lr ^ $td) { 1190 } elsif ($lr ^ $td) {
1037 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1191 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1038 my ($bx, $by) = ($self->{x}, $self->{y}); 1192 my ($bx, $by) = ($self->{x}, $self->{y});
… …
1040 $self->{motion} = sub { 1194 $self->{motion} = sub {
1041 my ($ev, $x, $y) = @_; 1195 my ($ev, $x, $y) = @_;
1042 1196
1043 ($x, $y) = ($ev->{x}, $ev->{y}); 1197 ($x, $y) = ($ev->{x}, $ev->{y});
1044 1198
1045 $self->move ($bx + $x - $ox, $by + $y - $oy); 1199 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1046 $self->update; 1200 # HACK: the next line is required to enforce placement
1201 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1047 }; 1202 };
1203 } else {
1204 return 0;
1205 }
1206
1048 } 1207 1
1049} 1208}
1050 1209
1051sub button_up { 1210sub invoke_button_up {
1052 my ($self, $ev, $x, $y) = @_; 1211 my ($self, $ev, $x, $y) = @_;
1053 1212
1054 delete $self->{motion}; 1213 ! ! delete $self->{motion}
1055} 1214}
1056 1215
1057sub mouse_motion { 1216sub invoke_mouse_motion {
1058 my ($self, $ev, $x, $y) = @_; 1217 my ($self, $ev, $x, $y) = @_;
1059 1218
1060 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1219 $self->{motion}->($ev, $x, $y) if $self->{motion};
1220
1221 ! ! $self->{motion}
1061} 1222}
1062 1223
1063sub _draw { 1224sub _draw {
1064 my ($self) = @_; 1225 my ($self) = @_;
1065 1226
1227 my $child = $self->{children}[0];
1228
1066 my ($w, $h ) = ($self->{w}, $self->{h}); 1229 my ($w, $h ) = ($self->{w}, $self->{h});
1067 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 1230 my ($cw, $ch) = ($child->{w}, $child->{h});
1068 1231
1069 glEnable GL_TEXTURE_2D; 1232 glEnable GL_TEXTURE_2D;
1070 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1233 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1071 1234
1072 my $border = $self->border; 1235 my $border = $self->border;
1073 1236
1074 glColor @{ $self->{border_bg} }; 1237 glColor @{ $self->{border_bg} };
1075 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1238 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1076 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1239 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1077 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1240 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1078 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1241 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1079 1242
1080 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1243 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1081 my $bg = $tex[0]; 1244 glColor @{ $self->{bg} };
1082 1245
1083 # TODO: repeat texture not scale 1246 # TODO: repeat texture not scale
1247 # solve this better(?)
1084 my $rep_x = $cw / $bg->{w}; 1248 $bg->{s} = $cw / $bg->{w};
1085 my $rep_y = $ch / $bg->{h}; 1249 $bg->{t} = $ch / $bg->{h};
1086
1087 glColor @{ $self->{bg} };
1088
1089 $bg->{s} = $rep_x;
1090 $bg->{t} = $rep_y;
1091 $bg->{wrap_mode} = 1;
1092 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1250 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1093 } 1251 }
1094 1252
1095 glDisable GL_TEXTURE_2D; 1253 glDisable GL_TEXTURE_2D;
1096 1254
1097 $self->{title}->draw if $self->{title};
1098
1099 $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};
1100} 1266}
1101 1267
1102############################################################################# 1268#############################################################################
1103 1269
1104package CFClient::UI::Table; 1270package CFClient::UI::Table;
… …
1126 my ($self, $x, $y, $child) = @_; 1292 my ($self, $x, $y, $child) = @_;
1127 1293
1128 $child->set_parent ($self); 1294 $child->set_parent ($self);
1129 $self->{children}[$y][$x] = $child; 1295 $self->{children}[$y][$x] = $child;
1130 1296
1131 $self->check_size (1); 1297 $self->realloc;
1298}
1299
1300sub remove {
1301 my ($self, $child) = @_;
1302
1303 # TODO: not yet implemented
1132} 1304}
1133 1305
1134# TODO: move to container class maybe? send children a signal on removal? 1306# TODO: move to container class maybe? send children a signal on removal?
1135sub clear { 1307sub clear {
1136 my ($self) = @_; 1308 my ($self) = @_;
… …
1141 for (@children) { 1313 for (@children) {
1142 delete $_->{parent}; 1314 delete $_->{parent};
1143 $_->hide; 1315 $_->hide;
1144 } 1316 }
1145 1317
1146 $self->check_size (1); 1318 $self->realloc;
1147 $self->update;
1148} 1319}
1149 1320
1150sub get_wh { 1321sub get_wh {
1151 my ($self) = @_; 1322 my ($self) = @_;
1152 1323
… …
1178 (sum @$ws), 1349 (sum @$ws),
1179 (sum @$hs), 1350 (sum @$hs),
1180 ) 1351 )
1181} 1352}
1182 1353
1183sub size_allocate { 1354sub invoke_size_allocate {
1184 my ($self, $w, $h) = @_; 1355 my ($self, $w, $h) = @_;
1185 1356
1186 my ($ws, $hs) = $self->get_wh; 1357 my ($ws, $hs) = $self->get_wh;
1187 1358
1188 my $req_w = (sum @$ws) || 1; 1359 my $req_w = (sum @$ws) || 1;
… …
1220 } 1391 }
1221 1392
1222 $y += $row_h; 1393 $y += $row_h;
1223 } 1394 }
1224 1395
1396 1
1225} 1397}
1226 1398
1227sub find_widget { 1399sub find_widget {
1228 my ($self, $x, $y) = @_; 1400 my ($self, $x, $y) = @_;
1229 1401
… …
1248 } 1420 }
1249} 1421}
1250 1422
1251############################################################################# 1423#############################################################################
1252 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
1253package CFClient::UI::HBox; 1485package CFClient::UI::HBox;
1254 1486
1255# TODO: wrap into common Box base class
1256
1257our @ISA = CFClient::UI::Container::; 1487our @ISA = CFClient::UI::Box::;
1258 1488
1259sub size_request { 1489sub new {
1260 my ($self) = @_; 1490 my $class = shift;
1261 1491
1262 my @alloc = map [$_->size_request], @{$self->{children}}; 1492 $class->SUPER::new (
1263 1493 vertical => 0,
1264 ( 1494 @_,
1265 (List::Util::sum map $_->[0], @alloc),
1266 (List::Util::max map $_->[1], @alloc),
1267 ) 1495 )
1268} 1496}
1269 1497
1270sub size_allocate {
1271 my ($self, $w, $h) = @_;
1272
1273 ($h, $w) = ($w, $h);
1274
1275 my $children = $self->{children};
1276
1277 my @h = map $_->{req_w}, @$children;
1278
1279 my $req_h = List::Util::sum @h;
1280
1281 if ($req_h > $h) {
1282 # ah well, not enough space
1283 $_ *= $h / $req_h for @h;
1284 } else {
1285 my $exp = List::Util::sum map $_->{expand}, @$children;
1286 $exp ||= 1;
1287
1288 for (0 .. $#$children) {
1289 my $child = $children->[$_];
1290
1291 my $alloc_h = $h[$_];
1292 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1293 $h[$_] = $alloc_h;
1294 }
1295 }
1296
1297 CFClient::UI::harmonize \@h;
1298
1299 my $y = 0;
1300 for (0 .. $#$children) {
1301 my $child = $children->[$_];
1302 my $h = $h[$_];
1303 $child->configure ($y, 0, $h, $w);
1304
1305 $y += $h;
1306 }
1307
1308 1
1309}
1310
1311############################################################################# 1498#############################################################################
1312 1499
1313package CFClient::UI::VBox; 1500package CFClient::UI::VBox;
1314 1501
1315# TODO: wrap into common Box base class
1316
1317our @ISA = CFClient::UI::Container::; 1502our @ISA = CFClient::UI::Box::;
1318 1503
1319sub size_request { 1504sub new {
1320 my ($self) = @_; 1505 my $class = shift;
1321 1506
1322 my @alloc = map [$_->size_request], @{$self->{children}}; 1507 $class->SUPER::new (
1323 1508 vertical => 1,
1324 ( 1509 @_,
1325 (List::Util::max map $_->[0], @alloc),
1326 (List::Util::sum map $_->[1], @alloc),
1327 ) 1510 )
1328}
1329
1330sub size_allocate {
1331 my ($self, $w, $h) = @_;
1332
1333 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1334
1335 my $children = $self->{children};
1336
1337 my @h = map $_->{req_h}, @$children;
1338
1339 my $req_h = List::Util::sum @h;
1340
1341 if ($req_h > $h) {
1342 # ah well, not enough space
1343 $_ *= $h / $req_h for @h;
1344 } else {
1345 my $exp = List::Util::sum map $_->{expand}, @$children;
1346 $exp ||= 1;
1347
1348 for (0 .. $#$children) {
1349 my $child = $children->[$_];
1350
1351 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1352 }
1353 }
1354
1355 CFClient::UI::harmonize \@h;
1356
1357 my $y = 0;
1358 for (0 .. $#$children) {
1359 my $child = $children->[$_];
1360 my $h = $h[$_];
1361 $child->configure (0, $y, $w, $h);
1362
1363 $y += $h;
1364 }
1365
1366 1
1367} 1511}
1368 1512
1369############################################################################# 1513#############################################################################
1370 1514
1371package CFClient::UI::Label; 1515package CFClient::UI::Label;
… …
1388 ellipsise => 3, # end 1532 ellipsise => 3, # end
1389 layout => (new CFClient::Layout), 1533 layout => (new CFClient::Layout),
1390 fontsize => 1, 1534 fontsize => 1,
1391 align => -1, 1535 align => -1,
1392 valign => -1, 1536 valign => -1,
1393 padding => 2, 1537 padding_x => 2,
1538 padding_y => 2,
1394 can_events => 0, 1539 can_events => 0,
1395 %arg 1540 %arg
1396 ); 1541 );
1397 1542
1398 if (exists $self->{template}) { 1543 if (exists $self->{template}) {
… …
1425 1570
1426 delete $self->{texture}; 1571 delete $self->{texture};
1427 $self->SUPER::update; 1572 $self->SUPER::update;
1428} 1573}
1429 1574
1575sub realloc {
1576 my ($self) = @_;
1577
1578 delete $self->{ox};
1579 $self->SUPER::realloc;
1580}
1581
1430sub set_text { 1582sub set_text {
1431 my ($self, $text) = @_; 1583 my ($self, $text) = @_;
1432 1584
1433 return if $self->{text} eq "T$text"; 1585 return if $self->{text} eq "T$text";
1434 $self->{text} = "T$text"; 1586 $self->{text} = "T$text";
1435 1587
1436 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1588 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1437 $self->{layout}->set_text ($text); 1589 $self->{layout}->set_text ($text);
1438 1590
1591 delete $self->{size_req};
1592 $self->realloc;
1439 $self->update; 1593 $self->update;
1440 $self->check_size;
1441} 1594}
1442 1595
1443sub set_markup { 1596sub set_markup {
1444 my ($self, $markup) = @_; 1597 my ($self, $markup) = @_;
1445 1598
… …
1449 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1602 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1450 1603
1451 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1604 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1452 $self->{layout}->set_markup ($markup); 1605 $self->{layout}->set_markup ($markup);
1453 1606
1607 delete $self->{size_req};
1608 $self->realloc;
1454 $self->update; 1609 $self->update;
1455 $self->check_size;
1456} 1610}
1457 1611
1458sub size_request { 1612sub size_request {
1459 my ($self) = @_; 1613 my ($self) = @_;
1460 1614
1615 $self->{size_req} ||= do {
1461 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1616 $self->{layout}->set_font ($self->{font}) if $self->{font};
1462 $self->{layout}->set_width ($self->{max_w} || -1); 1617 $self->{layout}->set_width ($self->{max_w} || -1);
1463 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1618 $self->{layout}->set_ellipsise ($self->{ellipsise});
1464 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1619 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1465 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1620 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1466 1621
1467 my ($w, $h) = $self->{layout}->size; 1622 my ($w, $h) = $self->{layout}->size;
1468 1623
1469 if (exists $self->{template}) { 1624 if (exists $self->{template}) {
1470 $self->{template}->set_font ($self->{font}) if $self->{font}; 1625 $self->{template}->set_font ($self->{font}) if $self->{font};
1471 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 1626 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1472 1627
1473 my ($w2, $h2) = $self->{template}->size; 1628 my ($w2, $h2) = $self->{template}->size;
1474 1629
1475 $w = List::Util::max $w, $w2; 1630 $w = List::Util::max $w, $w2;
1476 $h = List::Util::max $h, $h2; 1631 $h = List::Util::max $h, $h2;
1632 }
1633
1634 [$w, $h]
1477 } 1635 };
1478 1636
1479 ( 1637 @{ $self->{size_req} }
1480 $w + $self->{padding} * 2,
1481 $h + $self->{padding} * 2,
1482 )
1483} 1638}
1484 1639
1640sub baseline_shift {
1641 $_[0]{layout}->descent
1642}
1643
1485sub size_allocate { 1644sub invoke_size_allocate {
1486 my ($self, $w, $h) = @_; 1645 my ($self, $w, $h) = @_;
1487 1646
1647 delete $self->{ox};
1648
1488 delete $self->{texture}; 1649 delete $self->{texture}
1650 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1651
1652 1
1489} 1653}
1490 1654
1491sub set_fontsize { 1655sub set_fontsize {
1492 my ($self, $fontsize) = @_; 1656 my ($self, $fontsize) = @_;
1493 1657
1494 $self->{fontsize} = $fontsize; 1658 $self->{fontsize} = $fontsize;
1495 delete $self->{texture}; 1659 delete $self->{texture};
1496 1660
1497 $self->update; 1661 $self->realloc;
1498 $self->check_size; 1662}
1663
1664sub reconfigure {
1665 my ($self) = @_;
1666
1667 delete $self->{size_req};
1668
1669 $self->SUPER::reconfigure;
1499} 1670}
1500 1671
1501sub _draw { 1672sub _draw {
1502 my ($self) = @_; 1673 my ($self) = @_;
1503 1674
… …
1509 $self->{layout}->set_width ($self->{w}); 1680 $self->{layout}->set_width ($self->{w});
1510 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1681 $self->{layout}->set_ellipsise ($self->{ellipsise});
1511 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1682 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1512 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1683 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1513 1684
1514 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1685 new_from_layout CFClient::Texture $self->{layout}
1686 };
1515 1687
1688 unless (exists $self->{ox}) {
1516 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1689 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1517 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1690 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1518 : ($self->{w} - $tex->{w}) * 0.5); 1691 : ($self->{w} - $tex->{w}) * 0.5);
1519 1692
1520 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1693 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1521 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1694 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1522 : ($self->{h} - $tex->{h}) * 0.5); 1695 : ($self->{h} - $tex->{h}) * 0.5);
1523
1524 $tex
1525 }; 1696 };
1526 1697
1527 glEnable GL_TEXTURE_2D; 1698 glEnable GL_TEXTURE_2D;
1528 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1699
1700 my $w = List::Util::min $self->{w} + 4, $tex->{w};
1701 my $h = List::Util::min $self->{h} + 2, $tex->{h};
1529 1702
1530 if ($tex->{format} == GL_ALPHA) { 1703 if ($tex->{format} == GL_ALPHA) {
1704 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1531 glColor @{$self->{fg}}; 1705 glColor @{$self->{fg}};
1532 $tex->draw_quad_alpha ($self->{ox}, $self->{oy}); 1706 $tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1533 } else { 1707 } else {
1708 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1534 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}); 1709 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1535 } 1710 }
1536 1711
1537 glDisable GL_TEXTURE_2D; 1712 glDisable GL_TEXTURE_2D;
1538} 1713}
1539 1714
… …
1556 can_hover => 1, 1731 can_hover => 1,
1557 can_focus => 1, 1732 can_focus => 1,
1558 valign => 0, 1733 valign => 0,
1559 can_events => 1, 1734 can_events => 1,
1560 #text => ... 1735 #text => ...
1736 #hidden => "*",
1561 @_ 1737 @_
1562 ) 1738 )
1563} 1739}
1564 1740
1565sub _set_text { 1741sub _set_text {
… …
1567 1743
1568 delete $self->{cur_h}; 1744 delete $self->{cur_h};
1569 1745
1570 return if $self->{text} eq $text; 1746 return if $self->{text} eq $text;
1571 1747
1572 delete $self->{texture};
1573
1574 $self->{last_activity} = $::NOW; 1748 $self->{last_activity} = $::NOW;
1575 $self->{text} = $text; 1749 $self->{text} = $text;
1576 1750
1577 $text =~ s/./*/g if $self->{hidden}; 1751 $text =~ s/./*/g if $self->{hidden};
1578 $self->{layout}->set_text ("$text "); 1752 $self->{layout}->set_text ("$text ");
1753 delete $self->{size_req};
1579 1754
1580 $self->_emit (changed => $self->{text}); 1755 $self->emit (changed => $self->{text});
1756
1757 $self->realloc;
1758 $self->update;
1581} 1759}
1582 1760
1583sub set_text { 1761sub set_text {
1584 my ($self, $text) = @_; 1762 my ($self, $text) = @_;
1585 1763
1586 $self->{cursor} = length $text; 1764 $self->{cursor} = length $text;
1587 $self->_set_text ($text); 1765 $self->_set_text ($text);
1588 $self->update;
1589 $self->check_size;
1590} 1766}
1591 1767
1592sub get_text { 1768sub get_text {
1593 $_[0]{text} 1769 $_[0]{text}
1594} 1770}
… …
1599 my ($w, $h) = $self->SUPER::size_request; 1775 my ($w, $h) = $self->SUPER::size_request;
1600 1776
1601 ($w + 1, $h) # add 1 for cursor 1777 ($w + 1, $h) # add 1 for cursor
1602} 1778}
1603 1779
1604sub key_down { 1780sub invoke_key_down {
1605 my ($self, $ev) = @_; 1781 my ($self, $ev) = @_;
1606 1782
1607 my $mod = $ev->{mod}; 1783 my $mod = $ev->{mod};
1608 my $sym = $ev->{sym}; 1784 my $sym = $ev->{sym};
1609 my $uni = $ev->{unicode}; 1785 my $uni = $ev->{unicode};
… …
1621 } elsif ($sym == CFClient::SDLK_HOME) { 1797 } elsif ($sym == CFClient::SDLK_HOME) {
1622 $self->{cursor} = 0; 1798 $self->{cursor} = 0;
1623 } elsif ($sym == CFClient::SDLK_END) { 1799 } elsif ($sym == CFClient::SDLK_END) {
1624 $self->{cursor} = length $text; 1800 $self->{cursor} = length $text;
1625 } elsif ($uni == 27) { 1801 } elsif ($uni == 27) {
1626 $self->_emit ('escape'); 1802 $self->emit ('escape');
1627 } elsif ($uni) { 1803 } elsif ($uni) {
1628 substr $text, $self->{cursor}++, 0, chr $uni; 1804 substr $text, $self->{cursor}++, 0, chr $uni;
1805 } else {
1806 return 0;
1629 } 1807 }
1630 1808
1631 $self->_set_text ($text); 1809 $self->_set_text ($text);
1632 $self->update;
1633 $self->check_size;
1634}
1635 1810
1811 $self->realloc;
1812
1813 1
1814}
1815
1636sub focus_in { 1816sub invoke_focus_in {
1637 my ($self) = @_; 1817 my ($self) = @_;
1638 1818
1639 $self->{last_activity} = $::NOW; 1819 $self->{last_activity} = $::NOW;
1640 1820
1641 $self->SUPER::focus_in; 1821 $self->SUPER::invoke_focus_in
1642} 1822}
1643 1823
1644sub button_down { 1824sub invoke_button_down {
1645 my ($self, $ev, $x, $y) = @_; 1825 my ($self, $ev, $x, $y) = @_;
1646 1826
1647 $self->SUPER::button_down ($ev, $x, $y); 1827 $self->SUPER::invoke_button_down ($ev, $x, $y);
1648 1828
1649 my $idx = $self->{layout}->xy_to_index ($x, $y); 1829 my $idx = $self->{layout}->xy_to_index ($x, $y);
1650 1830
1651 # byte-index to char-index 1831 # byte-index to char-index
1652 my $text = $self->{text}; 1832 my $text = $self->{text};
1653 utf8::encode $text; 1833 utf8::encode $text;
1654 $self->{cursor} = length substr $text, 0, $idx; 1834 $self->{cursor} = length substr $text, 0, $idx;
1655 1835
1656 $self->_set_text ($self->{text}); 1836 $self->_set_text ($self->{text});
1657 $self->update; 1837 $self->update;
1838
1839 1
1658} 1840}
1659 1841
1660sub mouse_motion { 1842sub invoke_mouse_motion {
1661 my ($self, $ev, $x, $y) = @_; 1843 my ($self, $ev, $x, $y) = @_;
1662# 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
1663} 1847}
1664 1848
1665sub _draw { 1849sub _draw {
1666 my ($self) = @_; 1850 my ($self) = @_;
1667 1851
1668 local $self->{fg} = $self->{fg}; 1852 local $self->{fg} = $self->{fg};
1669 1853
1670 if ($FOCUS == $self) { 1854 if ($FOCUS == $self) {
1671 glColor @{$self->{active_bg}}; 1855 glColor_premultiply @{$self->{active_bg}};
1672 $self->{fg} = $self->{active_fg}; 1856 $self->{fg} = $self->{active_fg};
1673 } else { 1857 } else {
1674 glColor @{$self->{bg}}; 1858 glColor_premultiply @{$self->{bg}};
1675 } 1859 }
1676 1860
1677 glEnable GL_BLEND; 1861 glEnable GL_BLEND;
1678 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 1862 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1679 glBegin GL_QUADS; 1863 glBegin GL_QUADS;
1680 glVertex 0 , 0; 1864 glVertex 0 , 0;
1681 glVertex 0 , $self->{h}; 1865 glVertex 0 , $self->{h};
1682 glVertex $self->{w}, $self->{h}; 1866 glVertex $self->{w}, $self->{h};
1683 glVertex $self->{w}, 0; 1867 glVertex $self->{w}, 0;
… …
1708 1892
1709our @ISA = CFClient::UI::EntryBase::; 1893our @ISA = CFClient::UI::EntryBase::;
1710 1894
1711use CFClient::OpenGL; 1895use CFClient::OpenGL;
1712 1896
1713sub key_down { 1897sub invoke_key_down {
1714 my ($self, $ev) = @_; 1898 my ($self, $ev) = @_;
1715 1899
1716 my $sym = $ev->{sym}; 1900 my $sym = $ev->{sym};
1717 1901
1718 if ($sym == 13) { 1902 if ($sym == 13) {
1719 unshift @{$self->{history}}, 1903 unshift @{$self->{history}},
1720 my $txt = $self->get_text; 1904 my $txt = $self->get_text;
1905
1721 $self->{history_pointer} = -1; 1906 $self->{history_pointer} = -1;
1722 $self->{history_saveback} = ''; 1907 $self->{history_saveback} = '';
1723 $self->_emit (activate => $txt); 1908 $self->emit (activate => $txt);
1724 $self->update; 1909 $self->update;
1725 1910
1726 } elsif ($sym == CFClient::SDLK_UP) { 1911 } elsif ($sym == CFClient::SDLK_UP) {
1727 if ($self->{history_pointer} < 0) { 1912 if ($self->{history_pointer} < 0) {
1728 $self->{history_saveback} = $self->get_text; 1913 $self->{history_saveback} = $self->get_text;
… …
1744 } else { 1929 } else {
1745 $self->set_text ($self->{history_saveback}); 1930 $self->set_text ($self->{history_saveback});
1746 } 1931 }
1747 1932
1748 } else { 1933 } else {
1749 $self->SUPER::key_down ($ev); 1934 return $self->SUPER::invoke_key_down ($ev)
1935 }
1936
1750 } 1937 1
1751
1752} 1938}
1753 1939
1754############################################################################# 1940#############################################################################
1755 1941
1756package CFClient::UI::Button; 1942package CFClient::UI::Button;
… …
1765 1951
1766sub new { 1952sub new {
1767 my $class = shift; 1953 my $class = shift;
1768 1954
1769 $class->SUPER::new ( 1955 $class->SUPER::new (
1770 padding => 4, 1956 padding_x => 4,
1957 padding_y => 4,
1771 fg => [1, 1, 1], 1958 fg => [1, 1, 1],
1772 active_fg => [0, 0, 1], 1959 active_fg => [0, 0, 1],
1773 can_hover => 1, 1960 can_hover => 1,
1774 align => 0, 1961 align => 0,
1775 valign => 0, 1962 valign => 0,
1776 can_events => 1, 1963 can_events => 1,
1777 @_ 1964 @_
1778 ) 1965 )
1779} 1966}
1780 1967
1781sub activate { }
1782
1783sub button_up { 1968sub invoke_button_up {
1784 my ($self, $ev, $x, $y) = @_; 1969 my ($self, $ev, $x, $y) = @_;
1785 1970
1786 $self->emit ("activate") 1971 $self->emit ("activate")
1787 if $x >= 0 && $x < $self->{w} 1972 if $x >= 0 && $x < $self->{w}
1788 && $y >= 0 && $y < $self->{h}; 1973 && $y >= 0 && $y < $self->{h};
1974
1975 1
1789} 1976}
1790 1977
1791sub _draw { 1978sub _draw {
1792 my ($self) = @_; 1979 my ($self) = @_;
1793 1980
1794 local $self->{fg} = $self->{fg}; 1981 local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1795
1796 if ($GRAB == $self) {
1797 $self->{fg} = $self->{active_fg};
1798 }
1799 1982
1800 glEnable GL_TEXTURE_2D; 1983 glEnable GL_TEXTURE_2D;
1801 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1984 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1802 glColor 0, 0, 0, 1; 1985 glColor 0, 0, 0, 1;
1803 1986
… …
1808 $self->SUPER::_draw; 1991 $self->SUPER::_draw;
1809} 1992}
1810 1993
1811############################################################################# 1994#############################################################################
1812 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
2028}
2029
2030#############################################################################
2031
1813package CFClient::UI::CheckBox; 2032package CFClient::UI::CheckBox;
1814 2033
1815our @ISA = CFClient::UI::DrawBG::; 2034our @ISA = CFClient::UI::DrawBG::;
1816 2035
1817my @tex = 2036my @tex =
… …
1822 2041
1823sub new { 2042sub new {
1824 my $class = shift; 2043 my $class = shift;
1825 2044
1826 $class->SUPER::new ( 2045 $class->SUPER::new (
1827 padding => 2, 2046 padding_x => 2,
2047 padding_y => 2,
1828 fg => [1, 1, 1], 2048 fg => [1, 1, 1],
1829 active_fg => [1, 1, 0], 2049 active_fg => [1, 1, 0],
1830 bg => [0, 0, 0, 0.2], 2050 bg => [0, 0, 0, 0.2],
1831 active_bg => [1, 1, 1, 0.5], 2051 active_bg => [1, 1, 1, 0.5],
1832 state => 0, 2052 state => 0,
… …
1836} 2056}
1837 2057
1838sub size_request { 2058sub size_request {
1839 my ($self) = @_; 2059 my ($self) = @_;
1840 2060
1841 ($self->{padding} * 2 + 6) x 2 2061 (6) x 2
1842} 2062}
1843 2063
1844sub button_down { 2064sub invoke_button_down {
1845 my ($self, $ev, $x, $y) = @_; 2065 my ($self, $ev, $x, $y) = @_;
1846 2066
1847 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 2067 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1848 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 2068 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1849 $self->{state} = !$self->{state}; 2069 $self->{state} = !$self->{state};
1850 $self->_emit (changed => $self->{state}); 2070 $self->emit (changed => $self->{state});
2071 } else {
2072 return 0
2073 }
2074
1851 } 2075 1
1852} 2076}
1853 2077
1854sub _draw { 2078sub _draw {
1855 my ($self) = @_; 2079 my ($self) = @_;
1856 2080
1857 $self->SUPER::_draw; 2081 $self->SUPER::_draw;
1858 2082
1859 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 2083 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1860 2084
1861 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;
1862 2088
1863 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 2089 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1864 2090
1865 my $tex = $self->{state} ? $tex[1] : $tex[0]; 2091 my $tex = $self->{state} ? $tex[1] : $tex[0];
1866 2092
… …
1874package CFClient::UI::Image; 2100package CFClient::UI::Image;
1875 2101
1876our @ISA = CFClient::UI::Base::; 2102our @ISA = CFClient::UI::Base::;
1877 2103
1878use CFClient::OpenGL; 2104use CFClient::OpenGL;
1879use Carp qw/confess/;
1880 2105
1881our %loaded_images; 2106our %texture_cache;
1882 2107
1883sub new { 2108sub new {
1884 my $class = shift; 2109 my $class = shift;
1885 2110
1886 my $self = $class->SUPER::new (can_events => 0, @_); 2111 my $self = $class->SUPER::new (
2112 can_events => 0,
2113 @_,
2114 );
1887 2115
1888 $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";
1889 2118
1890 $loaded_images{$self->{image}} ||= 2119 $self->{tex} = $texture_cache{$self->{path}} ||=
1891 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;
1892 2121
1893 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2122 Scalar::Util::weaken $texture_cache{$self->{path}};
1894 2123
1895 Scalar::Util::weaken $loaded_images{$self->{image}}; 2124 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
1896
1897 $self->{aspect} = $tex->{w} / $tex->{h};
1898 2125
1899 $self 2126 $self
1900} 2127}
1901 2128
1902sub size_request { 2129sub size_request {
1903 my ($self) = @_; 2130 my ($self) = @_;
1904 2131
1905 ($self->{tex}->{w}, $self->{tex}->{h}) 2132 ($self->{tex}{w}, $self->{tex}{h})
1906} 2133}
1907 2134
1908sub _draw { 2135sub _draw {
1909 my ($self) = @_; 2136 my ($self) = @_;
1910 2137
… …
2021 2248
2022 my $h1 = $self->{h} * (1 - $ycut1); 2249 my $h1 = $self->{h} * (1 - $ycut1);
2023 my $h2 = $self->{h} * (1 - $ycut2); 2250 my $h2 = $self->{h} * (1 - $ycut2);
2024 2251
2025 glEnable GL_BLEND; 2252 glEnable GL_BLEND;
2026 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;
2027 glEnable GL_TEXTURE_2D; 2255 glEnable GL_TEXTURE_2D;
2028 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2256 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2029 2257
2030 glBindTexture GL_TEXTURE_2D, $t1->{name}; 2258 glBindTexture GL_TEXTURE_2D, $t1->{name};
2031 glBegin GL_QUADS; 2259 glBegin GL_QUADS;
… …
2131 fg => [1, 1, 1], 2359 fg => [1, 1, 1],
2132 active_fg => [0, 0, 0], 2360 active_fg => [0, 0, 0],
2133 bg => [0, 0, 0, 0.2], 2361 bg => [0, 0, 0, 0.2],
2134 active_bg => [1, 1, 1, 0.5], 2362 active_bg => [1, 1, 1, 0.5],
2135 range => [0, 0, 100, 10, 0], 2363 range => [0, 0, 100, 10, 0],
2136 req_w => $::WIDTH / 80, 2364 min_w => $::WIDTH / 80,
2137 req_h => $::WIDTH / 80, 2365 min_h => $::WIDTH / 80,
2138 vertical => 0, 2366 vertical => 0,
2139 can_hover => 1, 2367 can_hover => 1,
2140 inner_pad => 0.02, 2368 inner_pad => 0.02,
2141 @_ 2369 @_
2142 ); 2370 );
… …
2150sub set_range { 2378sub set_range {
2151 my ($self, $range) = @_; 2379 my ($self, $range) = @_;
2152 2380
2153 ($range, $self->{range}) = ($self->{range}, $range); 2381 ($range, $self->{range}) = ($self->{range}, $range);
2154 2382
2155 $self->update
2156 if "@$range" ne "@{$self->{range}}"; 2383 if ("@$range" ne "@{$self->{range}}") {
2384 $self->update;
2385 $self->set_value ($self->{range}[0]);
2386 }
2157} 2387}
2158 2388
2159sub set_value { 2389sub set_value {
2160 my ($self, $value) = @_; 2390 my ($self, $value) = @_;
2161 2391
… …
2172 if $unit; 2402 if $unit;
2173 2403
2174 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2404 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2175 2405
2176 if ($value != $old_value) { 2406 if ($value != $old_value) {
2177 $self->_emit (changed => $value); 2407 $self->emit (changed => $value);
2178 $self->update; 2408 $self->update;
2179 } 2409 }
2180} 2410}
2181 2411
2182sub size_request { 2412sub size_request {
2183 my ($self) = @_; 2413 my ($self) = @_;
2184 2414
2185 my $w = $self->{req_w}; 2415 ($self->{req_w}, $self->{req_h})
2186 my $h = $self->{req_h};
2187
2188 $self->{vertical} ? ($h, $w) : ($w, $h)
2189} 2416}
2190 2417
2191sub button_down { 2418sub invoke_button_down {
2192 my ($self, $ev, $x, $y) = @_; 2419 my ($self, $ev, $x, $y) = @_;
2193 2420
2194 $self->SUPER::button_down ($ev, $x, $y); 2421 $self->SUPER::invoke_button_down ($ev, $x, $y);
2195 2422
2196 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2423 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2197 2424
2198 $self->mouse_motion ($ev, $x, $y); 2425 $self->invoke_mouse_motion ($ev, $x, $y)
2199} 2426}
2200 2427
2201sub mouse_motion { 2428sub invoke_mouse_motion {
2202 my ($self, $ev, $x, $y) = @_; 2429 my ($self, $ev, $x, $y) = @_;
2203 2430
2204 if ($GRAB == $self) { 2431 if ($GRAB == $self) {
2205 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2432 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2206 2433
2207 my (undef, $lo, $hi, $page) = @{$self->{range}}; 2434 my (undef, $lo, $hi, $page) = @{$self->{range}};
2208 2435
2209 $x = ($x - $self->{click}[1]) / ($w * $self->{scale}); 2436 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2210 2437
2211 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); 2438 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2439 } else {
2440 return 0;
2441 }
2442
2212 } 2443 1
2213} 2444}
2214 2445
2215sub update { 2446sub update {
2216 my ($self) = @_; 2447 my ($self) = @_;
2217 2448
2218 $CFClient::UI::ROOT->on_post_alloc ($self => sub { 2449 delete $self->{knob_w};
2450 $self->SUPER::update;
2451}
2452
2453sub _draw {
2454 my ($self) = @_;
2455
2456 unless ($self->{knob_w}) {
2219 $self->set_value ($self->{range}[0]); 2457 $self->set_value ($self->{range}[0]);
2220 2458
2221 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2459 my ($value, $lo, $hi, $page) = @{$self->{range}};
2222 my $range = ($hi - $page - $lo) || 1e-100; 2460 my $range = ($hi - $page - $lo) || 1e-100;
2223 2461
… …
2229 $value = ($value - $lo) / $range; 2467 $value = ($value - $lo) / $range;
2230 $value = $value * $self->{scale} + $self->{offset}; 2468 $value = $value * $self->{scale} + $self->{offset};
2231 2469
2232 $self->{knob_x} = $value - $knob_w * 0.5; 2470 $self->{knob_x} = $value - $knob_w * 0.5;
2233 $self->{knob_w} = $knob_w; 2471 $self->{knob_w} = $knob_w;
2234 }); 2472 }
2235
2236 $self->SUPER::update;
2237}
2238
2239sub _draw {
2240 my ($self) = @_;
2241 2473
2242 $self->SUPER::_draw (); 2474 $self->SUPER::_draw ();
2243 2475
2244 glScale $self->{w}, $self->{h}; 2476 glScale $self->{w}, $self->{h};
2245 2477
… …
2306sub set_range { shift->{slider}->set_range (@_) } 2538sub set_range { shift->{slider}->set_range (@_) }
2307sub set_value { shift->{slider}->set_value (@_) } 2539sub set_value { shift->{slider}->set_value (@_) }
2308 2540
2309############################################################################# 2541#############################################################################
2310 2542
2311package CFClient::UI::TextView; 2543package CFClient::UI::TextScroller;
2312 2544
2313our @ISA = CFClient::UI::HBox::; 2545our @ISA = CFClient::UI::HBox::;
2314 2546
2315use CFClient::OpenGL; 2547use CFClient::OpenGL;
2316 2548
… …
2318 my $class = shift; 2550 my $class = shift;
2319 2551
2320 my $self = $class->SUPER::new ( 2552 my $self = $class->SUPER::new (
2321 fontsize => 1, 2553 fontsize => 1,
2322 can_events => 0, 2554 can_events => 0,
2555 indent => 0,
2323 #font => default_font 2556 #font => default_font
2324 @_, 2557 @_,
2325 2558
2326 layout => (new CFClient::Layout 1), 2559 layout => (new CFClient::Layout 1),
2327 par => [], 2560 par => [],
… …
2342 2575
2343 $self->{fontsize} = $fontsize; 2576 $self->{fontsize} = $fontsize;
2344 $self->reflow; 2577 $self->reflow;
2345} 2578}
2346 2579
2580sub visible_children {
2581 my ($self) = @_;
2582
2583 @{$self->{children}}[0,1]
2584}
2585
2347sub size_allocate { 2586sub invoke_size_allocate {
2348 my ($self, $w, $h) = @_; 2587 my ($self, $w, $h) = @_;
2349 2588
2350 $self->SUPER::size_allocate ($w, $h); 2589 my ($empty, $slider, @other) = @{ $self->{children} };
2590 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2351 2591
2352 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2592 $self->{layout}->set_font ($self->{font}) if $self->{font};
2353 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2593 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2354 $self->{layout}->set_width ($self->{children}[0]{w}); 2594 $self->{layout}->set_width ($empty->{w});
2595 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2355 2596
2356 $self->reflow; 2597 $self->reflow;
2357}
2358 2598
2359sub text_size { 2599 $self->SUPER::invoke_size_allocate ($w, $h)
2360 my ($self, $text, $indent) = @_; 2600}
2601
2602sub get_layout {
2603 my ($self, $para) = @_;
2361 2604
2362 my $layout = $self->{layout}; 2605 my $layout = $self->{layout};
2363 2606
2607 $layout->set_font ($self->{font}) if $self->{font};
2608 $layout->set_foreground (@{$para->{fg}});
2364 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2609 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2365 $layout->set_width ($self->{children}[0]{w} - $indent); 2610 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2611 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2366 $layout->set_markup ($text); 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}}
2367 2618 );
2619
2368 $layout->size 2620 $layout
2369} 2621}
2370 2622
2371sub reflow { 2623sub reflow {
2372 my ($self) = @_; 2624 my ($self) = @_;
2373 2625
… …
2382 $self->{children}[1]->set_value ($offset); 2634 $self->{children}[1]->set_value ($offset);
2383} 2635}
2384 2636
2385sub clear { 2637sub clear {
2386 my ($self) = @_; 2638 my ($self) = @_;
2639
2640 my (undef, undef, @other) = @{ $self->{children} };
2641 $self->remove ($_) for @other;
2387 2642
2388 $self->{par} = []; 2643 $self->{par} = [];
2389 $self->{height} = 0; 2644 $self->{height} = 0;
2390 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2645 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2391} 2646}
2392 2647
2393sub add_paragraph { 2648sub add_paragraph {
2394 my ($self, $color, $text, $indent) = @_; 2649 my ($self, $color, $para, $indent) = @_;
2395 2650
2396 for my $line (split /\n/, $text) { 2651 my ($text, @w) = ref $para ? @$para : $para;
2397 my ($w, $h) = $self->text_size ($line); 2652
2398 $self->{height} += $h; 2653 $para = {
2399 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 2654 w => 1e10,
2655 wrapped => 1,
2656 fg => $color,
2657 indent => $indent,
2658 markup => $text,
2659 widget => \@w,
2400 } 2660 };
2401 2661
2402 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 2662 $self->add (@w) if @w;
2663 push @{$self->{par}}, $para;
2664
2665 $self->{need_reflow}++;
2666 $self->update;
2667}
2668
2669sub scroll_to_bottom {
2670 my ($self) = @_;
2671
2672 $self->{scroll_to_bottom} = 1;
2673 $self->update;
2403} 2674}
2404 2675
2405sub update { 2676sub update {
2406 my ($self) = @_; 2677 my ($self) = @_;
2407 2678
… …
2409 2680
2410 return unless $self->{h} > 0; 2681 return unless $self->{h} > 0;
2411 2682
2412 delete $self->{texture}; 2683 delete $self->{texture};
2413 2684
2414 $ROOT->on_post_alloc ($self, sub { 2685 $ROOT->on_post_alloc ($self => sub {
2415 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2686 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2416 2687
2417 if (delete $self->{need_reflow}) { 2688 if (delete $self->{need_reflow}) {
2418 my $height = 0; 2689 my $height = 0;
2419 2690
2420 my $layout = $self->{layout};
2421
2422 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2423
2424 for (@{$self->{par}}) { 2691 for my $para (@{$self->{par}}) {
2425 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2692 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2426 $layout->set_width ($W - $_->[3]); 2693 my $layout = $self->get_layout ($para);
2427 $layout->set_markup ($_->[4]);
2428 my ($w, $h) = $layout->size; 2694 my ($w, $h) = $layout->size;
2429 $_->[0] = $w + $_->[3]; 2695
2430 $_->[1] = $h; 2696 $para->{w} = $w + $para->{indent};
2697 $para->{h} = $h;
2698 $para->{wrapped} = $layout->has_wrapped;
2431 } 2699 }
2432 2700
2433 $height += $_->[1]; 2701 $height += $para->{h};
2434 } 2702 }
2435 2703
2436 $self->{height} = $height; 2704 $self->{height} = $height;
2437 2705
2438 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]); 2706 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2439 2707
2440 delete $self->{texture}; 2708 delete $self->{texture};
2441 } 2709 }
2442 2710
2711 if (delete $self->{scroll_to_bottom}) {
2712 $self->{children}[1]->set_value (1e10);
2713 }
2714
2443 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2715 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2444 glClearColor 0.5, 0.5, 0.5, 0; 2716 glClearColor 0, 0, 0, 0;
2445 glClear GL_COLOR_BUFFER_BIT; 2717 glClear GL_COLOR_BUFFER_BIT;
2446 2718
2447 my $top = int $self->{children}[1]{range}[0]; 2719 my $top = int $self->{children}[1]{range}[0];
2448 2720
2449 my $y0 = $top; 2721 my $y0 = $top;
2450 my $y1 = $top + $H; 2722 my $y1 = $top + $H;
2451 2723
2452 my $y = 0; 2724 my $y = 0;
2453
2454 my $layout = $self->{layout};
2455
2456 $layout->set_font ($self->{font}) if $self->{font};
2457 2725
2458 glEnable GL_BLEND; 2726 glEnable GL_BLEND;
2459 #TODO# not correct in windows where rgba is forced off 2727 #TODO# not correct in windows where rgba is forced off
2460 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2728 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2461 2729
2462 for my $par (@{$self->{par}}) { 2730 for my $para (@{$self->{par}}) {
2463 my $h = $par->[1]; 2731 my $h = $para->{h};
2464 2732
2465 if ($y0 < $y + $h && $y < $y1) { 2733 if ($y0 < $y + $h && $y < $y1) {
2466 $layout->set_foreground (@{ $par->[2] }); 2734
2467 $layout->set_width ($W - $par->[3]); 2735 my $layout = $self->get_layout ($para);
2468 $layout->set_markup ($par->[4]);
2469 2736
2470 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2737 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2471 2738
2472 glRasterPos $par->[3], $y - $y0; 2739 glRasterPos $para->{indent}, $y - $y0;
2473 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 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 }
2474 } 2754 }
2475 2755
2476 $y += $h; 2756 $y += $h;
2477 } 2757 }
2478 2758
2479 glDisable GL_BLEND; 2759 glDisable GL_BLEND;
2480 }; 2760 };
2481 }); 2761 });
2482} 2762}
2483 2763
2764sub reconfigure {
2765 my ($self) = @_;
2766
2767 $self->SUPER::reconfigure;
2768
2769 $_->{w} = 1e10 for @{ $self->{par} };
2770 $self->reflow;
2771}
2772
2484sub _draw { 2773sub _draw {
2485 my ($self) = @_; 2774 my ($self) = @_;
2486 2775
2487 glEnable GL_TEXTURE_2D; 2776 glEnable GL_TEXTURE_2D;
2488 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2777 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2489 glColor 1, 1, 1, 1; 2778 glColor 0, 0, 0, 1;
2490 $self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2779 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2491 glDisable GL_TEXTURE_2D; 2780 glDisable GL_TEXTURE_2D;
2492 2781
2493 $self->{children}[1]->draw; 2782 $self->{children}[1]->draw;
2494
2495} 2783}
2496 2784
2497############################################################################# 2785#############################################################################
2498 2786
2499package CFClient::UI::Animator; 2787package CFClient::UI::Animator;
… …
2544 2832
2545sub new { 2833sub new {
2546 my $class = shift; 2834 my $class = shift;
2547 2835
2548 my $self = $class->SUPER::new ( 2836 my $self = $class->SUPER::new (
2549 state => 0, 2837 state => 0,
2550 connect_activate => \&toggle_flopper, 2838 on_activate => \&toggle_flopper,
2551 @_ 2839 @_
2552 ); 2840 );
2553 2841
2554 if ($self->{state}) {
2555 $self->{state} = 0;
2556 $self->toggle_flopper;
2557 }
2558
2559 $self 2842 $self
2560} 2843}
2561 2844
2562sub toggle_flopper { 2845sub toggle_flopper {
2563 my ($self) = @_; 2846 my ($self) = @_;
2564 2847
2565 # TODO: use animation 2848 $self->{other}->toggle_visibility;
2566 if ($self->{state} = !$self->{state}) {
2567 $CFClient::UI::ROOT->add ($self->{other});
2568 $self->{other}->move ($self->coord2global (0, $self->{h}));
2569 $self->_emit ("open");
2570 } else {
2571 $CFClient::UI::ROOT->remove ($self->{other});
2572 $self->_emit ("close");
2573 }
2574
2575 $self->_emit (changed => $self->{state});
2576} 2849}
2577 2850
2578############################################################################# 2851#############################################################################
2579 2852
2580package CFClient::UI::Tooltip; 2853package CFClient::UI::Tooltip;
… …
2593} 2866}
2594 2867
2595sub set_tooltip_from { 2868sub set_tooltip_from {
2596 my ($self, $widget) = @_; 2869 my ($self, $widget) = @_;
2597 2870
2871 my $tooltip = $widget->{tooltip};
2872
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
2598 $self->add (new CFClient::UI::Label 2883 $self->add (new CFClient::UI::Label
2599 markup => $widget->{tooltip}, 2884 markup => $tooltip,
2600 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2885 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2601 fontsize => 0.8, 2886 fontsize => 0.8,
2602 fg => [0, 0, 0, 1], 2887 fg => [0, 0, 0, 1],
2603 ellipsise => 0, 2888 ellipsise => 0,
2604 font => ($widget->{tooltip_font} || $::FONT_PROP), 2889 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2611 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 2896 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2612 2897
2613 ($w + 4, $h + 4) 2898 ($w + 4, $h + 4)
2614} 2899}
2615 2900
2616sub size_allocate { 2901sub invoke_size_allocate {
2617 my ($self, $w, $h) = @_; 2902 my ($self, $w, $h) = @_;
2618 2903
2619 $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 });
2620} 2923}
2621 2924
2622sub _draw { 2925sub _draw {
2623 my ($self) = @_; 2926 my ($self) = @_;
2624 2927
… …
2641 glVertex $w, $h; 2944 glVertex $w, $h;
2642 glVertex $w, 0; 2945 glVertex $w, 0;
2643 glEnd; 2946 glEnd;
2644 2947
2645 glTranslate 2 - 0.375, 2 - 0.375; 2948 glTranslate 2 - 0.375, 2 - 0.375;
2949
2646 $self->SUPER::_draw; 2950 $self->SUPER::_draw;
2647} 2951}
2648 2952
2649############################################################################# 2953#############################################################################
2650 2954
… …
2709 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]]; 3013 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2710 3014
2711 if ($tex) { 3015 if ($tex) {
2712 glEnable GL_TEXTURE_2D; 3016 glEnable GL_TEXTURE_2D;
2713 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 3017 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2714 glColor 1, 1, 1, 1; 3018 glColor 0, 0, 0, 1;
2715 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3019 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2716 glDisable GL_TEXTURE_2D; 3020 glDisable GL_TEXTURE_2D;
2717 } 3021 }
2718} 3022}
2719 3023
2720sub DESTROY { 3024sub destroy {
2721 my ($self) = @_; 3025 my ($self) = @_;
2722 3026
2723 $self->{timer}->cancel 3027 $self->{timer}->cancel
2724 if $self->{timer}; 3028 if $self->{timer};
2725 3029
2726 $self->SUPER::DESTROY; 3030 $self->SUPER::destroy;
2727} 3031}
2728 3032
2729############################################################################# 3033#############################################################################
2730 3034
2731package CFClient::UI::Inventory; 3035package CFClient::UI::Buttonbar;
2732 3036
2733our @ISA = CFClient::UI::ScrolledWindow::; 3037our @ISA = CFClient::UI::HBox::;
2734 3038
2735sub new { 3039# TODO: should actualyl wrap buttons and other goodies.
2736 my $class = shift;
2737
2738 my $self = $class->SUPER::new (
2739 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2740 @_,
2741 );
2742
2743 $self
2744}
2745
2746sub set_items {
2747 my ($self, $items) = @_;
2748
2749 $self->{scrolled}->clear;
2750 return unless $items;
2751
2752 my @items = sort {
2753 ($a->{type} <=> $b->{type})
2754 or ($a->{name} cmp $b->{name})
2755 } @$items;
2756
2757 $self->{real_items} = \@items;
2758
2759 my $row = 0;
2760 for my $item (@items) {
2761 CFClient::Item::update_widgets $item;
2762
2763 $self->{scrolled}->add (0, $row, $item->{face_widget});
2764 $self->{scrolled}->add (1, $row, $item->{desc_widget});
2765 $self->{scrolled}->add (2, $row, $item->{weight_widget});
2766
2767 $row++;
2768 }
2769}
2770
2771sub size_request {
2772 my ($self) = @_;
2773 ($self->{req_w}, $self->{req_h});
2774}
2775 3040
2776############################################################################# 3041#############################################################################
2777 3042
2778package CFClient::UI::Menu; 3043package CFClient::UI::Menu;
2779 3044
… …
2791 ); 3056 );
2792 3057
2793 $self->add ($self->{vbox} = new CFClient::UI::VBox); 3058 $self->add ($self->{vbox} = new CFClient::UI::VBox);
2794 3059
2795 for my $item (@{ $self->{items} }) { 3060 for my $item (@{ $self->{items} }) {
2796 my ($widget, $cb) = @$item; 3061 my ($widget, $cb, $tooltip) = @$item;
2797 3062
2798 # handle various types of items, only text for now 3063 # handle various types of items, only text for now
2799 if (!ref $widget) { 3064 if (!ref $widget) {
2800 $widget = new CFClient::UI::Label 3065 $widget = new CFClient::UI::Label
2801 can_hover => 1, 3066 can_hover => 1,
2802 can_events => 1, 3067 can_events => 1,
2803 text => $widget; 3068 markup => $widget,
3069 tooltip => $tooltip
2804 } 3070 }
2805 3071
2806 $self->{item}{$widget} = $item; 3072 $self->{item}{$widget} = $item;
2807 3073
2808 $self->{vbox}->add ($widget); 3074 $self->{vbox}->add ($widget);
… …
2813 3079
2814# popup given the event (must be a mouse button down event currently) 3080# popup given the event (must be a mouse button down event currently)
2815sub popup { 3081sub popup {
2816 my ($self, $ev) = @_; 3082 my ($self, $ev) = @_;
2817 3083
2818 $self->_emit ("popdown"); 3084 $self->emit ("popdown");
2819 3085
2820 # maybe save $GRAB? must be careful about events... 3086 # maybe save $GRAB? must be careful about events...
2821 $GRAB = $self; 3087 $GRAB = $self;
2822 $self->{button} = $ev->{button}; 3088 $self->{button} = $ev->{button};
2823 3089
2824 $self->show; 3090 $self->show;
2825 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 3091 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2826} 3092}
2827 3093
2828sub mouse_motion { 3094sub invoke_mouse_motion {
2829 my ($self, $ev, $x, $y) = @_; 3095 my ($self, $ev, $x, $y) = @_;
2830 3096
2831 # TODO: should use vbox->find_widget or so 3097 # TODO: should use vbox->find_widget or so
2832 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3098 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2833 $self->{hover} = $self->{item}{$HOVER}; 3099 $self->{hover} = $self->{item}{$HOVER};
2834}
2835 3100
3101 0
3102}
3103
2836sub button_up { 3104sub invoke_button_up {
2837 my ($self, $ev, $x, $y) = @_; 3105 my ($self, $ev, $x, $y) = @_;
2838 3106
2839 if ($ev->{button} == $self->{button}) { 3107 if ($ev->{button} == $self->{button}) {
2840 undef $GRAB; 3108 undef $GRAB;
2841 $self->hide; 3109 $self->hide;
2842 3110
2843 $self->_emit ("popdown"); 3111 $self->emit ("popdown");
2844 $self->{hover}[1]->() if $self->{hover}; 3112 $self->{hover}[1]->() if $self->{hover};
3113 } else {
3114 return 0
3115 }
3116
2845 } 3117 1
2846} 3118}
2847 3119
2848############################################################################# 3120#############################################################################
2849 3121
2850package CFClient::UI::Statusbox; 3122package CFClient::UI::Multiplexer;
2851 3123
2852our @ISA = CFClient::UI::VBox::; 3124our @ISA = CFClient::UI::Container::;
2853 3125
2854sub new { 3126sub new {
2855 my $class = shift; 3127 my $class = shift;
2856 3128
2857 $class->SUPER::new ( 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 (
2858 fontsize => 0.8, 3296 fontsize => 0.8,
2859 @_, 3297 @_,
2860 ) 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
2861} 3305}
2862 3306
2863sub reorder { 3307sub reorder {
2864 my ($self) = @_; 3308 my ($self) = @_;
2865 my $NOW = time; 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} };
2866 3315
2867 while (my ($k, $v) = each %{ $self->{item} }) { 3316 while (my ($k, $v) = each %{ $self->{item} }) {
2868 delete $self->{item}{$k} if $v->{timeout} < $NOW; 3317 delete $self->{item}{$k} if $v->{timeout} < $NOW;
2869 } 3318 }
2870 3319
… …
2873 my @items = sort { 3322 my @items = sort {
2874 $a->{pri} <=> $b->{pri} 3323 $a->{pri} <=> $b->{pri}
2875 or $b->{id} <=> $a->{id} 3324 or $b->{id} <=> $a->{id}
2876 } values %{ $self->{item} }; 3325 } values %{ $self->{item} };
2877 3326
3327 $self->{timer}->interval (1);
3328
2878 my $count = 10 + 1; 3329 my $count = 10 + 1;
2879 for my $item (@items) { 3330 for my $item (@items) {
2880 last unless --$count; 3331 last unless --$count;
2881 3332
2882 push @widgets, $item->{label} ||= do { 3333 my $label = $item->{label} ||= do {
2883 # TODO: doesn't handle markup well (read as: at all) 3334 # TODO: doesn't handle markup well (read as: at all)
2884 my $short = $item->{count} > 1 3335 my $short = $item->{count} > 1
2885 ? "<b>$item->{count} ×</b> $item->{text}" 3336 ? "<b>$item->{count} ×</b> $item->{text}"
2886 : $item->{text}; 3337 : $item->{text};
2887 3338
… …
2895 tooltip => $item->{tooltip}, 3346 tooltip => $item->{tooltip},
2896 tooltip_font => $::FONT_PROP, 3347 tooltip_font => $::FONT_PROP,
2897 tooltip_width => 0.67, 3348 tooltip_width => 0.67,
2898 fontsize => $item->{fontsize} || $self->{fontsize}, 3349 fontsize => $item->{fontsize} || $self->{fontsize},
2899 max_w => $::WIDTH * 0.44, 3350 max_w => $::WIDTH * 0.44,
2900 fg => $item->{fg}, 3351 fg => [@{ $item->{fg} }],
2901 can_events => 1, 3352 can_events => 1,
2902 can_hover => 1 3353 can_hover => 1
2903 }; 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;
2904 } 3367 }
2905 3368
2906 $self->clear; 3369 $self->clear;
2907 $self->SUPER::add (reverse @widgets); 3370 $self->SUPER::add (reverse @widgets);
2908} 3371}
… …
2913 $text =~ s/^\s+//; 3376 $text =~ s/^\s+//;
2914 $text =~ s/\s+$//; 3377 $text =~ s/\s+$//;
2915 3378
2916 return unless $text; 3379 return unless $text;
2917 3380
2918 my $timeout = time + ((delete $arg{timeout}) || 60); 3381 my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2919 3382
2920 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 3383 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2921 3384
2922 if (my $item = $self->{item}{$group}) { 3385 if (my $item = $self->{item}{$group}) {
2923 if ($item->{text} eq $text) { 3386 if ($item->{text} eq $text) {
2924 $item->{count}++; 3387 $item->{count}++;
2925 } else { 3388 } else {
2926 $item->{count} = 1; 3389 $item->{count} = 1;
2927 $item->{text} = $item->{tooltip} = $text; 3390 $item->{text} = $item->{tooltip} = $text;
2928 } 3391 }
2929 $item->{id} = ++$self->{id}; 3392 $item->{id} += 0.2;#d#
2930 $item->{timeout} = $timeout; 3393 $item->{timeout} = $timeout;
2931 delete $item->{label}; 3394 delete $item->{label};
2932 } else { 3395 } else {
2933 $self->{item}{$group} = { 3396 $self->{item}{$group} = {
2934 id => ++$self->{id}, 3397 id => ++$self->{id},
… …
2953 3416
2954 $self->reorder; 3417 $self->reorder;
2955 $self->SUPER::reconfigure; 3418 $self->SUPER::reconfigure;
2956} 3419}
2957 3420
3421sub destroy {
3422 my ($self) = @_;
3423
3424 $self->{timer}->cancel;
3425
3426 $self->SUPER::destroy;
3427}
3428
2958############################################################################# 3429#############################################################################
2959 3430
2960package CFClient::UI::Root; 3431package CFClient::UI::Inventory;
2961 3432
2962our @ISA = CFClient::UI::Container::; 3433our @ISA = CFClient::UI::ScrolledWindow::;
2963
2964use CFClient::OpenGL;
2965 3434
2966sub new { 3435sub new {
2967 my $class = shift; 3436 my $class = shift;
2968 3437
2969 $class->SUPER::new ( 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 => [],
3691 @_,
3692 )
3693}
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 (
2970 visible => 1, 3815 visible => 1,
2971 @_, 3816 @_,
2972 ) 3817 );
2973}
2974 3818
2975sub configure { 3819 Scalar::Util::weaken ($self->{root} = $self);
2976 my ($self, $x, $y, $w, $h) = @_;
2977 3820
2978 $self->{w} = $w; 3821 $self
2979 $self->{h} = $h;
2980}
2981
2982sub check_size {
2983 my ($self) = @_;
2984
2985 $self->size_allocate ($self->{w}, $self->{h})
2986 if $self->{w};
2987} 3822}
2988 3823
2989sub size_request { 3824sub size_request {
2990 my ($self) = @_; 3825 my ($self) = @_;
2991 3826
2992 ($self->{w}, $self->{h}) 3827 ($self->{w}, $self->{h})
2993} 3828}
2994 3829
3830sub _to_pixel {
3831 my ($coord, $size, $max) = @_;
3832
3833 $coord =
3834 $coord eq "center" ? ($max - $size) * 0.5
3835 : $coord eq "max" ? $max
3836 : $coord;
3837
3838 $coord = 0 if $coord < 0;
3839 $coord = $max - $size if $coord > $max - $size;
3840
3841 int $coord + 0.5
3842}
3843
2995sub size_allocate { 3844sub invoke_size_allocate {
2996 my ($self, $w, $h) = @_; 3845 my ($self, $w, $h) = @_;
2997 3846
2998 for my $child ($self->children) { 3847 for my $child ($self->children) {
2999 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)};
3000 3849
3001 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3850 $X = $child->{force_x} if exists $child->{force_x};
3002 if exists $child->{req_x}; 3851 $Y = $child->{force_y} if exists $child->{force_y};
3003 3852
3004 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3853 $X = _to_pixel $X, $W, $self->{w};
3005 if exists $child->{req_y}; 3854 $Y = _to_pixel $Y, $H, $self->{h};
3006
3007 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3008 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3009 3855
3010 $child->configure ($X, $Y, $W, $H); 3856 $child->configure ($X, $Y, $W, $H);
3011 } 3857 }
3858
3859 1
3012} 3860}
3013 3861
3014sub coord2local { 3862sub coord2local {
3015 my ($self, $x, $y) = @_; 3863 my ($self, $x, $y) = @_;
3016 3864
… …
3024} 3872}
3025 3873
3026sub update { 3874sub update {
3027 my ($self) = @_; 3875 my ($self) = @_;
3028 3876
3029 $self->check_size;
3030 $::WANT_REFRESH++; 3877 $::WANT_REFRESH++;
3031} 3878}
3032 3879
3033sub add { 3880sub add {
3034 my ($self, @children) = @_; 3881 my ($self, @children) = @_;
3035 3882
3036 for (my @widgets = @children; my $w = pop @widgets; ) {
3037 push @widgets, $w->children;
3038 $w->{root} = $self;
3039 $w->{visible} = $self->{visible} + 1;
3040 }
3041
3042 for my $child (@children) {
3043 $child->{is_toplevel} = 1; 3883 $_->{is_toplevel} = 1
3044 3884 for @children;
3045 # integerise window positions
3046 $child->{x} = int $child->{x};
3047 $child->{y} = int $child->{y};
3048 }
3049 3885
3050 $self->SUPER::add (@children); 3886 $self->SUPER::add (@children);
3051} 3887}
3052 3888
3053sub remove { 3889sub remove {
3054 my ($self, @children) = @_; 3890 my ($self, @children) = @_;
3055 3891
3056 $self->SUPER::remove (@children); 3892 $self->SUPER::remove (@children);
3893
3894 delete $self->{is_toplevel}
3895 for @children;
3057 3896
3058 while (@children) { 3897 while (@children) {
3059 my $w = pop @children; 3898 my $w = pop @children;
3060 push @children, $w->children; 3899 push @children, $w->children;
3061 $w->set_invisible; 3900 $w->set_invisible;
… …
3080 while ($self->{refresh_hook}) { 3919 while ($self->{refresh_hook}) {
3081 $_->() 3920 $_->()
3082 for values %{delete $self->{refresh_hook}}; 3921 for values %{delete $self->{refresh_hook}};
3083 } 3922 }
3084 3923
3085 if ($self->{check_size}) { 3924 if ($self->{realloc}) {
3086 my @queue = ([], []); 3925 my %queue;
3926 my @queue;
3927 my $widget;
3087 3928
3088 for (;;) { 3929 outer:
3089 if ($self->{check_size}) { 3930 while () {
3090 # heuristic: check containers last 3931 if (my $realloc = delete $self->{realloc}) {
3091 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3932 for $widget (values %$realloc) {
3092 for values %{delete $self->{check_size}} 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 }
3093 } 3939 }
3094 3940
3095 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3941 while () {
3942 @queue or last outer;
3096 3943
3097 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3944 $widget = pop @{ $queue[-1] || [] }
3098 ? @$widget{qw(user_w user_h)} 3945 and last;
3099 : $widget->size_request;
3100
3101 if (delete $widget->{force_alloc}
3102 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3103 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3104 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}) {
3105 $widget->{req_w} = $w; 3965 $widget->{req_w} = $w;
3106 $widget->{req_h} = $h; 3966 $widget->{req_h} = $h;
3107 3967
3108 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3968 $self->{size_alloc}{$widget+0} = $widget;
3109 3969
3110 $widget->{parent}->check_size
3111 if $widget->{parent}; 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 }
3112 } 3977 }
3978
3979 delete $self->{realloc}{$widget+0};
3113 } 3980 }
3114 } 3981 }
3115 3982
3116 while ($self->{size_alloc}) { 3983 while (my $size_alloc = delete $self->{size_alloc}) {
3117 for (values %{delete $self->{size_alloc}}) { 3984 my @queue = sort { $b->{visible} <=> $a->{visible} }
3118 my ($widget, $w, $h) = @$_; 3985 values %$size_alloc;
3986
3987 while () {
3988 my $widget = pop @queue || last;
3989
3990 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3119 3991
3120 $w = 0 if $w < 0; 3992 $w = 0 if $w < 0;
3121 $h = 0 if $h < 0; 3993 $h = 0 if $h < 0;
3122 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
3123 $widget->{w} = $w; 4002 $widget->{w} = $w;
3124 $widget->{h} = $h; 4003 $widget->{h} = $h;
4004
3125 $widget->emit (size_allocate => $w, $h); 4005 $widget->emit (size_allocate => $w, $h);
4006 }
3126 } 4007 }
3127 } 4008 }
3128 4009
3129 while ($self->{post_alloc_hook}) { 4010 while ($self->{post_alloc_hook}) {
3130 $_->() 4011 $_->()
3131 for values %{delete $self->{post_alloc_hook}}; 4012 for values %{delete $self->{post_alloc_hook}};
3132 } 4013 }
4014
3133 4015
3134 glViewport 0, 0, $::WIDTH, $::HEIGHT; 4016 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3135 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 4017 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3136 glClear GL_COLOR_BUFFER_BIT; 4018 glClear GL_COLOR_BUFFER_BIT;
3137 4019
… …
3139 glLoadIdentity; 4021 glLoadIdentity;
3140 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 4022 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3141 glMatrixMode GL_MODELVIEW; 4023 glMatrixMode GL_MODELVIEW;
3142 glLoadIdentity; 4024 glLoadIdentity;
3143 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
3144 $self->_draw; 4033 $self->_draw;
3145} 4034}
3146 4035
3147############################################################################# 4036#############################################################################
3148 4037

Diff Legend

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