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.258 by root, Tue May 30 02:55:45 2006 UTC vs.
Revision 1.305 by root, Sun Jun 18 17:13:12 2006 UTC

… …
3use utf8; 3use utf8;
4use strict; 4use strict;
5 5
6use Scalar::Util (); 6use Scalar::Util ();
7use List::Util (); 7use List::Util ();
8use Event;
8 9
9use CFClient; 10use CFClient;
10use CFClient::Texture; 11use CFClient::Texture;
11 12
12our ($FOCUS, $HOVER, $GRAB); # various widgets 13our ($FOCUS, $HOVER, $GRAB); # various widgets
… …
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->hide;
28
29 $TOOLTIP->{owner} = $widget;
30
31 return if $ENV{CFPLUS_DEBUG} & 8;
32
33 my $tip = $widget->{tooltip};
34
35 $tip = $tip->($widget) if CODE:: eq ref $tip;
36
37 $TOOLTIP->set_tooltip_from ($widget);
38 $TOOLTIP->show;
39 }
40
41 return;
42 }
43 }
44 }
45
46 $TOOLTIP->hide;
47 delete $TOOLTIP->{owner};
48});
20 49
21sub get_layout { 50sub get_layout {
22 my $layout; 51 my $layout;
23 52
24 for (grep { $_->{name} } values %WIDGET) { 53 for (grep { $_->{name} } values %WIDGET) {
… …
39 my ($layout) = @_; 68 my ($layout) = @_;
40 69
41 $LAYOUT = $layout; 70 $LAYOUT = $layout;
42} 71}
43 72
44sub check_tooltip {
45 if (!$GRAB) {
46 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
47 if (length $widget->{tooltip}) {
48
49 if ($TOOLTIP->{owner} != $widget) {
50 $TOOLTIP->hide;
51
52 $TOOLTIP->{owner} = $widget;
53
54 my $tip = $widget->{tooltip};
55
56 $tip = $tip->($widget) if CODE:: eq ref $tip;
57
58 $TOOLTIP->set_tooltip_from ($widget);
59 $TOOLTIP->show;
60 }
61
62 return;
63 }
64 }
65 }
66
67 $TOOLTIP->hide;
68 delete $TOOLTIP->{owner};
69}
70
71# class methods for events 73# class methods for events
72sub feed_sdl_key_down_event { 74sub feed_sdl_key_down_event {
73 $FOCUS->emit (key_down => $_[0]) 75 $FOCUS->emit (key_down => $_[0])
74 if $FOCUS; 76 if $FOCUS;
75} 77}
… …
87 my $widget = $ROOT->find_widget ($x, $y); 89 my $widget = $ROOT->find_widget ($x, $y);
88 90
89 $GRAB = $widget; 91 $GRAB = $widget;
90 $GRAB->update if $GRAB; 92 $GRAB->update if $GRAB;
91 93
92 check_tooltip; 94 $TOOLTIP_WATCHER->cb->();
93 } 95 }
94 96
95 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 97 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
96 98
97 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y)) 99 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
… …
112 if (!$BUTTON_STATE) { 114 if (!$BUTTON_STATE) {
113 my $grab = $GRAB; undef $GRAB; 115 my $grab = $GRAB; undef $GRAB;
114 $grab->update if $grab; 116 $grab->update if $grab;
115 $GRAB->update if $GRAB; 117 $GRAB->update if $GRAB;
116 118
117 check_tooltip; 119 $TOOLTIP_WATCHER->cb->();
118 } 120 }
119} 121}
120 122
121sub feed_sdl_motion_event { 123sub feed_sdl_motion_event {
122 my ($ev) = @_; 124 my ($ev) = @_;
… …
128 my $hover = $HOVER; $HOVER = $widget; 130 my $hover = $HOVER; $HOVER = $widget;
129 131
130 $hover->update if $hover && $hover->{can_hover}; 132 $hover->update if $hover && $hover->{can_hover};
131 $HOVER->update if $HOVER && $HOVER->{can_hover}; 133 $HOVER->update if $HOVER && $HOVER->{can_hover};
132 134
133 check_tooltip; 135 $TOOLTIP_WATCHER->start;
134 } 136 }
135 137
136 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y)) 138 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
137 if $HOVER; 139 if $HOVER;
138} 140}
… …
170sub rescale_widgets { 172sub rescale_widgets {
171 my ($sx, $sy) = @_; 173 my ($sx, $sy) = @_;
172 174
173 for my $widget (values %WIDGET) { 175 for my $widget (values %WIDGET) {
174 if ($widget->{is_toplevel}) { 176 if ($widget->{is_toplevel}) {
175 $widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; 177 $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
176 $widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; 178 $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
177 179
178 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/; 180 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
179 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 181 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
180 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w}; 182 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
181 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/; 183 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
182 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 184 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
183 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h}; 185 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
184 186
185 $widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; 187 $widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
186 $widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; 188 $widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
187 189
188 } 190 }
189 } 191 }
190 192
191 reconfigure_widgets; 193 reconfigure_widgets;
… …
219 $self->connect ($1 => delete $self->{$_}); 221 $self->connect ($1 => delete $self->{$_});
220 } 222 }
221 } 223 }
222 224
223 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) { 225 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
224 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{w} if exists $layout->{x}; 226 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
225 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{h} if exists $layout->{y}; 227 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
226 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{w} if exists $layout->{w}; 228 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
227 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{h} if exists $layout->{h}; 229 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
228 230
229 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x}; 231 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
230 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y}; 232 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
231 233
232 $self->show if $layout->{show}; 234 $self->show if $layout->{show};
… …
270 272
271 return unless $self->{visible}; 273 return unless $self->{visible};
272 274
273 $_->set_invisible for $self->children; 275 $_->set_invisible for $self->children;
274 276
277 delete $self->{visible};
275 delete $self->{root}; 278 delete $self->{root};
276 delete $self->{visible};
277 279
278 undef $GRAB if $GRAB == $self; 280 undef $GRAB if $GRAB == $self;
279 undef $HOVER if $HOVER == $self; 281 undef $HOVER if $HOVER == $self;
280 282
281 CFClient::UI::check_tooltip 283 $CFClient::UI::TOOLTIP_WATCHER->cb->()
282 if $TOOLTIP->{owner} == $self; 284 if $TOOLTIP->{owner} == $self;
283 285
284 $self->focus_out; 286 $self->emit ("focus_out");
285
286 $self->emit (visibility_change => 0); 287 $self->emit (visibility_change => 0);
287} 288}
288 289
289sub set_visibility { 290sub set_visibility {
290 my ($self, $visible) = @_; 291 my ($self, $visible) = @_;
… …
313} 314}
314 315
315sub move_abs { 316sub move_abs {
316 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
317 318
318 $self->{x} = List::Util::max 0, int $x; 319 $self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
319 $self->{y} = List::Util::max 0, int $y; 320 $self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
320 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
321 322
322 $self->update; 323 $self->update;
323} 324}
324 325
… …
355 $self->{x} = $x; 356 $self->{x} = $x;
356 $self->{y} = $y; 357 $self->{y} = $y;
357 $self->update; 358 $self->update;
358 } 359 }
359 360
360 if ($self->{w} != $w || $self->{h} != $h) { 361 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
361 return unless $self->{visible}; 362 return unless $self->{visible};
362 363
364 $self->{alloc_w} = $w;
365 $self->{alloc_h} = $h;
366
363 $self->{root}->{size_alloc}{$self+0} = [$self, $w, $h]; 367 $self->{root}{size_alloc}{$self+0} = $self;
364 } 368 }
365}
366
367sub size_allocate {
368 # nothing to be done
369} 369}
370 370
371sub children { 371sub children {
372 # nop
373}
374
375sub visible_children {
376 $_[0]->children
372} 377}
373 378
374sub set_max_size { 379sub set_max_size {
375 my ($self, $w, $h) = @_; 380 my ($self, $w, $h) = @_;
376 381
377 delete $self->{max_w}; $self->{max_w} = $w if $w; 382 $self->{max_w} = int $w if defined $w;
378 delete $self->{max_h}; $self->{max_h} = $h if $h; 383 $self->{max_h} = int $h if defined $h;
384
385 $self->realloc;
379} 386}
380 387
381sub set_tooltip { 388sub set_tooltip {
382 my ($self, $tooltip) = @_; 389 my ($self, $tooltip) = @_;
383 390
… …
388 395
389 $self->{tooltip} = $tooltip; 396 $self->{tooltip} = $tooltip;
390 397
391 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 398 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
392 delete $CFClient::UI::TOOLTIP->{owner}; 399 delete $CFClient::UI::TOOLTIP->{owner};
393 CFClient::UI::check_tooltip; 400 $CFClient::UI::TOOLTIP_WATCHER->cb->();
394 } 401 }
395} 402}
396 403
397# translate global coordinates to local coordinate system 404# translate global coordinates to local coordinate system
398sub coord2local { 405sub coord2local {
… …
406 my ($self, $x, $y) = @_; 413 my ($self, $x, $y) = @_;
407 414
408 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 415 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
409} 416}
410 417
411sub focus_in { 418sub invoke_focus_in {
412 my ($self) = @_; 419 my ($self) = @_;
413 420
414 return if $FOCUS == $self; 421 return if $FOCUS == $self;
415 return unless $self->{can_focus}; 422 return unless $self->{can_focus};
416 423
417 my $focus = $FOCUS; $FOCUS = $self; 424 my $focus = $FOCUS; $FOCUS = $self;
418 425
419 $self->_emit (focus_in => $focus);
420
421 $focus->update if $focus; 426 $focus->update if $focus;
422 $FOCUS->update; 427 $FOCUS->update;
423}
424 428
429 0
430}
431
425sub focus_out { 432sub invoke_focus_out {
426 my ($self) = @_; 433 my ($self) = @_;
427 434
428 return unless $FOCUS == $self; 435 return unless $FOCUS == $self;
429 436
430 my $focus = $FOCUS; undef $FOCUS; 437 my $focus = $FOCUS; undef $FOCUS;
431 438
432 $self->_emit (focus_out => $focus);
433
434 $focus->update if $focus; #? 439 $focus->update if $focus; #?
435 440
436 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus 441 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
437 unless $FOCUS; 442 unless $FOCUS;
438}
439 443
444 0
445}
446
447sub grab_focus {
448 my ($self) = @_;
449
450 $self->emit ("focus_in");
451}
452
440sub mouse_motion { } 453sub invoke_mouse_motion { 1 }
441sub button_up { } 454sub invoke_button_up { 1 }
442sub key_down { } 455sub invoke_key_down { 1 }
443sub key_up { } 456sub invoke_key_up { 1 }
444 457
445sub button_down { 458sub invoke_button_down {
446 my ($self, $ev, $x, $y) = @_; 459 my ($self, $ev, $x, $y) = @_;
447 460
448 $self->focus_in; 461 $self->grab_focus;
449}
450 462
451sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 463 1
452sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 464}
453sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 465
454sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 466sub connect {
455sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 467 my ($self, $signal, $cb) = @_;
468
469 push @{ $self->{signal_cb}{$signal} }, $cb;
470}
471
472sub emit {
473 my ($self, $signal, @args) = @_;
474
475 (List::Util::sum +(map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}), # before
476 ($self->can ("invoke_$signal") || sub { 1 })->($self, @args)) # closure
477 || ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
478}
456 479
457sub find_widget { 480sub find_widget {
458 my ($self, $x, $y) = @_; 481 my ($self, $x, $y) = @_;
459 482
460 return () unless $self->{can_events}; 483 return () unless $self->{can_events};
… …
471 494
472 Scalar::Util::weaken ($self->{parent} = $parent); 495 Scalar::Util::weaken ($self->{parent} = $parent);
473 $self->set_visible if $parent->{visible}; 496 $self->set_visible if $parent->{visible};
474} 497}
475 498
476sub connect {
477 my ($self, $signal, $cb) = @_;
478
479 push @{ $self->{signal_cb}{$signal} }, $cb;
480}
481
482sub _emit {
483 my ($self, $signal, @args) = @_;
484
485 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
486}
487
488sub emit {
489 my ($self, $signal, @args) = @_;
490
491 $self->_emit ($signal, @args)
492 || $self->$signal (@args);
493}
494
495sub visibility_change {
496 #my ($self, $visible) = @_;
497}
498
499sub realloc { 499sub realloc {
500 my ($self) = @_; 500 my ($self) = @_;
501 501
502 if ($self->{visible}) { 502 if ($self->{visible}) {
503 return if $self->{root}{realloc}{$self}; 503 return if $self->{root}{realloc}{$self+0};
504 504
505 $self->{root}{realloc}{$self} = $self; 505 $self->{root}{realloc}{$self+0} = $self;
506 $self->{root}->update; 506 $self->{root}->update;
507 } else { 507 } else {
508 delete $self->{req_w}; 508 delete $self->{req_w};
509 delete $self->{req_h};
509 } 510 }
510} 511}
511 512
512sub update { 513sub update {
513 my ($self) = @_; 514 my ($self) = @_;
… …
521 522
522 $self->realloc; 523 $self->realloc;
523 $self->update; 524 $self->update;
524} 525}
525 526
527# using global variables seems a bit hacky, but passing through all drawing
528# functions seems pointless.
529our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
530
526sub draw { 531sub draw {
527 my ($self) = @_; 532 my ($self) = @_;
528 533
529 return unless $self->{h} && $self->{w}; 534 return unless $self->{h} && $self->{w};
535
536 # update screen rectangle
537 local $draw_x = $draw_x + $self->{x};
538 local $draw_y = $draw_y + $self->{y};
539 local $draw_w = $draw_x + $self->{w};
540 local $draw_h = $draw_y + $self->{h};
541
542 # skip widgets that are entirely outside the drawing area
543 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
544 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
530 545
531 glPushMatrix; 546 glPushMatrix;
532 glTranslate $self->{x}, $self->{y}, 0; 547 glTranslate $self->{x}, $self->{y}, 0;
533 $self->_draw;
534 glPopMatrix;
535 548
536 if ($self == $HOVER && $self->{can_hover}) { 549 if ($self == $HOVER && $self->{can_hover}) {
537 my ($x, $y) = @$self{qw(x y)};
538
539 glColor 1, 0.8, 0.5, 0.2; 550 glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
540 glEnable GL_BLEND; 551 glEnable GL_BLEND;
541 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 552 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
542 glBegin GL_QUADS; 553 glBegin GL_QUADS;
543 glVertex $x , $y; 554 glVertex 0 , 0;
544 glVertex $x + $self->{w}, $y; 555 glVertex $self->{w}, 0;
545 glVertex $x + $self->{w}, $y + $self->{h}; 556 glVertex $self->{w}, $self->{h};
546 glVertex $x , $y + $self->{h}; 557 glVertex 0 , $self->{h};
547 glEnd; 558 glEnd;
548 glDisable GL_BLEND; 559 glDisable GL_BLEND;
549 } 560 }
550 561
551 if ($ENV{CFPLUS_DEBUG}) { 562 if ($ENV{CFPLUS_DEBUG} & 1) {
552 glPushMatrix; 563 glPushMatrix;
553 glColor 1, 1, 0, 1; 564 glColor 1, 1, 0, 1;
554 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 565 glTranslate 0.375, 0.375;
555 glBegin GL_LINE_LOOP; 566 glBegin GL_LINE_LOOP;
556 glVertex 0 , 0; 567 glVertex 0 , 0;
557 glVertex $self->{w} - 1, 0; 568 glVertex $self->{w} - 1, 0;
558 glVertex $self->{w} - 1, $self->{h} - 1; 569 glVertex $self->{w} - 1, $self->{h} - 1;
559 glVertex 0 , $self->{h} - 1; 570 glVertex 0 , $self->{h} - 1;
560 glEnd; 571 glEnd;
561 glPopMatrix; 572 glPopMatrix;
562 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 573 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
563 } 574 }
575
576 $self->_draw;
577 glPopMatrix;
564} 578}
565 579
566sub _draw { 580sub _draw {
567 my ($self) = @_; 581 my ($self) = @_;
568 582
… …
571 585
572sub DESTROY { 586sub DESTROY {
573 my ($self) = @_; 587 my ($self) = @_;
574 588
575 delete $WIDGET{$self+0}; 589 delete $WIDGET{$self+0};
576 #$self->deactivate; 590
591 eval { $self->destroy };
592 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
577} 593}
578 594
579############################################################################# 595#############################################################################
580 596
581package CFClient::UI::DrawBG; 597package CFClient::UI::DrawBG;
… …
606 622
607 if ($color && (@$color < 4 || $color->[3])) { 623 if ($color && (@$color < 4 || $color->[3])) {
608 my ($w, $h) = @$self{qw(w h)}; 624 my ($w, $h) = @$self{qw(w h)};
609 625
610 glEnable GL_BLEND; 626 glEnable GL_BLEND;
611 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 627 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
612 glColor @$color; 628 glColor_premultiply @$color;
613 629
614 glBegin GL_QUADS; 630 glBegin GL_QUADS;
615 glVertex 0 , 0; 631 glVertex 0 , 0;
616 glVertex 0 , $h; 632 glVertex 0 , $h;
617 glVertex $w, $h; 633 glVertex $w, $h;
… …
648our @ISA = CFClient::UI::Base::; 664our @ISA = CFClient::UI::Base::;
649 665
650sub new { 666sub new {
651 my ($class, %arg) = @_; 667 my ($class, %arg) = @_;
652 668
653 my $children = delete $arg{children} || []; 669 my $children = delete $arg{children};
654 670
655 my $self = $class->SUPER::new ( 671 my $self = $class->SUPER::new (
656 children => [], 672 children => [],
657 can_events => 0, 673 can_events => 0,
658 %arg, 674 %arg,
659 ); 675 );
676
660 $self->add ($_) for @$children; 677 $self->add (@$children)
678 if $children;
661 679
662 $self 680 $self
663} 681}
664 682
665sub add { 683sub add {
… …
713 $x -= $self->{x}; 731 $x -= $self->{x};
714 $y -= $self->{y}; 732 $y -= $self->{y};
715 733
716 my $res; 734 my $res;
717 735
718 for (reverse @{ $self->{children} }) { 736 for (reverse $self->visible_children) {
719 $res = $_->find_widget ($x, $y) 737 $res = $_->find_widget ($x, $y)
720 and return $res; 738 and return $res;
721 } 739 }
722 740
723 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y}) 741 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
… …
744} 762}
745 763
746sub add { 764sub add {
747 my ($self, $child) = @_; 765 my ($self, $child) = @_;
748 766
749 $self->{children} = []; 767 $self->SUPER::remove ($_) for @{ $self->{children} };
750
751 $self->SUPER::add ($child); 768 $self->SUPER::add ($child);
752} 769}
753 770
754sub remove { 771sub remove {
755 my ($self, $widget) = @_; 772 my ($self, $widget) = @_;
… …
764 781
765sub size_request { 782sub size_request {
766 $_[0]{children}[0]->size_request 783 $_[0]{children}[0]->size_request
767} 784}
768 785
769sub size_allocate { 786sub invoke_size_allocate {
770 my ($self, $w, $h, $changed) = @_; 787 my ($self, $w, $h) = @_;
771 788
772 $self->{children}[0]->configure (0, 0, $w, $h); 789 $self->{children}[0]->configure (0, 0, $w, $h);
790
791 1
773} 792}
774 793
775############################################################################# 794#############################################################################
795
796# back-buffered drawing area
776 797
777package CFClient::UI::Window; 798package CFClient::UI::Window;
778 799
779our @ISA = CFClient::UI::Bin::; 800our @ISA = CFClient::UI::Bin::;
780 801
… …
791 812
792 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 813 $ROOT->on_post_alloc ($self => sub { $self->render_child });
793 $self->SUPER::update; 814 $self->SUPER::update;
794} 815}
795 816
796sub size_allocate { 817sub invoke_size_allocate {
797 my ($self, $w, $h, $changed) = @_; 818 my ($self, $w, $h) = @_;
798 819
799 $self->SUPER::size_allocate ($w, $h, $changed);
800 $self->update 820 $self->update;
801 if $changed; 821
822 $self->SUPER::invoke_size_allocate ($w, $h)
802} 823}
803 824
804sub _render { 825sub _render {
826 my ($self) = @_;
827
805 $_[0]{children}[0]->draw; 828 $self->{children}[0]->draw;
806} 829}
807 830
808sub render_child { 831sub render_child {
809 my ($self) = @_; 832 my ($self) = @_;
810 833
811 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 834 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
812 glClearColor 0, 0, 0, 0; 835 glClearColor 0, 0, 0, 0;
813 glClear GL_COLOR_BUFFER_BIT; 836 glClear GL_COLOR_BUFFER_BIT;
814 837
838 {
839 package CFClient::UI::Base;
840
841 ($draw_x, $draw_y, $draw_w, $draw_h) =
842 (0, 0, $self->{w}, $self->{h});
843 }
844
815 $self->_render; 845 $self->_render;
816 }; 846 };
817} 847}
818 848
819sub _draw { 849sub _draw {
820 my ($self) = @_; 850 my ($self) = @_;
821 851
822 my ($w, $h) = ($self->w, $self->h); 852 my ($w, $h) = @$self{qw(w h)};
823 853
824 my $tex = $self->{texture} 854 my $tex = $self->{texture}
825 or return; 855 or return;
826 856
827 glEnable GL_TEXTURE_2D; 857 glEnable GL_TEXTURE_2D;
828 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 858 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
829 glColor 1, 1, 1, 1; 859 glColor 0, 0, 0, 1;
830 860
831 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h); 861 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
832 862
833 glDisable GL_TEXTURE_2D; 863 glDisable GL_TEXTURE_2D;
834} 864}
… …
850} 880}
851 881
852sub size_request { 882sub size_request {
853 my ($self) = @_; 883 my ($self) = @_;
854 884
855 my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 885 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
856 886
857 $w = 10 if $self->{scroll_x}; 887 $w = 10 if $self->{scroll_x};
858 $h = 10 if $self->{scroll_y}; 888 $h = 10 if $self->{scroll_y};
859 889
860 ($w, $h) 890 ($w, $h)
861} 891}
862 892
863sub size_allocate { 893sub invoke_size_allocate {
864 my ($self, $w, $h, $changed) = @_; 894 my ($self, $w, $h) = @_;
865 895
896 my $child = $self->child;
897
866 $w = $self->{child_w} if $self->{scroll_x} && $self->{child_w}; 898 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
867 $h = $self->{child_h} if $self->{scroll_y} && $self->{child_h}; 899 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
868 900
869 $self->child->configure (0, 0, $w, $h); 901 $self->child->configure (0, 0, $w, $h);
870 $self->update; 902 $self->update;
903
904 1
871} 905}
872 906
873sub set_offset { 907sub set_offset {
874 my ($self, $x, $y) = @_; 908 my ($self, $x, $y) = @_;
875 909
… …
908} 942}
909 943
910sub _render { 944sub _render {
911 my ($self) = @_; 945 my ($self) = @_;
912 946
947 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
948 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
949
913 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 950 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
914 951
915 $self->SUPER::_render; 952 $self->SUPER::_render;
916} 953}
917 954
… …
920package CFClient::UI::ScrolledWindow; 957package CFClient::UI::ScrolledWindow;
921 958
922our @ISA = CFClient::UI::HBox::; 959our @ISA = CFClient::UI::HBox::;
923 960
924sub new { 961sub new {
925 my $class = shift; 962 my ($class, %arg) = @_;
963
964 my $child = delete $arg{child};
926 965
927 my $self; 966 my $self;
928 967
929 my $slider = new CFClient::UI::Slider 968 my $slider = new CFClient::UI::Slider
930 vertical => 1, 969 vertical => 1,
… …
935 ; 974 ;
936 975
937 $self = $class->SUPER::new ( 976 $self = $class->SUPER::new (
938 vp => (new CFClient::UI::ViewPort expand => 1), 977 vp => (new CFClient::UI::ViewPort expand => 1),
939 slider => $slider, 978 slider => $slider,
940 @_, 979 %arg,
941 ); 980 );
942 981
943 $self->{vp}->add ($self->{scrolled});
944 $self->add ($self->{vp});
945 $self->add ($self->{slider}); 982 $self->SUPER::add ($self->{vp}, $self->{slider});
983 $self->add ($child) if $child;
946 984
947 $self 985 $self
986}
987
988sub add {
989 my ($self, $widget) = @_;
990
991 $self->{vp}->add ($self->{child} = $widget);
948} 992}
949 993
950sub update { 994sub update {
951 my ($self) = @_; 995 my ($self) = @_;
952 996
… …
955 # todo: overwrite size_allocate of child 999 # todo: overwrite size_allocate of child
956 my $child = $self->{vp}->child; 1000 my $child = $self->{vp}->child;
957 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); 1001 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
958} 1002}
959 1003
960sub size_allocate { 1004sub invoke_size_allocate {
961 my ($self, $w, $h, $changed) = @_; 1005 my ($self, $w, $h) = @_;
962
963 $self->SUPER::size_allocate ($w, $h, $changed);
964 1006
965 my $child = $self->{vp}->child; 1007 my $child = $self->{vp}->child;
966 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); 1008 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1009
1010 $self->SUPER::invoke_size_allocate ($w, $h)
967} 1011}
968 1012
969#TODO# update range on size_allocate depending on child 1013#TODO# update range on size_allocate depending on child
970# update viewport offset on scroll 1014# update viewport offset on scroll
971 1015
… …
991 1035
992 if ($self->{bg}) { 1036 if ($self->{bg}) {
993 my ($w, $h) = @$self{qw(w h)}; 1037 my ($w, $h) = @$self{qw(w h)};
994 1038
995 glEnable GL_BLEND; 1039 glEnable GL_BLEND;
996 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 1040 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
997 glColor @{ $self->{bg} }; 1041 glColor_premultiply @{ $self->{bg} };
998 1042
999 glBegin GL_QUADS; 1043 glBegin GL_QUADS;
1000 glVertex 0 , 0; 1044 glVertex 0 , 0;
1001 glVertex 0 , $h; 1045 glVertex 0 , $h;
1002 glVertex $w, $h; 1046 glVertex $w, $h;
… …
1024my @border = 1068my @border =
1025 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1069 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1026 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1070 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1027 1071
1028sub new { 1072sub new {
1029 my $class = shift; 1073 my ($class, %arg) = @_;
1030 1074
1031 my $self = $class->SUPER::new ( 1075 my $self = $class->SUPER::new (
1032 bg => [1, 1, 1, 1], 1076 bg => [1, 1, 1, 1],
1033 border_bg => [1, 1, 1, 1], 1077 border_bg => [1, 1, 1, 1],
1034 border => 0.6, 1078 border => 0.6,
1035 can_events => 1, 1079 can_events => 1,
1036 min_w => 16, 1080 min_w => 16,
1037 min_h => 16, 1081 min_h => 16,
1038 @_ 1082 %arg,
1039 ); 1083 );
1040 1084
1041 $self->{title} &&= new CFClient::UI::Label 1085 $self->{title_widget} = new CFClient::UI::Label
1042 align => 0, 1086 align => 0,
1043 valign => 1, 1087 valign => 1,
1044 text => $self->{title}, 1088 text => $self->{title},
1045 fontsize => $self->{border}; 1089 fontsize => $self->{border},
1090 if exists $self->{title};
1091
1092 if ($self->{has_close_button}) {
1093 $self->{close_button} =
1094 new CFClient::UI::ImageButton
1095 image => 'x1_close.png',
1096 on_activate => sub { $self->hide };
1097
1098 $self->CFClient::UI::Container::add ($self->{close_button});
1099 }
1046 1100
1047 $self 1101 $self
1102}
1103
1104sub add {
1105 my ($self, @widgets) = @_;
1106
1107 $self->SUPER::add (@widgets);
1108 $self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1109 $self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1048} 1110}
1049 1111
1050sub border { 1112sub border {
1051 int $_[0]{border} * $::FONTSIZE 1113 int $_[0]{border} * $::FONTSIZE
1052} 1114}
1053 1115
1054sub size_request { 1116sub size_request {
1055 my ($self) = @_; 1117 my ($self) = @_;
1118
1119 $self->{title_widget}->size_request
1120 if $self->{title_widget};
1121
1122 $self->{close_button}->size_request
1123 if $self->{close_button};
1056 1124
1057 my ($w, $h) = $self->SUPER::size_request; 1125 my ($w, $h) = $self->SUPER::size_request;
1058 1126
1059 ( 1127 (
1060 $w + $self->border * 2, 1128 $w + $self->border * 2,
1061 $h + $self->border * 2, 1129 $h + $self->border * 2,
1062 ) 1130 )
1063} 1131}
1064 1132
1065sub size_allocate { 1133sub invoke_size_allocate {
1066 my ($self, $w, $h, $changed) = @_; 1134 my ($self, $w, $h) = @_;
1067 1135
1068 return unless $changed; 1136 if ($self->{title_widget}) {
1137 $self->{title_widget}{w} = $w;
1138 $self->{title_widget}{h} = $h;
1139 $self->{title_widget}->invoke_size_allocate ($w, $h);
1140 }
1069 1141
1142 my $border = $self->border;
1143
1070 $h -= List::Util::max 0, $self->border * 2; 1144 $h -= List::Util::max 0, $border * 2;
1071 $w -= List::Util::max 0, $self->border * 2; 1145 $w -= List::Util::max 0, $border * 2;
1072 1146
1073 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1074 if $self->{title};
1075
1076 $self->child->configure ($self->border, $self->border, $w, $h); 1147 $self->child->configure ($border, $border, $w, $h);
1077}
1078 1148
1149 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1150 if $self->{close_button};
1151
1152 1
1153}
1154
1079sub button_down { 1155sub invoke_button_down {
1080 my ($self, $ev, $x, $y) = @_; 1156 my ($self, $ev, $x, $y) = @_;
1081 1157
1082 my ($w, $h) = @$self{qw(w h)}; 1158 my ($w, $h) = @$self{qw(w h)};
1083 my $border = $self->border; 1159 my $border = $self->border;
1084 1160
… …
1100 my $dy = $ev->{y} - $oy; 1176 my $dy = $ev->{y} - $oy;
1101 1177
1102 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1); 1178 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1103 $self->{force_h} = $bh + $dy * ($my ? -1 : 1); 1179 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1104 1180
1181 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1105 $self->realloc; 1182 $self->realloc;
1106 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1107 }; 1183 };
1108 1184
1109 } elsif ($lr ^ $td) { 1185 } elsif ($lr ^ $td) {
1110 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1186 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1111 my ($bx, $by) = ($self->{x}, $self->{y}); 1187 my ($bx, $by) = ($self->{x}, $self->{y});
… …
1114 my ($ev, $x, $y) = @_; 1190 my ($ev, $x, $y) = @_;
1115 1191
1116 ($x, $y) = ($ev->{x}, $ev->{y}); 1192 ($x, $y) = ($ev->{x}, $ev->{y});
1117 1193
1118 $self->move_abs ($bx + $x - $ox, $by + $y - $oy); 1194 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1195 # HACK: the next line is required to enforce placement
1196 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1119 }; 1197 };
1198 } else {
1199 return 0;
1200 }
1201
1120 } 1202 1
1121} 1203}
1122 1204
1123sub button_up { 1205sub invoke_button_up {
1124 my ($self, $ev, $x, $y) = @_; 1206 my ($self, $ev, $x, $y) = @_;
1125 1207
1126 delete $self->{motion}; 1208 ! ! delete $self->{motion}
1127} 1209}
1128 1210
1129sub mouse_motion { 1211sub invoke_mouse_motion {
1130 my ($self, $ev, $x, $y) = @_; 1212 my ($self, $ev, $x, $y) = @_;
1131 1213
1132 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1214 $self->{motion}->($ev, $x, $y) if $self->{motion};
1215
1216 ! ! $self->{motion}
1133} 1217}
1134 1218
1135sub _draw { 1219sub _draw {
1136 my ($self) = @_; 1220 my ($self) = @_;
1137 1221
1222 my $child = $self->{children}[0];
1223
1138 my ($w, $h ) = ($self->{w}, $self->{h}); 1224 my ($w, $h ) = ($self->{w}, $self->{h});
1139 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 1225 my ($cw, $ch) = ($child->{w}, $child->{h});
1140 1226
1141 glEnable GL_TEXTURE_2D; 1227 glEnable GL_TEXTURE_2D;
1142 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1228 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1143 1229
1144 my $border = $self->border; 1230 my $border = $self->border;
… …
1159 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1245 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1160 } 1246 }
1161 1247
1162 glDisable GL_TEXTURE_2D; 1248 glDisable GL_TEXTURE_2D;
1163 1249
1164 $self->{title}->draw if $self->{title};
1165
1166 $self->child->draw; 1250 $child->draw;
1251
1252 if ($self->{title_widget}) {
1253 glTranslate 0, $border - $self->{h};
1254 $self->{title_widget}->_draw;
1255
1256 glTranslate 0, - ($border - $self->{h});
1257 }
1258
1259 $self->{close_button}->draw
1260 if $self->{close_button};
1167} 1261}
1168 1262
1169############################################################################# 1263#############################################################################
1170 1264
1171package CFClient::UI::Table; 1265package CFClient::UI::Table;
… …
1194 1288
1195 $child->set_parent ($self); 1289 $child->set_parent ($self);
1196 $self->{children}[$y][$x] = $child; 1290 $self->{children}[$y][$x] = $child;
1197 1291
1198 $self->realloc; 1292 $self->realloc;
1293}
1294
1295sub remove {
1296 my ($self, $child) = @_;
1297
1298 # TODO: not yet implemented
1199} 1299}
1200 1300
1201# TODO: move to container class maybe? send children a signal on removal? 1301# TODO: move to container class maybe? send children a signal on removal?
1202sub clear { 1302sub clear {
1203 my ($self) = @_; 1303 my ($self) = @_;
… …
1244 (sum @$ws), 1344 (sum @$ws),
1245 (sum @$hs), 1345 (sum @$hs),
1246 ) 1346 )
1247} 1347}
1248 1348
1249sub size_allocate { 1349sub invoke_size_allocate {
1250 my ($self, $w, $h, $changed) = @_; 1350 my ($self, $w, $h) = @_;
1251 1351
1252 my ($ws, $hs) = $self->get_wh; 1352 my ($ws, $hs) = $self->get_wh;
1253 1353
1254 my $req_w = (sum @$ws) || 1; 1354 my $req_w = (sum @$ws) || 1;
1255 my $req_h = (sum @$hs) || 1; 1355 my $req_h = (sum @$hs) || 1;
… …
1286 } 1386 }
1287 1387
1288 $y += $row_h; 1388 $y += $row_h;
1289 } 1389 }
1290 1390
1391 1
1291} 1392}
1292 1393
1293sub find_widget { 1394sub find_widget {
1294 my ($self, $x, $y) = @_; 1395 my ($self, $x, $y) = @_;
1295 1396
… …
1332 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1433 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1333 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1434 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1334 ) 1435 )
1335} 1436}
1336 1437
1337sub size_allocate { 1438sub invoke_size_allocate {
1338 my ($self, $w, $h, $changed) = @_; 1439 my ($self, $w, $h) = @_;
1339 1440
1340 my $space = $self->{vertical} ? $h : $w; 1441 my $space = $self->{vertical} ? $h : $w;
1341 my $children = $self->{children}; 1442 my $children = $self->{children};
1342 1443
1343 my @req; 1444 my @req;
… …
1464 1565
1465 delete $self->{texture}; 1566 delete $self->{texture};
1466 $self->SUPER::update; 1567 $self->SUPER::update;
1467} 1568}
1468 1569
1570sub realloc {
1571 my ($self) = @_;
1572
1573 delete $self->{ox};
1574 $self->SUPER::realloc;
1575}
1576
1469sub set_text { 1577sub set_text {
1470 my ($self, $text) = @_; 1578 my ($self, $text) = @_;
1471 1579
1472 return if $self->{text} eq "T$text"; 1580 return if $self->{text} eq "T$text";
1473 $self->{text} = "T$text"; 1581 $self->{text} = "T$text";
1474 1582
1475 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1583 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1476 $self->{layout}->set_text ($text); 1584 $self->{layout}->set_text ($text);
1477 1585
1586 delete $self->{size_req};
1478 $self->realloc; 1587 $self->realloc;
1479 $self->update; 1588 $self->update;
1480} 1589}
1481 1590
1482sub set_markup { 1591sub set_markup {
… …
1488 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1597 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1489 1598
1490 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1599 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1491 $self->{layout}->set_markup ($markup); 1600 $self->{layout}->set_markup ($markup);
1492 1601
1602 delete $self->{size_req};
1493 $self->realloc; 1603 $self->realloc;
1494 $self->update; 1604 $self->update;
1495} 1605}
1496 1606
1497sub size_request { 1607sub size_request {
1498 my ($self) = @_; 1608 my ($self) = @_;
1499 1609
1610 $self->{size_req} ||= do {
1500 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1611 $self->{layout}->set_font ($self->{font}) if $self->{font};
1501 $self->{layout}->set_width ($self->{max_w} || -1); 1612 $self->{layout}->set_width ($self->{max_w} || -1);
1502 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1613 $self->{layout}->set_ellipsise ($self->{ellipsise});
1503 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1614 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1504 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1615 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1505 1616
1506 my ($w, $h) = $self->{layout}->size; 1617 my ($w, $h) = $self->{layout}->size;
1507 1618
1508 if (exists $self->{template}) { 1619 if (exists $self->{template}) {
1509 $self->{template}->set_font ($self->{font}) if $self->{font}; 1620 $self->{template}->set_font ($self->{font}) if $self->{font};
1510 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 1621 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1511 1622
1512 my ($w2, $h2) = $self->{template}->size; 1623 my ($w2, $h2) = $self->{template}->size;
1513 1624
1514 $w = List::Util::max $w, $w2; 1625 $w = List::Util::max $w, $w2;
1515 $h = List::Util::max $h, $h2; 1626 $h = List::Util::max $h, $h2;
1627 }
1628
1629 [$w, $h]
1516 } 1630 };
1517 1631
1518 ($w, $h) 1632 @{ $self->{size_req} }
1519} 1633}
1520 1634
1521sub size_allocate { 1635sub invoke_size_allocate {
1522 my ($self, $w, $h, $changed) = @_; 1636 my ($self, $w, $h) = @_;
1637
1638 delete $self->{ox};
1523 1639
1524 delete $self->{texture} 1640 delete $self->{texture}
1525 if $changed; 1641 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1642
1643 1
1526} 1644}
1527 1645
1528sub set_fontsize { 1646sub set_fontsize {
1529 my ($self, $fontsize) = @_; 1647 my ($self, $fontsize) = @_;
1530 1648
1531 $self->{fontsize} = $fontsize; 1649 $self->{fontsize} = $fontsize;
1532 delete $self->{texture}; 1650 delete $self->{texture};
1533 1651
1534 $self->realloc; 1652 $self->realloc;
1653}
1654
1655sub reconfigure {
1656 my ($self) = @_;
1657
1658 delete $self->{size_req};
1659
1660 $self->SUPER::reconfigure;
1535} 1661}
1536 1662
1537sub _draw { 1663sub _draw {
1538 my ($self) = @_; 1664 my ($self) = @_;
1539 1665
… …
1545 $self->{layout}->set_width ($self->{w}); 1671 $self->{layout}->set_width ($self->{w});
1546 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1672 $self->{layout}->set_ellipsise ($self->{ellipsise});
1547 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1673 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1548 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1674 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1549 1675
1550 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1676 new_from_layout CFClient::Texture $self->{layout}
1677 };
1551 1678
1679 unless (exists $self->{ox}) {
1552 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} 1680 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1553 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x} 1681 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1554 : ($self->{w} - $tex->{w}) * 0.5); 1682 : ($self->{w} - $tex->{w}) * 0.5);
1555 1683
1556 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 1684 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1557 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y} 1685 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1558 : ($self->{h} - $tex->{h}) * 0.5); 1686 : ($self->{h} - $tex->{h}) * 0.5);
1559
1560 $tex
1561 }; 1687 };
1562 1688
1563 glEnable GL_TEXTURE_2D; 1689 glEnable GL_TEXTURE_2D;
1564 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1690
1691 my $w = List::Util::min $self->{w} + 4, $tex->{w};
1692 my $h = List::Util::min $self->{h} + 2, $tex->{h};
1565 1693
1566 if ($tex->{format} == GL_ALPHA) { 1694 if ($tex->{format} == GL_ALPHA) {
1695 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1567 glColor @{$self->{fg}}; 1696 glColor @{$self->{fg}};
1568 $tex->draw_quad_alpha ($self->{ox}, $self->{oy}); 1697 $tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1569 } else { 1698 } else {
1699 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1570 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}); 1700 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1571 } 1701 }
1572 1702
1573 glDisable GL_TEXTURE_2D; 1703 glDisable GL_TEXTURE_2D;
1574} 1704}
1575 1705
… …
1592 can_hover => 1, 1722 can_hover => 1,
1593 can_focus => 1, 1723 can_focus => 1,
1594 valign => 0, 1724 valign => 0,
1595 can_events => 1, 1725 can_events => 1,
1596 #text => ... 1726 #text => ...
1727 #hidden => "*",
1597 @_ 1728 @_
1598 ) 1729 )
1599} 1730}
1600 1731
1601sub _set_text { 1732sub _set_text {
… …
1603 1734
1604 delete $self->{cur_h}; 1735 delete $self->{cur_h};
1605 1736
1606 return if $self->{text} eq $text; 1737 return if $self->{text} eq $text;
1607 1738
1608 delete $self->{texture};
1609
1610 $self->{last_activity} = $::NOW; 1739 $self->{last_activity} = $::NOW;
1611 $self->{text} = $text; 1740 $self->{text} = $text;
1612 1741
1613 $text =~ s/./*/g if $self->{hidden}; 1742 $text =~ s/./*/g if $self->{hidden};
1614 $self->{layout}->set_text ("$text "); 1743 $self->{layout}->set_text ("$text ");
1744 delete $self->{size_req};
1615 1745
1616 $self->_emit (changed => $self->{text}); 1746 $self->emit (changed => $self->{text});
1747
1748 $self->realloc;
1749 $self->update;
1617} 1750}
1618 1751
1619sub set_text { 1752sub set_text {
1620 my ($self, $text) = @_; 1753 my ($self, $text) = @_;
1621 1754
1622 $self->{cursor} = length $text; 1755 $self->{cursor} = length $text;
1623 $self->_set_text ($text); 1756 $self->_set_text ($text);
1624
1625 $self->realloc;
1626} 1757}
1627 1758
1628sub get_text { 1759sub get_text {
1629 $_[0]{text} 1760 $_[0]{text}
1630} 1761}
… …
1635 my ($w, $h) = $self->SUPER::size_request; 1766 my ($w, $h) = $self->SUPER::size_request;
1636 1767
1637 ($w + 1, $h) # add 1 for cursor 1768 ($w + 1, $h) # add 1 for cursor
1638} 1769}
1639 1770
1640sub key_down { 1771sub invoke_key_down {
1641 my ($self, $ev) = @_; 1772 my ($self, $ev) = @_;
1642 1773
1643 my $mod = $ev->{mod}; 1774 my $mod = $ev->{mod};
1644 my $sym = $ev->{sym}; 1775 my $sym = $ev->{sym};
1645 my $uni = $ev->{unicode}; 1776 my $uni = $ev->{unicode};
… …
1657 } elsif ($sym == CFClient::SDLK_HOME) { 1788 } elsif ($sym == CFClient::SDLK_HOME) {
1658 $self->{cursor} = 0; 1789 $self->{cursor} = 0;
1659 } elsif ($sym == CFClient::SDLK_END) { 1790 } elsif ($sym == CFClient::SDLK_END) {
1660 $self->{cursor} = length $text; 1791 $self->{cursor} = length $text;
1661 } elsif ($uni == 27) { 1792 } elsif ($uni == 27) {
1662 $self->_emit ('escape'); 1793 $self->emit ('escape');
1663 } elsif ($uni) { 1794 } elsif ($uni) {
1664 substr $text, $self->{cursor}++, 0, chr $uni; 1795 substr $text, $self->{cursor}++, 0, chr $uni;
1796 } else {
1797 return 0;
1665 } 1798 }
1666 1799
1667 $self->_set_text ($text); 1800 $self->_set_text ($text);
1668 1801
1669 $self->realloc; 1802 $self->realloc;
1670}
1671 1803
1804 1
1805}
1806
1672sub focus_in { 1807sub invoke_focus_in {
1673 my ($self) = @_; 1808 my ($self) = @_;
1674 1809
1675 $self->{last_activity} = $::NOW; 1810 $self->{last_activity} = $::NOW;
1676 1811
1677 $self->SUPER::focus_in; 1812 $self->SUPER::invoke_focus_in
1678} 1813}
1679 1814
1680sub button_down { 1815sub invoke_button_down {
1681 my ($self, $ev, $x, $y) = @_; 1816 my ($self, $ev, $x, $y) = @_;
1682 1817
1683 $self->SUPER::button_down ($ev, $x, $y); 1818 $self->SUPER::invoke_button_down ($ev, $x, $y);
1684 1819
1685 my $idx = $self->{layout}->xy_to_index ($x, $y); 1820 my $idx = $self->{layout}->xy_to_index ($x, $y);
1686 1821
1687 # byte-index to char-index 1822 # byte-index to char-index
1688 my $text = $self->{text}; 1823 my $text = $self->{text};
1689 utf8::encode $text; 1824 utf8::encode $text;
1690 $self->{cursor} = length substr $text, 0, $idx; 1825 $self->{cursor} = length substr $text, 0, $idx;
1691 1826
1692 $self->_set_text ($self->{text}); 1827 $self->_set_text ($self->{text});
1693 $self->update; 1828 $self->update;
1829
1830 1
1694} 1831}
1695 1832
1696sub mouse_motion { 1833sub invoke_mouse_motion {
1697 my ($self, $ev, $x, $y) = @_; 1834 my ($self, $ev, $x, $y) = @_;
1698# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1835# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1836
1837 1
1699} 1838}
1700 1839
1701sub _draw { 1840sub _draw {
1702 my ($self) = @_; 1841 my ($self) = @_;
1703 1842
1704 local $self->{fg} = $self->{fg}; 1843 local $self->{fg} = $self->{fg};
1705 1844
1706 if ($FOCUS == $self) { 1845 if ($FOCUS == $self) {
1707 glColor @{$self->{active_bg}}; 1846 glColor_premultiply @{$self->{active_bg}};
1708 $self->{fg} = $self->{active_fg}; 1847 $self->{fg} = $self->{active_fg};
1709 } else { 1848 } else {
1710 glColor @{$self->{bg}}; 1849 glColor_premultiply @{$self->{bg}};
1711 } 1850 }
1712 1851
1713 glEnable GL_BLEND; 1852 glEnable GL_BLEND;
1714 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 1853 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1715 glBegin GL_QUADS; 1854 glBegin GL_QUADS;
1716 glVertex 0 , 0; 1855 glVertex 0 , 0;
1717 glVertex 0 , $self->{h}; 1856 glVertex 0 , $self->{h};
1718 glVertex $self->{w}, $self->{h}; 1857 glVertex $self->{w}, $self->{h};
1719 glVertex $self->{w}, 0; 1858 glVertex $self->{w}, 0;
… …
1744 1883
1745our @ISA = CFClient::UI::EntryBase::; 1884our @ISA = CFClient::UI::EntryBase::;
1746 1885
1747use CFClient::OpenGL; 1886use CFClient::OpenGL;
1748 1887
1749sub key_down { 1888sub invoke_key_down {
1750 my ($self, $ev) = @_; 1889 my ($self, $ev) = @_;
1751 1890
1752 my $sym = $ev->{sym}; 1891 my $sym = $ev->{sym};
1753 1892
1754 if ($sym == 13) { 1893 if ($sym == 13) {
1755 unshift @{$self->{history}}, 1894 unshift @{$self->{history}},
1756 my $txt = $self->get_text; 1895 my $txt = $self->get_text;
1757 $self->{history_pointer} = -1; 1896 $self->{history_pointer} = -1;
1758 $self->{history_saveback} = ''; 1897 $self->{history_saveback} = '';
1759 $self->_emit (activate => $txt); 1898 $self->emit (activate => $txt);
1760 $self->update; 1899 $self->update;
1761 1900
1762 } elsif ($sym == CFClient::SDLK_UP) { 1901 } elsif ($sym == CFClient::SDLK_UP) {
1763 if ($self->{history_pointer} < 0) { 1902 if ($self->{history_pointer} < 0) {
1764 $self->{history_saveback} = $self->get_text; 1903 $self->{history_saveback} = $self->get_text;
… …
1780 } else { 1919 } else {
1781 $self->set_text ($self->{history_saveback}); 1920 $self->set_text ($self->{history_saveback});
1782 } 1921 }
1783 1922
1784 } else { 1923 } else {
1785 $self->SUPER::key_down ($ev); 1924 return $self->SUPER::invoke_key_down ($ev)
1925 }
1926
1786 } 1927 1
1787
1788} 1928}
1789 1929
1790############################################################################# 1930#############################################################################
1791 1931
1792package CFClient::UI::Button; 1932package CFClient::UI::Button;
… …
1813 can_events => 1, 1953 can_events => 1,
1814 @_ 1954 @_
1815 ) 1955 )
1816} 1956}
1817 1957
1818sub activate { }
1819
1820sub button_up { 1958sub invoke_button_up {
1821 my ($self, $ev, $x, $y) = @_; 1959 my ($self, $ev, $x, $y) = @_;
1822 1960
1823 $self->emit ("activate") 1961 $self->emit ("activate")
1824 if $x >= 0 && $x < $self->{w} 1962 if $x >= 0 && $x < $self->{w}
1825 && $y >= 0 && $y < $self->{h}; 1963 && $y >= 0 && $y < $self->{h};
1964
1965 1
1826} 1966}
1827 1967
1828sub _draw { 1968sub _draw {
1829 my ($self) = @_; 1969 my ($self) = @_;
1830 1970
1831 local $self->{fg} = $self->{fg}; 1971 local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1832
1833 if ($GRAB == $self) {
1834 $self->{fg} = $self->{active_fg};
1835 }
1836 1972
1837 glEnable GL_TEXTURE_2D; 1973 glEnable GL_TEXTURE_2D;
1838 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1974 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1839 glColor 0, 0, 0, 1; 1975 glColor 0, 0, 0, 1;
1840 1976
1841 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 1977 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1842 1978
1843 glDisable GL_TEXTURE_2D; 1979 glDisable GL_TEXTURE_2D;
1844 1980
1845 $self->SUPER::_draw; 1981 $self->SUPER::_draw;
1982}
1983
1984#############################################################################
1985
1986package CFClient::UI::ImageButton;
1987
1988our @ISA = CFClient::UI::Image::;
1989
1990use CFClient::OpenGL;
1991
1992my %textures;
1993
1994sub new {
1995 my $class = shift;
1996
1997 my $self = $class->SUPER::new (
1998 padding_x => 4,
1999 padding_y => 4,
2000 fg => [1, 1, 1],
2001 active_fg => [0, 0, 1],
2002 can_hover => 1,
2003 align => 0,
2004 valign => 0,
2005 can_events => 1,
2006 @_
2007 );
2008}
2009
2010sub invoke_button_up {
2011 my ($self, $ev, $x, $y) = @_;
2012
2013 $self->emit ("activate")
2014 if $x >= 0 && $x < $self->{w}
2015 && $y >= 0 && $y < $self->{h};
2016
2017 1
1846} 2018}
1847 2019
1848############################################################################# 2020#############################################################################
1849 2021
1850package CFClient::UI::CheckBox; 2022package CFClient::UI::CheckBox;
… …
1877 my ($self) = @_; 2049 my ($self) = @_;
1878 2050
1879 (6) x 2 2051 (6) x 2
1880} 2052}
1881 2053
1882sub button_down { 2054sub invoke_button_down {
1883 my ($self, $ev, $x, $y) = @_; 2055 my ($self, $ev, $x, $y) = @_;
1884 2056
1885 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2057 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1886 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2058 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1887 $self->{state} = !$self->{state}; 2059 $self->{state} = !$self->{state};
1888 $self->_emit (changed => $self->{state}); 2060 $self->emit (changed => $self->{state});
2061 } else {
2062 return 0
2063 }
2064
1889 } 2065 1
1890} 2066}
1891 2067
1892sub _draw { 2068sub _draw {
1893 my ($self) = @_; 2069 my ($self) = @_;
1894 2070
… …
2061 2237
2062 my $h1 = $self->{h} * (1 - $ycut1); 2238 my $h1 = $self->{h} * (1 - $ycut1);
2063 my $h2 = $self->{h} * (1 - $ycut2); 2239 my $h2 = $self->{h} * (1 - $ycut2);
2064 2240
2065 glEnable GL_BLEND; 2241 glEnable GL_BLEND;
2066 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 2242 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2243 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2067 glEnable GL_TEXTURE_2D; 2244 glEnable GL_TEXTURE_2D;
2068 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2245 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2069 2246
2070 glBindTexture GL_TEXTURE_2D, $t1->{name}; 2247 glBindTexture GL_TEXTURE_2D, $t1->{name};
2071 glBegin GL_QUADS; 2248 glBegin GL_QUADS;
… …
2185 $self->update; 2362 $self->update;
2186 2363
2187 $self 2364 $self
2188} 2365}
2189 2366
2190sub changed { }
2191
2192sub set_range { 2367sub set_range {
2193 my ($self, $range) = @_; 2368 my ($self, $range) = @_;
2194 2369
2195 ($range, $self->{range}) = ($self->{range}, $range); 2370 ($range, $self->{range}) = ($self->{range}, $range);
2196 2371
2197 $self->update
2198 if "@$range" ne "@{$self->{range}}"; 2372 if ("@$range" ne "@{$self->{range}}") {
2373 $self->update;
2374 $self->set_value ($self->{range}[0]);
2375 }
2199} 2376}
2200 2377
2201sub set_value { 2378sub set_value {
2202 my ($self, $value) = @_; 2379 my ($self, $value) = @_;
2203 2380
… …
2214 if $unit; 2391 if $unit;
2215 2392
2216 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2393 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2217 2394
2218 if ($value != $old_value) { 2395 if ($value != $old_value) {
2219 $self->_emit (changed => $value); 2396 $self->emit (changed => $value);
2220 $self->update; 2397 $self->update;
2221 } 2398 }
2222} 2399}
2223 2400
2224sub size_request { 2401sub size_request {
2225 my ($self) = @_; 2402 my ($self) = @_;
2226 2403
2227 ($self->{req_w}, $self->{req_h}) 2404 ($self->{req_w}, $self->{req_h})
2228} 2405}
2229 2406
2230sub button_down { 2407sub invoke_button_down {
2231 my ($self, $ev, $x, $y) = @_; 2408 my ($self, $ev, $x, $y) = @_;
2232 2409
2233 $self->SUPER::button_down ($ev, $x, $y); 2410 $self->SUPER::invoke_button_down ($ev, $x, $y);
2234 2411
2235 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2412 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2236 2413
2237 $self->mouse_motion ($ev, $x, $y); 2414 $self->mouse_motion ($ev, $x, $y)
2238} 2415}
2239 2416
2240sub mouse_motion { 2417sub invoke_mouse_motion {
2241 my ($self, $ev, $x, $y) = @_; 2418 my ($self, $ev, $x, $y) = @_;
2242 2419
2243 if ($GRAB == $self) { 2420 if ($GRAB == $self) {
2244 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2421 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2245 2422
2246 my (undef, $lo, $hi, $page) = @{$self->{range}}; 2423 my (undef, $lo, $hi, $page) = @{$self->{range}};
2247 2424
2248 $x = ($x - $self->{click}[1]) / ($w * $self->{scale}); 2425 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2249 2426
2250 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); 2427 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2428 } else {
2429 return 0;
2430 }
2431
2251 } 2432 1
2252} 2433}
2253 2434
2254sub update { 2435sub update {
2255 my ($self) = @_; 2436 my ($self) = @_;
2256 2437
2257 $CFClient::UI::ROOT->on_post_alloc ($self => sub { 2438 delete $self->{knob_w};
2439 $self->SUPER::update;
2440}
2441
2442sub _draw {
2443 my ($self) = @_;
2444
2445 unless ($self->{knob_w}) {
2258 $self->set_value ($self->{range}[0]); 2446 $self->set_value ($self->{range}[0]);
2259 2447
2260 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2448 my ($value, $lo, $hi, $page) = @{$self->{range}};
2261 my $range = ($hi - $page - $lo) || 1e-100; 2449 my $range = ($hi - $page - $lo) || 1e-100;
2262 2450
… …
2268 $value = ($value - $lo) / $range; 2456 $value = ($value - $lo) / $range;
2269 $value = $value * $self->{scale} + $self->{offset}; 2457 $value = $value * $self->{scale} + $self->{offset};
2270 2458
2271 $self->{knob_x} = $value - $knob_w * 0.5; 2459 $self->{knob_x} = $value - $knob_w * 0.5;
2272 $self->{knob_w} = $knob_w; 2460 $self->{knob_w} = $knob_w;
2273 }); 2461 }
2274
2275 $self->SUPER::update;
2276}
2277
2278sub _draw {
2279 my ($self) = @_;
2280 2462
2281 $self->SUPER::_draw (); 2463 $self->SUPER::_draw ();
2282 2464
2283 glScale $self->{w}, $self->{h}; 2465 glScale $self->{w}, $self->{h};
2284 2466
… …
2345sub set_range { shift->{slider}->set_range (@_) } 2527sub set_range { shift->{slider}->set_range (@_) }
2346sub set_value { shift->{slider}->set_value (@_) } 2528sub set_value { shift->{slider}->set_value (@_) }
2347 2529
2348############################################################################# 2530#############################################################################
2349 2531
2350package CFClient::UI::TextView; 2532package CFClient::UI::TextScroller;
2351 2533
2352our @ISA = CFClient::UI::HBox::; 2534our @ISA = CFClient::UI::HBox::;
2353 2535
2354use CFClient::OpenGL; 2536use CFClient::OpenGL;
2355 2537
… …
2357 my $class = shift; 2539 my $class = shift;
2358 2540
2359 my $self = $class->SUPER::new ( 2541 my $self = $class->SUPER::new (
2360 fontsize => 1, 2542 fontsize => 1,
2361 can_events => 0, 2543 can_events => 0,
2544 indent => 0,
2362 #font => default_font 2545 #font => default_font
2363 @_, 2546 @_,
2364 2547
2365 layout => (new CFClient::Layout 1), 2548 layout => (new CFClient::Layout 1),
2366 par => [], 2549 par => [],
… …
2381 2564
2382 $self->{fontsize} = $fontsize; 2565 $self->{fontsize} = $fontsize;
2383 $self->reflow; 2566 $self->reflow;
2384} 2567}
2385 2568
2386sub size_allocate { 2569sub invoke_size_allocate {
2387 my ($self, $w, $h, $changed) = @_; 2570 my ($self, $w, $h) = @_;
2388
2389 $self->SUPER::size_allocate ($w, $h, $changed);
2390
2391 return unless $changed;
2392 2571
2393 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2572 $self->{layout}->set_font ($self->{font}) if $self->{font};
2394 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2573 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2395 $self->{layout}->set_width ($self->{children}[0]{w}); 2574 $self->{layout}->set_width ($self->{children}[0]{w});
2575 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2396 2576
2397 $self->reflow; 2577 $self->reflow;
2578
2579 $self->SUPER::invoke_size_allocate ($w, $h)
2398} 2580}
2399 2581
2400sub text_size { 2582sub text_size {
2401 my ($self, $text, $indent) = @_; 2583 my ($self, $text, $indent) = @_;
2402 2584
2403 my $layout = $self->{layout}; 2585 my $layout = $self->{layout};
2404 2586
2405 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2587 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2406 $layout->set_width ($self->{children}[0]{w} - $indent); 2588 $layout->set_width ($self->{children}[0]{w} - $indent);
2589 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2407 $layout->set_markup ($text); 2590 $layout->set_markup ($text);
2408 2591
2409 $layout->size 2592 $layout->size
2410} 2593}
2411 2594
… …
2450 2633
2451 return unless $self->{h} > 0; 2634 return unless $self->{h} > 0;
2452 2635
2453 delete $self->{texture}; 2636 delete $self->{texture};
2454 2637
2455 $ROOT->on_post_alloc ($self, sub { 2638 $ROOT->on_post_alloc ($self => sub {
2456 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2639 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2457 2640
2458 if (delete $self->{need_reflow}) { 2641 if (delete $self->{need_reflow}) {
2459 my $height = 0; 2642 my $height = 0;
2460 2643
… …
2463 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2646 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2464 2647
2465 for (@{$self->{par}}) { 2648 for (@{$self->{par}}) {
2466 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2649 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2467 $layout->set_width ($W - $_->[3]); 2650 $layout->set_width ($W - $_->[3]);
2651 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2468 $layout->set_markup ($_->[4]); 2652 $layout->set_markup ($_->[4]);
2469 my ($w, $h) = $layout->size; 2653 my ($w, $h) = $layout->size;
2470 $_->[0] = $w + $_->[3]; 2654 $_->[0] = $w + $_->[3];
2471 $_->[1] = $h; 2655 $_->[1] = $h;
2472 } 2656 }
… …
2475 } 2659 }
2476 2660
2477 $self->{height} = $height; 2661 $self->{height} = $height;
2478 2662
2479 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]); 2663 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2480 2664
2481 delete $self->{texture}; 2665 delete $self->{texture};
2482 } 2666 }
2483 2667
2484 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2668 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2485 glClearColor 0.5, 0.5, 0.5, 0; 2669 glClearColor 0, 0, 0, 0;
2486 glClear GL_COLOR_BUFFER_BIT; 2670 glClear GL_COLOR_BUFFER_BIT;
2487 2671
2488 my $top = int $self->{children}[1]{range}[0]; 2672 my $top = int $self->{children}[1]{range}[0];
2489 2673
2490 my $y0 = $top; 2674 my $y0 = $top;
… …
2504 my $h = $par->[1]; 2688 my $h = $par->[1];
2505 2689
2506 if ($y0 < $y + $h && $y < $y1) { 2690 if ($y0 < $y + $h && $y < $y1) {
2507 $layout->set_foreground (@{ $par->[2] }); 2691 $layout->set_foreground (@{ $par->[2] });
2508 $layout->set_width ($W - $par->[3]); 2692 $layout->set_width ($W - $par->[3]);
2693 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2509 $layout->set_markup ($par->[4]); 2694 $layout->set_markup ($par->[4]);
2510 2695
2511 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2696 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2512 2697
2513 glRasterPos $par->[3], $y - $y0; 2698 glRasterPos $par->[3], $y - $y0;
… …
2525sub _draw { 2710sub _draw {
2526 my ($self) = @_; 2711 my ($self) = @_;
2527 2712
2528 glEnable GL_TEXTURE_2D; 2713 glEnable GL_TEXTURE_2D;
2529 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2714 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2530 glColor 1, 1, 1, 1; 2715 glColor 0, 0, 0, 1;
2531 $self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2716 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2532 glDisable GL_TEXTURE_2D; 2717 glDisable GL_TEXTURE_2D;
2533 2718
2534 $self->{children}[1]->draw; 2719 $self->{children}[1]->draw;
2535 2720
2536} 2721}
… …
2619} 2804}
2620 2805
2621sub set_tooltip_from { 2806sub set_tooltip_from {
2622 my ($self, $widget) = @_; 2807 my ($self, $widget) = @_;
2623 2808
2809 my $tooltip = $widget->{tooltip};
2810
2811 if ($ENV{CFPLUS_DEBUG} & 2) {
2812 $tooltip .= "\n\n" . (ref $widget) . "\n"
2813 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2814 . "req $widget->{req_w} $widget->{req_h}\n"
2815 . "visible $widget->{visible}";
2816 }
2817
2818 $tooltip =~ s/^\n+//;
2819 $tooltip =~ s/\n+$//;
2820
2624 $self->add (new CFClient::UI::Label 2821 $self->add (new CFClient::UI::Label
2625 markup => $widget->{tooltip}, 2822 markup => $tooltip,
2626 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2823 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2627 fontsize => 0.8, 2824 fontsize => 0.8,
2628 fg => [0, 0, 0, 1], 2825 fg => [0, 0, 0, 1],
2629 ellipsise => 0, 2826 ellipsise => 0,
2630 font => ($widget->{tooltip_font} || $::FONT_PROP), 2827 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2637 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 2834 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2638 2835
2639 ($w + 4, $h + 4) 2836 ($w + 4, $h + 4)
2640} 2837}
2641 2838
2642sub size_allocate { 2839sub invoke_size_allocate {
2643 my ($self, $w, $h, $changed) = @_; 2840 my ($self, $w, $h) = @_;
2644 2841
2645 return unless $changed;
2646
2647 $self->SUPER::size_allocate ($w - 4, $h - 4, $changed); 2842 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2648} 2843}
2649 2844
2650sub visibility_change { 2845sub invoke_visibility_change {
2651 my ($self, $visible) = @_; 2846 my ($self, $visible) = @_;
2652 2847
2653 return unless $visible; 2848 return unless $visible;
2654 2849
2655 $self->{root}->on_post_alloc ("move_$self" => sub { 2850 $self->{root}->on_post_alloc ("move_$self" => sub {
… …
2657 or return; 2852 or return;
2658 2853
2659 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 2854 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2660 2855
2661 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 2856 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2662 if $x + $self->{w} > $::WIDTH; 2857 if $x + $self->{w} > $self->{root}{w};
2663 2858
2664 $self->move_abs ($x, $y); 2859 $self->move_abs ($x, $y);
2665 }); 2860 });
2666} 2861}
2667 2862
… …
2756 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]]; 2951 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2757 2952
2758 if ($tex) { 2953 if ($tex) {
2759 glEnable GL_TEXTURE_2D; 2954 glEnable GL_TEXTURE_2D;
2760 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2955 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2761 glColor 1, 1, 1, 1; 2956 glColor 0, 0, 0, 1;
2762 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 2957 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2763 glDisable GL_TEXTURE_2D; 2958 glDisable GL_TEXTURE_2D;
2764 } 2959 }
2765} 2960}
2766 2961
2767sub DESTROY { 2962sub destroy {
2768 my ($self) = @_; 2963 my ($self) = @_;
2769 2964
2770 $self->{timer}->cancel 2965 $self->{timer}->cancel
2771 if $self->{timer}; 2966 if $self->{timer};
2772 2967
2773 $self->SUPER::DESTROY; 2968 $self->SUPER::destroy;
2774} 2969}
2775 2970
2776############################################################################# 2971#############################################################################
2777 2972
2778package CFClient::UI::Inventory; 2973package CFClient::UI::Buttonbar;
2779 2974
2780our @ISA = CFClient::UI::ScrolledWindow::; 2975our @ISA = CFClient::UI::HBox::;
2781 2976
2782sub new { 2977# TODO: should actualyl wrap buttons and other goodies.
2783 my $class = shift;
2784
2785 my $self = $class->SUPER::new (
2786 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2787 @_,
2788 );
2789
2790 $self
2791}
2792
2793sub set_items {
2794 my ($self, $items) = @_;
2795
2796 $self->{scrolled}->clear;
2797 return unless $items;
2798
2799 my @items = sort {
2800 ($a->{type} <=> $b->{type})
2801 or ($a->{name} cmp $b->{name})
2802 } @$items;
2803
2804 $self->{real_items} = \@items;
2805
2806 my $row = 0;
2807 for my $item (@items) {
2808 CFClient::Item::update_widgets $item;
2809
2810 $self->{scrolled}->add (0, $row, $item->{face_widget});
2811 $self->{scrolled}->add (1, $row, $item->{desc_widget});
2812 $self->{scrolled}->add (2, $row, $item->{weight_widget});
2813
2814 $row++;
2815 }
2816}
2817 2978
2818############################################################################# 2979#############################################################################
2819 2980
2820package CFClient::UI::Menu; 2981package CFClient::UI::Menu;
2821 2982
… …
2833 ); 2994 );
2834 2995
2835 $self->add ($self->{vbox} = new CFClient::UI::VBox); 2996 $self->add ($self->{vbox} = new CFClient::UI::VBox);
2836 2997
2837 for my $item (@{ $self->{items} }) { 2998 for my $item (@{ $self->{items} }) {
2838 my ($widget, $cb) = @$item; 2999 my ($widget, $cb, $tooltip) = @$item;
2839 3000
2840 # handle various types of items, only text for now 3001 # handle various types of items, only text for now
2841 if (!ref $widget) { 3002 if (!ref $widget) {
2842 $widget = new CFClient::UI::Label 3003 $widget = new CFClient::UI::Label
2843 can_hover => 1, 3004 can_hover => 1,
2844 can_events => 1, 3005 can_events => 1,
2845 text => $widget; 3006 markup => $widget,
3007 tooltip => $tooltip
2846 } 3008 }
2847 3009
2848 $self->{item}{$widget} = $item; 3010 $self->{item}{$widget} = $item;
2849 3011
2850 $self->{vbox}->add ($widget); 3012 $self->{vbox}->add ($widget);
… …
2855 3017
2856# popup given the event (must be a mouse button down event currently) 3018# popup given the event (must be a mouse button down event currently)
2857sub popup { 3019sub popup {
2858 my ($self, $ev) = @_; 3020 my ($self, $ev) = @_;
2859 3021
2860 $self->_emit ("popdown"); 3022 $self->emit ("popdown");
2861 3023
2862 # maybe save $GRAB? must be careful about events... 3024 # maybe save $GRAB? must be careful about events...
2863 $GRAB = $self; 3025 $GRAB = $self;
2864 $self->{button} = $ev->{button}; 3026 $self->{button} = $ev->{button};
2865 3027
2866 $self->show; 3028 $self->show;
2867 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 3029 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2868} 3030}
2869 3031
2870sub mouse_motion { 3032sub invoke_mouse_motion {
2871 my ($self, $ev, $x, $y) = @_; 3033 my ($self, $ev, $x, $y) = @_;
2872 3034
2873 # TODO: should use vbox->find_widget or so 3035 # TODO: should use vbox->find_widget or so
2874 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3036 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2875 $self->{hover} = $self->{item}{$HOVER}; 3037 $self->{hover} = $self->{item}{$HOVER};
2876}
2877 3038
3039 0
3040}
3041
2878sub button_up { 3042sub invoke_button_up {
2879 my ($self, $ev, $x, $y) = @_; 3043 my ($self, $ev, $x, $y) = @_;
2880 3044
2881 if ($ev->{button} == $self->{button}) { 3045 if ($ev->{button} == $self->{button}) {
2882 undef $GRAB; 3046 undef $GRAB;
2883 $self->hide; 3047 $self->hide;
2884 3048
2885 $self->_emit ("popdown"); 3049 $self->emit ("popdown");
2886 $self->{hover}[1]->() if $self->{hover}; 3050 $self->{hover}[1]->() if $self->{hover};
3051 } else {
3052 return 0
3053 }
3054
2887 } 3055 1
2888} 3056}
2889 3057
2890############################################################################# 3058#############################################################################
2891 3059
2892package CFClient::UI::Statusbox; 3060package CFClient::UI::Multiplexer;
2893 3061
2894our @ISA = CFClient::UI::VBox::; 3062our @ISA = CFClient::UI::Container::;
2895 3063
2896sub new { 3064sub new {
2897 my $class = shift; 3065 my $class = shift;
2898 3066
2899 $class->SUPER::new ( 3067 my $self = $class->SUPER::new (
3068 @_,
3069 );
3070
3071 $self->{current} = $self->{children}[0]
3072 if @{ $self->{children} };
3073
3074 $self
3075}
3076
3077sub add {
3078 my ($self, @widgets) = @_;
3079
3080 $self->SUPER::add (@widgets);
3081
3082 $self->{current} = $self->{children}[0]
3083 if @{ $self->{children} };
3084}
3085
3086sub set_current_page {
3087 my ($self, $page_or_widget) = @_;
3088
3089 my $widget = ref $page_or_widget
3090 ? $page_or_widget
3091 : $self->{children}[$page_or_widget];
3092
3093 $self->{current} = $widget;
3094 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3095
3096 $self->emit (page_changed => $self->{current});
3097
3098 $self->realloc;
3099}
3100
3101sub visible_children {
3102 $_[0]{current}
3103}
3104
3105sub size_request {
3106 my ($self) = @_;
3107
3108 $self->{current}->size_request
3109}
3110
3111sub invoke_size_allocate {
3112 my ($self, $w, $h) = @_;
3113
3114 $self->{current}->configure (0, 0, $w, $h);
3115
3116 1
3117}
3118
3119sub _draw {
3120 my ($self) = @_;
3121
3122 $self->{current}->draw;
3123}
3124
3125#############################################################################
3126
3127package CFClient::UI::Notebook;
3128
3129our @ISA = CFClient::UI::VBox::;
3130
3131sub new {
3132 my $class = shift;
3133
3134 my $self = $class->SUPER::new (
3135 buttonbar => (new CFClient::UI::Buttonbar),
3136 multiplexer => (new CFClient::UI::Multiplexer expand => 1),
3137 # filter => # will be put between multiplexer and $self
3138 @_,
3139 );
3140
3141 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3142 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
3143
3144 $self
3145}
3146
3147sub add {
3148 my ($self, $title, $widget, $tooltip) = @_;
3149
3150 Scalar::Util::weaken $self;
3151
3152 $self->{buttonbar}->add (new CFClient::UI::Button
3153 markup => $title,
3154 tooltip => $tooltip,
3155 on_activate => sub { $self->set_current_page ($widget) },
3156 );
3157
3158 $self->{multiplexer}->add ($widget);
3159}
3160
3161sub set_current_page {
3162 my ($self, $page) = @_;
3163
3164 $self->{multiplexer}->set_current_page ($page);
3165 $self->emit (page_changed => $self->{multiplexer}{current});
3166}
3167
3168#############################################################################
3169
3170package CFClient::UI::Combobox;
3171
3172use utf8;
3173
3174our @ISA = CFClient::UI::Button::;
3175
3176sub new {
3177 my $class = shift;
3178
3179 my $self = $class->SUPER::new (
3180 options => [], # [value, title, longdesc], ...
3181 value => undef,
3182 @_,
3183 );
3184
3185 $self->_set_value ($self->{value});
3186
3187 $self
3188}
3189
3190sub invoke_button_down {
3191 my ($self, $ev) = @_;
3192
3193 my @menu_items;
3194
3195 for (@{ $self->{options} }) {
3196 my ($value, $title, $tooltip) = @$_;
3197
3198 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3199 }
3200
3201 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
3202}
3203
3204sub _set_value {
3205 my ($self, $value) = @_;
3206
3207 my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
3208 or return;
3209
3210 $self->{value} = $item->[0];
3211 $self->set_markup ("$item->[1] ⇓");
3212 $self->set_tooltip ($item->[2]);
3213}
3214
3215sub set_value {
3216 my ($self, $value) = @_;
3217
3218 return unless $self->{value} ne $value;
3219
3220 $self->_set_value ($value);
3221 $self->emit (changed => $value);
3222}
3223
3224#############################################################################
3225
3226package CFClient::UI::Statusbox;
3227
3228our @ISA = CFClient::UI::VBox::;
3229
3230sub new {
3231 my $class = shift;
3232
3233 my $self = $class->SUPER::new (
2900 fontsize => 0.8, 3234 fontsize => 0.8,
2901 @_, 3235 @_,
2902 ) 3236 );
3237
3238 Scalar::Util::weaken (my $this = $self);
3239
3240 $self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
3241
3242 $self
2903} 3243}
2904 3244
2905sub reorder { 3245sub reorder {
2906 my ($self) = @_; 3246 my ($self) = @_;
2907 my $NOW = time; 3247 my $NOW = Time::HiRes::time;
3248
3249 # freeze display when hovering over any label
3250 return if $CFClient::UI::TOOLTIP->{owner}
3251 && grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
3252 values %{ $self->{item} };
2908 3253
2909 while (my ($k, $v) = each %{ $self->{item} }) { 3254 while (my ($k, $v) = each %{ $self->{item} }) {
2910 delete $self->{item}{$k} if $v->{timeout} < $NOW; 3255 delete $self->{item}{$k} if $v->{timeout} < $NOW;
2911 } 3256 }
2912 3257
… …
2915 my @items = sort { 3260 my @items = sort {
2916 $a->{pri} <=> $b->{pri} 3261 $a->{pri} <=> $b->{pri}
2917 or $b->{id} <=> $a->{id} 3262 or $b->{id} <=> $a->{id}
2918 } values %{ $self->{item} }; 3263 } values %{ $self->{item} };
2919 3264
3265 $self->{timer}->interval (1);
3266
2920 my $count = 10 + 1; 3267 my $count = 10 + 1;
2921 for my $item (@items) { 3268 for my $item (@items) {
2922 last unless --$count; 3269 last unless --$count;
2923 3270
2924 push @widgets, $item->{label} ||= do { 3271 my $label = $item->{label} ||= do {
2925 # TODO: doesn't handle markup well (read as: at all) 3272 # TODO: doesn't handle markup well (read as: at all)
2926 my $short = $item->{count} > 1 3273 my $short = $item->{count} > 1
2927 ? "<b>$item->{count} ×</b> $item->{text}" 3274 ? "<b>$item->{count} ×</b> $item->{text}"
2928 : $item->{text}; 3275 : $item->{text};
2929 3276
… …
2937 tooltip => $item->{tooltip}, 3284 tooltip => $item->{tooltip},
2938 tooltip_font => $::FONT_PROP, 3285 tooltip_font => $::FONT_PROP,
2939 tooltip_width => 0.67, 3286 tooltip_width => 0.67,
2940 fontsize => $item->{fontsize} || $self->{fontsize}, 3287 fontsize => $item->{fontsize} || $self->{fontsize},
2941 max_w => $::WIDTH * 0.44, 3288 max_w => $::WIDTH * 0.44,
2942 fg => $item->{fg}, 3289 fg => [@{ $item->{fg} }],
2943 can_events => 1, 3290 can_events => 1,
2944 can_hover => 1 3291 can_hover => 1
2945 }; 3292 };
3293
3294 if ((my $diff = $item->{timeout} - $NOW) < 2) {
3295 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
3296 $label->update;
3297 $label->set_max_size (undef, $label->{req_h} * $diff)
3298 if $diff < 1;
3299 $self->{timer}->interval (1/30);
3300 } else {
3301 $label->{fg}[3] = $item->{fg}[3] || 1;
3302 }
3303
3304 push @widgets, $label;
2946 } 3305 }
2947 3306
2948 $self->clear; 3307 $self->clear;
2949 $self->SUPER::add (reverse @widgets); 3308 $self->SUPER::add (reverse @widgets);
2950} 3309}
… …
2955 $text =~ s/^\s+//; 3314 $text =~ s/^\s+//;
2956 $text =~ s/\s+$//; 3315 $text =~ s/\s+$//;
2957 3316
2958 return unless $text; 3317 return unless $text;
2959 3318
2960 my $timeout = time + ((delete $arg{timeout}) || 60); 3319 my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2961 3320
2962 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 3321 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2963 3322
2964 if (my $item = $self->{item}{$group}) { 3323 if (my $item = $self->{item}{$group}) {
2965 if ($item->{text} eq $text) { 3324 if ($item->{text} eq $text) {
2966 $item->{count}++; 3325 $item->{count}++;
2967 } else { 3326 } else {
2968 $item->{count} = 1; 3327 $item->{count} = 1;
2969 $item->{text} = $item->{tooltip} = $text; 3328 $item->{text} = $item->{tooltip} = $text;
2970 } 3329 }
2971 $item->{id} = ++$self->{id}; 3330 $item->{id} += 0.2;#d#
2972 $item->{timeout} = $timeout; 3331 $item->{timeout} = $timeout;
2973 delete $item->{label}; 3332 delete $item->{label};
2974 } else { 3333 } else {
2975 $self->{item}{$group} = { 3334 $self->{item}{$group} = {
2976 id => ++$self->{id}, 3335 id => ++$self->{id},
… …
2995 3354
2996 $self->reorder; 3355 $self->reorder;
2997 $self->SUPER::reconfigure; 3356 $self->SUPER::reconfigure;
2998} 3357}
2999 3358
3359sub destroy {
3360 my ($self) = @_;
3361
3362 $self->{timer}->cancel;
3363
3364 $self->SUPER::destroy;
3365}
3366
3000############################################################################# 3367#############################################################################
3001 3368
3369package CFClient::UI::Inventory;
3370
3371our @ISA = CFClient::UI::ScrolledWindow::;
3372
3373sub new {
3374 my $class = shift;
3375
3376 my $self = $class->SUPER::new (
3377 child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3378 @_,
3379 );
3380
3381 $self
3382}
3383
3384sub set_items {
3385 my ($self, $items) = @_;
3386
3387 $self->{child}->clear;
3388 return unless $items;
3389
3390 my @items = sort {
3391 ($a->{type} <=> $b->{type})
3392 or ($a->{name} cmp $b->{name})
3393 } @$items;
3394
3395 $self->{real_items} = \@items;
3396
3397 my $row = 0;
3398 for my $item (@items) {
3399 CFClient::Item::update_widgets $item;
3400
3401 $self->{child}->add (0, $row, $item->{face_widget});
3402 $self->{child}->add (1, $row, $item->{desc_widget});
3403 $self->{child}->add (2, $row, $item->{weight_widget});
3404
3405 $row++;
3406 }
3407}
3408
3409#############################################################################
3410
3411package CFClient::UI::BindEditor;
3412
3413our @ISA = CFClient::UI::FancyFrame::;
3414
3415sub new {
3416 my $class = shift;
3417
3418 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3419
3420 $self->add (my $vb = new CFClient::UI::VBox);
3421
3422
3423 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3424 text => "start recording",
3425 tooltip => "Start/Stops recording of actions."
3426 ."All subsequent actions after the recording started will be captured."
3427 ."The actions are displayed after the record was stopped."
3428 ."To bind the action you have to click on the 'Bind' button",
3429 on_activate => sub {
3430 unless ($self->{recording}) {
3431 $self->start;
3432 } else {
3433 $self->stop;
3434 }
3435 });
3436
3437 $vb->add (new CFClient::UI::Label text => "Actions:");
3438 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3439
3440 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3441 $vb->add (my $hb = new CFClient::UI::HBox);
3442 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3443 $hb->add (new CFClient::UI::Button
3444 text => "bind",
3445 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3446 on_activate => sub {
3447 $self->ask_for_bind;
3448 });
3449
3450 $vb->add (my $hb = new CFClient::UI::HBox);
3451 $hb->add (new CFClient::UI::Button
3452 text => "ok",
3453 expand => 1,
3454 tooltip => "This closes the binding editor and saves the binding",
3455 on_activate => sub {
3456 $self->hide;
3457 $self->commit;
3458 });
3459
3460 $hb->add (new CFClient::UI::Button
3461 text => "cancel",
3462 expand => 1,
3463 tooltip => "This closes the binding editor without saving",
3464 on_activate => sub {
3465 $self->hide;
3466 $self->{binding_cancel}->()
3467 if $self->{binding_cancel};
3468 });
3469
3470 $self->update_binding_widgets;
3471
3472 $self
3473}
3474
3475sub commit {
3476 my ($self) = @_;
3477 my ($mod, $sym, $cmds) = $self->get_binding;
3478 if ($sym != 0 && @$cmds > 0) {
3479 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3480 ."'. Don't forget 'Save Config'!");
3481 $self->{binding_change}->($mod, $sym, $cmds)
3482 if $self->{binding_change};
3483 } else {
3484 $::STATUSBOX->add ("No action bound, no key or action specified!");
3485 $self->{binding_cancel}->()
3486 if $self->{binding_cancel};
3487 }
3488}
3489
3490sub start {
3491 my ($self) = @_;
3492
3493 $self->{rec_btn}->set_text ("stop recording");
3494 $self->{recording} = 1;
3495 $self->clear_command_list;
3496 $::CONN->start_record if $::CONN;
3497}
3498
3499sub stop {
3500 my ($self) = @_;
3501
3502 $self->{rec_btn}->set_text ("start recording");
3503 $self->{recording} = 0;
3504
3505 my $rec;
3506 $rec = $::CONN->stop_record if $::CONN;
3507 return unless ref $rec eq 'ARRAY';
3508 $self->set_command_list ($rec);
3509}
3510
3511
3512sub ask_for_bind_and_commit {
3513 my ($self) = @_;
3514 $self->ask_for_bind (1);
3515}
3516
3517sub ask_for_bind {
3518 my ($self, $commit, $end_cb) = @_;
3519
3520 CFClient::Binder::open_binding_dialog (sub {
3521 my ($mod, $sym) = @_;
3522 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3523 $self->update_binding_widgets;
3524 $self->commit if $commit;
3525 $end_cb->() if $end_cb;
3526 });
3527}
3528
3529# $mod and $sym are the modifiers and key symbol
3530# $cmds is a array ref of strings (the commands)
3531# $cb is the callback that is executed on OK
3532# $ccb is the callback that is executed on CANCEL and
3533# when the binding was unsuccessful on OK
3534sub set_binding {
3535 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3536
3537 $self->clear_command_list;
3538 $self->{recording} = 0;
3539 $self->{rec_btn}->set_text ("start recording");
3540
3541 $self->{binding} = [$mod, $sym];
3542 $self->{commands} = $cmds;
3543
3544 $self->{binding_change} = $cb;
3545 $self->{binding_cancel} = $ccb;
3546
3547 $self->update_binding_widgets;
3548}
3549
3550# this is a shortcut method that asks for a binding
3551# and then just binds it.
3552sub do_quick_binding {
3553 my ($self, $cmds, $end_cb) = @_;
3554 $self->set_binding (undef, undef, $cmds, sub {
3555 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3556 });
3557 $self->ask_for_bind (1, $end_cb);
3558}
3559
3560sub update_binding_widgets {
3561 my ($self) = @_;
3562 my ($mod, $sym, $cmds) = $self->get_binding;
3563 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3564 $self->set_command_list ($cmds);
3565}
3566
3567sub get_binding {
3568 my ($self) = @_;
3569 return (
3570 $self->{binding}->[0],
3571 $self->{binding}->[1],
3572 [ grep { defined $_ } @{$self->{commands}} ]
3573 );
3574}
3575
3576sub clear_command_list {
3577 my ($self) = @_;
3578 $self->{cmdbox}->clear ();
3579}
3580
3581sub set_command_list {
3582 my ($self, $cmds) = @_;
3583
3584 $self->{cmdbox}->clear ();
3585 $self->{commands} = $cmds;
3586
3587 my $idx = 0;
3588
3589 for (@$cmds) {
3590 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3591
3592 my $i = $idx;
3593 $hb->add (new CFClient::UI::Label text => $_);
3594 $hb->add (new CFClient::UI::Button
3595 text => "delete",
3596 tooltip => "Deletes the action from the record",
3597 on_activate => sub {
3598 $self->{cmdbox}->remove ($hb);
3599 $cmds->[$i] = undef;
3600 });
3601
3602
3603 $idx++
3604 }
3605}
3606
3607#############################################################################
3608
3609package CFClient::UI::SpellList;
3610
3611our @ISA = CFClient::UI::Table::;
3612
3613sub new {
3614 my $class = shift;
3615
3616 my $self = $class->SUPER::new (
3617 binding => [],
3618 commands => [],
3619 @_,
3620 )
3621}
3622
3623my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
3624
3625my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3626 "<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
3627my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3628 "<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
3629my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3630 "<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
3631my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3632 "<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
3633my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3634 "<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
3635
3636sub rebuild_spell_list {
3637 my ($self) = @_;
3638
3639 $CFClient::UI::ROOT->on_refresh ($self => sub {
3640 $self->clear;
3641
3642 return unless $::CONN;
3643
3644 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3645 $self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3646 $self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3647 $self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3648 $self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3649
3650 my $row = 0;
3651
3652 for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3653 my $spell = $self->{spell}{$_};
3654
3655 $row++;
3656
3657 my $spell_cb = sub {
3658 my ($widget, $ev) = @_;
3659
3660 if ($ev->{button} == 1) {
3661 $::CONN->user_send ("cast $spell->{name}");
3662 } elsif ($ev->{button} == 2) {
3663 $::CONN->user_send ("invoke $spell->{name}");
3664 } elsif ($ev->{button} == 3) {
3665 (new CFClient::UI::Menu
3666 items => [
3667 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3668 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3669 ],
3670 )->popup ($ev);
3671 } else {
3672 return 0;
3673 }
3674
3675 1
3676 };
3677
3678 my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3679
3680 #TODO: add path info to tooltip
3681 #$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
3682
3683 $self->add (0, $row, new CFClient::UI::Face
3684 face => $spell->{face},
3685 can_hover => 1,
3686 can_events => 1,
3687 tooltip => $tooltip,
3688 on_button_down => $spell_cb,
3689 );
3690
3691 $self->add (1, $row, new CFClient::UI::Label
3692 expand => 1,
3693 text => $spell->{name},
3694 can_hover => 1,
3695 can_events => 1,
3696 tooltip => $tooltip,
3697 on_button_down => $spell_cb,
3698 );
3699
3700 $self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3701 $self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3702 $self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3703 $self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3704 }
3705 });
3706}
3707
3708sub add_spell {
3709 my ($self, $spell) = @_;
3710
3711 $self->{spell}->{$spell->{name}} = $spell;
3712 $self->rebuild_spell_list;
3713}
3714
3715sub remove_spell {
3716 my ($self, $spell) = @_;
3717
3718 delete $self->{spell}->{$spell->{name}};
3719 $self->rebuild_spell_list;
3720}
3721
3722sub clear_spells {
3723 my ($self) = @_;
3724
3725 $self->{spell} = {};
3726 $self->rebuild_spell_list;
3727}
3728
3729#############################################################################
3730
3002package CFClient::UI::Root; 3731package CFClient::UI::Root;
3003 3732
3004our @ISA = CFClient::UI::Container::; 3733our @ISA = CFClient::UI::Container::;
3734
3735use List::Util qw(min max);
3005 3736
3006use CFClient::OpenGL; 3737use CFClient::OpenGL;
3007 3738
3008sub new { 3739sub new {
3009 my $class = shift; 3740 my $class = shift;
… …
3016 Scalar::Util::weaken ($self->{root} = $self); 3747 Scalar::Util::weaken ($self->{root} = $self);
3017 3748
3018 $self 3749 $self
3019} 3750}
3020 3751
3021sub configure {
3022 my ($self, $x, $y, $w, $h) = @_;
3023
3024 $self->{w} = $w;
3025 $self->{h} = $h;
3026}
3027
3028sub reconfigure {
3029 my ($self) = @_;
3030
3031 $self->SUPER::reconfigure;
3032
3033 $self->size_allocate ($self->{w}, $self->{h}, 1)
3034 if $self->{w};
3035}
3036
3037sub size_request { 3752sub size_request {
3038 my ($self) = @_; 3753 my ($self) = @_;
3039 3754
3040 ($self->{w}, $self->{h}) 3755 ($self->{w}, $self->{h})
3041} 3756}
… …
3052 $coord = $max - $size if $coord > $max - $size; 3767 $coord = $max - $size if $coord > $max - $size;
3053 3768
3054 int $coord + 0.5 3769 int $coord + 0.5
3055} 3770}
3056 3771
3057sub size_allocate { 3772sub invoke_size_allocate {
3058 my ($self, $w, $h, $changed) = @_; 3773 my ($self, $w, $h) = @_;
3059 3774
3060 for my $child ($self->children) { 3775 for my $child ($self->children) {
3061 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3776 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3062 3777
3063 $X = $child->{force_x} if exists $child->{force_x}; 3778 $X = $child->{force_x} if exists $child->{force_x};
… …
3066 $X = _to_pixel $X, $W, $self->{w}; 3781 $X = _to_pixel $X, $W, $self->{w};
3067 $Y = _to_pixel $Y, $H, $self->{h}; 3782 $Y = _to_pixel $Y, $H, $self->{h};
3068 3783
3069 $child->configure ($X, $Y, $W, $H); 3784 $child->configure ($X, $Y, $W, $H);
3070 } 3785 }
3786
3787 1
3071} 3788}
3072 3789
3073sub coord2local { 3790sub coord2local {
3074 my ($self, $x, $y) = @_; 3791 my ($self, $x, $y) = @_;
3075 3792
… …
3131 $_->() 3848 $_->()
3132 for values %{delete $self->{refresh_hook}}; 3849 for values %{delete $self->{refresh_hook}};
3133 } 3850 }
3134 3851
3135 if ($self->{realloc}) { 3852 if ($self->{realloc}) {
3853 my %queue;
3136 my @queue; 3854 my @queue;
3855 my $widget;
3137 3856
3857 outer:
3138 while () { 3858 while () {
3139 if ($self->{realloc}) { 3859 if (my $realloc = delete $self->{realloc}) {
3140 #TODO use array-of-depth approach 3860 for $widget (values %$realloc) {
3861 $widget->{visible} or next; # do not resize invisible widgets
3141 3862
3142 @queue = sort { $a->{visible} <=> $b->{visible} } 3863 $queue{$widget+0}++ and next; # duplicates are common
3143 @queue, values %{delete $self->{realloc}}; 3864
3865 push @{ $queue[$widget->{visible}] }, $widget;
3866 }
3144 } 3867 }
3145 3868
3869 while () {
3870 @queue or last outer;
3871
3146 my $widget = pop @queue || last; 3872 $widget = pop @{ $queue[-1] || [] }
3873 and last;
3874
3875 pop @queue;
3876 }
3147 3877
3148 $widget->{visible} or last; # do not resize invisible widgets 3878 delete $queue{$widget+0};
3149 3879
3150 my ($w, $h) = $widget->size_request; 3880 my ($w, $h) = $widget->size_request;
3151 3881
3152 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2; 3882 $w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3153 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2; 3883 $h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3884
3885 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3886 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3154 3887
3155 $w = $widget->{force_w} if exists $widget->{force_w}; 3888 $w = $widget->{force_w} if exists $widget->{force_w};
3156 $h = $widget->{force_h} if exists $widget->{force_h}; 3889 $h = $widget->{force_h} if exists $widget->{force_h};
3157 3890
3891 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3892 || delete $widget->{force_realloc}) {
3158 $widget->{req_w} = $w; 3893 $widget->{req_w} = $w;
3159 $widget->{req_h} = $h; 3894 $widget->{req_h} = $h;
3160 3895
3161 $self->{size_alloc}{$widget} = [$widget, undef, undef]; 3896 $self->{size_alloc}{$widget+0} = $widget;
3162 3897
3163 push @queue, $widget->{parent} 3898 if (my $parent = $widget->{parent}) {
3164 if ($self->{w} != $w || $self->{h} != $h) && $widget->{parent}; 3899 $self->{realloc}{$parent+0} = $parent
3900 unless $queue{$parent+0};
3901
3902 $parent->{force_size_alloc} = 1;
3903 $self->{size_alloc}{$parent+0} = $parent;
3904 }
3905 }
3906
3907 delete $self->{realloc}{$widget+0};
3165 } 3908 }
3166 } 3909 }
3167 3910
3168 while (my $size_alloc = delete $self->{size_alloc}) { 3911 while (my $size_alloc = delete $self->{size_alloc}) {
3169 my @queue = sort $b->[0]{visible} <=> $a->[0]{visible}, 3912 my @queue = sort { $b->{visible} <=> $a->{visible} }
3170 values %$size_alloc; 3913 values %$size_alloc;
3171 3914
3172 while () { 3915 while () {
3173 my ($widget, $w, $h) = @{ pop @queue or last }; 3916 my $widget = pop @queue || last;
3174 3917
3175 $w = $widget->{w} || $widget->{req_w} unless defined $w; 3918 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3176 $h = $widget->{h} || $widget->{req_h} unless defined $h;
3177 3919
3178 $w = 0 if $w < 0; 3920 $w = 0 if $w < 0;
3179 $h = 0 if $h < 0; 3921 $h = 0 if $h < 0;
3180 3922
3181 $w = int $w + 0.5; 3923 $w = int $w + 0.5;
3182 $h = int $h + 0.5; 3924 $h = int $h + 0.5;
3183 3925
3184 my $changed = $widget->{w} != $w || $widget->{h} != $h; 3926 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3927 $widget->{old_w} = $widget->{w};
3928 $widget->{old_h} = $widget->{h};
3185 3929
3186 $widget->{w} = $w; 3930 $widget->{w} = $w;
3187 $widget->{h} = $h; 3931 $widget->{h} = $h;
3188 3932
3189 $widget->emit (size_allocate => $w, $h, $changed); 3933 $widget->emit (size_allocate => $w, $h);
3934 }
3190 } 3935 }
3191 } 3936 }
3192 3937
3193 while ($self->{post_alloc_hook}) { 3938 while ($self->{post_alloc_hook}) {
3194 $_->() 3939 $_->()
3195 for values %{delete $self->{post_alloc_hook}}; 3940 for values %{delete $self->{post_alloc_hook}};
3196 } 3941 }
3942
3197 3943
3198 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3944 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3199 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3945 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3200 glClear GL_COLOR_BUFFER_BIT; 3946 glClear GL_COLOR_BUFFER_BIT;
3201 3947
… …
3203 glLoadIdentity; 3949 glLoadIdentity;
3204 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 3950 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3205 glMatrixMode GL_MODELVIEW; 3951 glMatrixMode GL_MODELVIEW;
3206 glLoadIdentity; 3952 glLoadIdentity;
3207 3953
3954 {
3955 package CFClient::UI::Base;
3956
3957 ($draw_x, $draw_y, $draw_w, $draw_h) =
3958 (0, 0, $self->{w}, $self->{h});
3959 }
3960
3208 $self->_draw; 3961 $self->_draw;
3209} 3962}
3210 3963
3211############################################################################# 3964#############################################################################
3212 3965

Diff Legend

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