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

Diff Legend

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