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.273 by root, Sat Jun 3 02:32:35 2006 UTC vs.
Revision 1.410 by root, Sun Jul 22 16:37:19 2007 UTC

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

Diff Legend

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