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.283 by root, Mon Jun 5 02:28:30 2006 UTC vs.
Revision 1.328 by root, Sat Jul 22 13:43:05 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 return if $ENV{CFPLUS_DEBUG} & 8;
46
47 if (!$GRAB) {
48 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
49 if (length $widget->{tooltip}) {
50 if ($TOOLTIP->{owner} != $widget) {
51 $TOOLTIP->hide;
52
53 $TOOLTIP->{owner} = $widget;
54
55 my $tip = $widget->{tooltip};
56
57 $tip = $tip->($widget) if CODE:: eq ref $tip;
58
59 $TOOLTIP->set_tooltip_from ($widget);
60 $TOOLTIP->show;
61 }
62
63 return;
64 }
65 }
66 }
67
68 $TOOLTIP->hide;
69 delete $TOOLTIP->{owner};
70}
71
72# class methods for events 73# class methods for events
73sub feed_sdl_key_down_event { 74sub feed_sdl_key_down_event {
74 $FOCUS->emit (key_down => $_[0]) 75 $FOCUS->emit (key_down => $_[0])
75 if $FOCUS; 76 if $FOCUS;
76} 77}
… …
82 83
83sub feed_sdl_button_down_event { 84sub feed_sdl_button_down_event {
84 my ($ev) = @_; 85 my ($ev) = @_;
85 my ($x, $y) = ($ev->{x}, $ev->{y}); 86 my ($x, $y) = ($ev->{x}, $ev->{y});
86 87
88 warn "button down $ev->{button}\n";#d#
89
87 if (!$BUTTON_STATE) { 90 if (!$BUTTON_STATE) {
88 my $widget = $ROOT->find_widget ($x, $y); 91 my $widget = $ROOT->find_widget ($x, $y);
89 92
90 $GRAB = $widget; 93 $GRAB = $widget;
91 $GRAB->update if $GRAB; 94 $GRAB->update if $GRAB;
92 95
93 check_tooltip; 96 $TOOLTIP_WATCHER->cb->();
94 } 97 }
95 98
96 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 99 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
97 100
98 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y)) 101 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
… …
113 if (!$BUTTON_STATE) { 116 if (!$BUTTON_STATE) {
114 my $grab = $GRAB; undef $GRAB; 117 my $grab = $GRAB; undef $GRAB;
115 $grab->update if $grab; 118 $grab->update if $grab;
116 $GRAB->update if $GRAB; 119 $GRAB->update if $GRAB;
117 120
118 check_tooltip; 121 $TOOLTIP_WATCHER->cb->();
119 } 122 }
120} 123}
121 124
122sub feed_sdl_motion_event { 125sub feed_sdl_motion_event {
123 my ($ev) = @_; 126 my ($ev) = @_;
… …
129 my $hover = $HOVER; $HOVER = $widget; 132 my $hover = $HOVER; $HOVER = $widget;
130 133
131 $hover->update if $hover && $hover->{can_hover}; 134 $hover->update if $hover && $hover->{can_hover};
132 $HOVER->update if $HOVER && $HOVER->{can_hover}; 135 $HOVER->update if $HOVER && $HOVER->{can_hover};
133 136
134 check_tooltip; 137 $TOOLTIP_WATCHER->start;
135 } 138 }
136 139
137 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y)) 140 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
138 if $HOVER; 141 if $HOVER;
139} 142}
… …
271 274
272 return unless $self->{visible}; 275 return unless $self->{visible};
273 276
274 $_->set_invisible for $self->children; 277 $_->set_invisible for $self->children;
275 278
279 delete $self->{visible};
276 delete $self->{root}; 280 delete $self->{root};
277 delete $self->{visible};
278 281
279 undef $GRAB if $GRAB == $self; 282 undef $GRAB if $GRAB == $self;
280 undef $HOVER if $HOVER == $self; 283 undef $HOVER if $HOVER == $self;
281 284
282 CFClient::UI::check_tooltip 285 $CFClient::UI::TOOLTIP_WATCHER->cb->()
283 if $TOOLTIP->{owner} == $self; 286 if $TOOLTIP->{owner} == $self;
284 287
285 $self->focus_out; 288 $self->emit ("focus_out");
286
287 $self->emit (visibility_change => 0); 289 $self->emit (visibility_change => 0);
288} 290}
289 291
290sub set_visibility { 292sub set_visibility {
291 my ($self, $visible) = @_; 293 my ($self, $visible) = @_;
… …
314} 316}
315 317
316sub move_abs { 318sub move_abs {
317 my ($self, $x, $y, $z) = @_; 319 my ($self, $x, $y, $z) = @_;
318 320
319 $self->{x} = List::Util::max 0, int $x; 321 $self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
320 $self->{y} = List::Util::max 0, int $y; 322 $self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
321 $self->{z} = $z if defined $z; 323 $self->{z} = $z if defined $z;
322 324
323 $self->update; 325 $self->update;
324} 326}
325 327
… …
333} 335}
334 336
335sub size_request { 337sub size_request {
336 require Carp; 338 require Carp;
337 Carp::confess "size_request is abstract"; 339 Carp::confess "size_request is abstract";
340}
341
342sub baseline_shift {
343 0
338} 344}
339 345
340sub configure { 346sub configure {
341 my ($self, $x, $y, $w, $h) = @_; 347 my ($self, $x, $y, $w, $h) = @_;
342 348
… …
366 372
367 $self->{root}{size_alloc}{$self+0} = $self; 373 $self->{root}{size_alloc}{$self+0} = $self;
368 } 374 }
369} 375}
370 376
371sub size_allocate {
372 # nothing to be done
373}
374
375sub children { 377sub children {
376 # nop 378 # nop
377} 379}
378 380
379sub visible_children { 381sub visible_children {
… …
399 401
400 $self->{tooltip} = $tooltip; 402 $self->{tooltip} = $tooltip;
401 403
402 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 404 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
403 delete $CFClient::UI::TOOLTIP->{owner}; 405 delete $CFClient::UI::TOOLTIP->{owner};
404 CFClient::UI::check_tooltip; 406 $CFClient::UI::TOOLTIP_WATCHER->cb->();
405 } 407 }
406} 408}
407 409
408# translate global coordinates to local coordinate system 410# translate global coordinates to local coordinate system
409sub coord2local { 411sub coord2local {
… …
417 my ($self, $x, $y) = @_; 419 my ($self, $x, $y) = @_;
418 420
419 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 421 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
420} 422}
421 423
422sub focus_in { 424sub invoke_focus_in {
423 my ($self) = @_; 425 my ($self) = @_;
424 426
425 return if $FOCUS == $self; 427 return if $FOCUS == $self;
426 return unless $self->{can_focus}; 428 return unless $self->{can_focus};
427 429
428 my $focus = $FOCUS; $FOCUS = $self; 430 $FOCUS = $self;
429 431
430 $self->_emit (focus_in => $focus); 432 $self->update;
431 433
432 $focus->update if $focus; 434 0
433 $FOCUS->update;
434} 435}
435 436
436sub focus_out { 437sub invoke_focus_out {
437 my ($self) = @_; 438 my ($self) = @_;
438 439
439 return unless $FOCUS == $self; 440 return unless $FOCUS == $self;
440 441
441 my $focus = $FOCUS; undef $FOCUS; 442 undef $FOCUS;
442 443
443 $self->_emit (focus_out => $focus); 444 $self->update;
444 445
445 $focus->update if $focus; #?
446
447 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus 446 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
448 unless $FOCUS; 447 unless $FOCUS;
449}
450 448
449 0
450}
451
452sub grab_focus {
453 my ($self) = @_;
454
455 $FOCUS->emit ("focus_out") if $FOCUS;
456 $self->emit ("focus_in");
457}
458
451sub mouse_motion { 0 } 459sub invoke_mouse_motion { 0 }
452sub button_up { 0 } 460sub invoke_button_up { 0 }
453sub key_down { 0 } 461sub invoke_key_down { 0 }
454sub key_up { 0 } 462sub invoke_key_up { 0 }
455 463
456sub button_down { 464sub invoke_button_down {
457 my ($self, $ev, $x, $y) = @_; 465 my ($self, $ev, $x, $y) = @_;
458 466
459 $self->focus_in; 467 $self->grab_focus;
468
469 warn "button down $ev->{button} $x $y\n";#d#
460 470
461 0 471 0
472}
473
474sub connect {
475 my ($self, $signal, $cb) = @_;
476
477 push @{ $self->{signal_cb}{$signal} }, $cb;
478}
479
480sub emit {
481 my ($self, $signal, @args) = @_;
482
483 #d##TODO# stop propagating at first true, do not use sum
484 (List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before
485 || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure
486 || ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
462} 487}
463 488
464sub find_widget { 489sub find_widget {
465 my ($self, $x, $y) = @_; 490 my ($self, $x, $y) = @_;
466 491
… …
476sub set_parent { 501sub set_parent {
477 my ($self, $parent) = @_; 502 my ($self, $parent) = @_;
478 503
479 Scalar::Util::weaken ($self->{parent} = $parent); 504 Scalar::Util::weaken ($self->{parent} = $parent);
480 $self->set_visible if $parent->{visible}; 505 $self->set_visible if $parent->{visible};
481}
482
483sub connect {
484 my ($self, $signal, $cb) = @_;
485
486 push @{ $self->{signal_cb}{$signal} }, $cb;
487}
488
489sub _emit {
490 my ($self, $signal, @args) = @_;
491
492 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
493}
494
495sub emit {
496 my ($self, $signal, @args) = @_;
497
498 $self->_emit ($signal, @args)
499 || $self->$signal (@args);
500}
501
502sub visibility_change {
503 #my ($self, $visible) = @_;
504} 506}
505 507
506sub realloc { 508sub realloc {
507 my ($self) = @_; 509 my ($self) = @_;
508 510
… …
541 return unless $self->{h} && $self->{w}; 543 return unless $self->{h} && $self->{w};
542 544
543 # update screen rectangle 545 # update screen rectangle
544 local $draw_x = $draw_x + $self->{x}; 546 local $draw_x = $draw_x + $self->{x};
545 local $draw_y = $draw_y + $self->{y}; 547 local $draw_y = $draw_y + $self->{y};
546 local $draw_w = $draw_x + $self->{w};
547 local $draw_h = $draw_y + $self->{h};
548 548
549 # skip widgets that are entirely outside the drawing area 549 # skip widgets that are entirely outside the drawing area
550 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w) 550 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
551 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h); 551 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
552 552
… …
591} 591}
592 592
593sub DESTROY { 593sub DESTROY {
594 my ($self) = @_; 594 my ($self) = @_;
595 595
596 return if CFClient::in_destruct;
597
596 delete $WIDGET{$self+0}; 598 delete $WIDGET{$self+0};
597 #$self->deactivate; 599
600 eval { $self->destroy };
601 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
598} 602}
599 603
600############################################################################# 604#############################################################################
601 605
602package CFClient::UI::DrawBG; 606package CFClient::UI::DrawBG;
… …
767} 771}
768 772
769sub add { 773sub add {
770 my ($self, $child) = @_; 774 my ($self, $child) = @_;
771 775
772 $self->{children} = []; 776 $self->SUPER::remove ($_) for @{ $self->{children} };
773
774 $self->SUPER::add ($child); 777 $self->SUPER::add ($child);
775} 778}
776 779
777sub remove { 780sub remove {
778 my ($self, $widget) = @_; 781 my ($self, $widget) = @_;
… …
787 790
788sub size_request { 791sub size_request {
789 $_[0]{children}[0]->size_request 792 $_[0]{children}[0]->size_request
790} 793}
791 794
792sub size_allocate { 795sub invoke_size_allocate {
793 my ($self, $w, $h) = @_; 796 my ($self, $w, $h) = @_;
794 797
795 $self->{children}[0]->configure (0, 0, $w, $h); 798 $self->{children}[0]->configure (0, 0, $w, $h);
799
800 1
796} 801}
797 802
798############################################################################# 803#############################################################################
799 804
800# back-buffered drawing area 805# back-buffered drawing area
… …
816 821
817 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 822 $ROOT->on_post_alloc ($self => sub { $self->render_child });
818 $self->SUPER::update; 823 $self->SUPER::update;
819} 824}
820 825
821sub size_allocate { 826sub invoke_size_allocate {
822 my ($self, $w, $h) = @_; 827 my ($self, $w, $h) = @_;
823 828
824 $self->SUPER::size_allocate ($w, $h);
825 $self->update; 829 $self->update;
830
831 $self->SUPER::invoke_size_allocate ($w, $h)
826} 832}
827 833
828sub _render { 834sub _render {
829 my ($self) = @_; 835 my ($self) = @_;
830 836
… …
891 $h = 10 if $self->{scroll_y}; 897 $h = 10 if $self->{scroll_y};
892 898
893 ($w, $h) 899 ($w, $h)
894} 900}
895 901
896sub size_allocate { 902sub invoke_size_allocate {
897 my ($self, $w, $h) = @_; 903 my ($self, $w, $h) = @_;
898 904
899 my $child = $self->child; 905 my $child = $self->child;
900 906
901 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w}; 907 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
902 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h}; 908 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
903 909
904 $self->child->configure (0, 0, $w, $h); 910 $self->child->configure (0, 0, $w, $h);
905 $self->update; 911 $self->update;
912
913 1
906} 914}
907 915
908sub set_offset { 916sub set_offset {
909 my ($self, $x, $y) = @_; 917 my ($self, $x, $y) = @_;
910 918
… …
984 $self->add ($child) if $child; 992 $self->add ($child) if $child;
985 993
986 $self 994 $self
987} 995}
988 996
997#TODO# update range on size_allocate depending on child
998
989sub add { 999sub add {
990 my ($self, $widget) = @_; 1000 my ($self, $widget) = @_;
991 1001
992 $self->{vp}->add ($self->{child} = $widget); 1002 $self->{vp}->add ($self->{child} = $widget);
993} 1003}
994 1004
1005sub invoke_button_down {
1006 my ($self, $ev) = @_;
1007
1008 warn "button down $ev->{button}\n";#d#
1009
1010 0
1011}
1012
1013sub update_slider {
1014 my ($self) = @_;
1015
1016 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
1017}
1018
995sub update { 1019sub update {
996 my ($self) = @_; 1020 my ($self) = @_;
997 1021
998 $self->SUPER::update; 1022 $self->SUPER::update;
999 1023
1000 # todo: overwrite size_allocate of child 1024 $self->update_slider;
1001 my $child = $self->{vp}->child;
1002 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1003} 1025}
1004 1026
1005sub size_allocate { 1027sub invoke_size_allocate {
1006 my ($self, $w, $h) = @_; 1028 my ($self, $w, $h) = @_;
1007 1029
1030 $self->update_slider;
1031
1008 $self->SUPER::size_allocate ($w, $h); 1032 $self->SUPER::invoke_size_allocate ($w, $h)
1009
1010 my $child = $self->{vp}->child;
1011 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1012} 1033}
1013
1014#TODO# update range on size_allocate depending on child
1015# update viewport offset on scroll
1016 1034
1017############################################################################# 1035#############################################################################
1018 1036
1019package CFClient::UI::Frame; 1037package CFClient::UI::Frame;
1020 1038
… …
1071 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1089 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1072 1090
1073sub new { 1091sub new {
1074 my ($class, %arg) = @_; 1092 my ($class, %arg) = @_;
1075 1093
1076 my $title = delete $arg{title};
1077
1078 my $self = $class->SUPER::new ( 1094 my $self = $class->SUPER::new (
1079 bg => [1, 1, 1, 1], 1095 bg => [1, 1, 1, 1],
1080 border_bg => [1, 1, 1, 1], 1096 border_bg => [1, 1, 1, 1],
1081 border => 0.6, 1097 border => 0.6,
1082 can_events => 1, 1098 can_events => 1,
1083 min_w => 16, 1099 min_w => 64,
1084 min_h => 16, 1100 min_h => 32,
1085 %arg, 1101 %arg,
1086 ); 1102 );
1087 1103
1088 $self->{title} = new CFClient::UI::Label 1104 $self->{title_widget} = new CFClient::UI::Label
1089 align => 0, 1105 align => 0,
1090 valign => 1, 1106 valign => 1,
1091 text => $title, 1107 text => $self->{title},
1092 fontsize => $self->{border} 1108 fontsize => $self->{border},
1093 if defined $title; 1109 if exists $self->{title};
1110
1111 if ($self->{has_close_button}) {
1112 $self->{close_button} =
1113 new CFClient::UI::ImageButton
1114 path => 'x1_close.png',
1115 on_activate => sub { $self->emit ("delete") };
1116
1117 $self->CFClient::UI::Container::add ($self->{close_button});
1118 }
1094 1119
1095 $self 1120 $self
1096} 1121}
1097 1122
1098sub add { 1123sub add {
1099 my ($self, @widgets) = @_; 1124 my ($self, @widgets) = @_;
1100 1125
1101 $self->SUPER::add (@widgets); 1126 $self->SUPER::add (@widgets);
1127 $self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1102 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title}; 1128 $self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1103} 1129}
1104 1130
1105sub border { 1131sub border {
1106 int $_[0]{border} * $::FONTSIZE 1132 int $_[0]{border} * $::FONTSIZE
1107} 1133}
1108 1134
1109sub size_request { 1135sub size_request {
1110 my ($self) = @_; 1136 my ($self) = @_;
1111 1137
1112 $self->{title}->size_request 1138 $self->{title_widget}->size_request
1113 if $self->{title}; 1139 if $self->{title_widget};
1140
1141 $self->{close_button}->size_request
1142 if $self->{close_button};
1114 1143
1115 my ($w, $h) = $self->SUPER::size_request; 1144 my ($w, $h) = $self->SUPER::size_request;
1116 1145
1117 ( 1146 (
1118 $w + $self->border * 2, 1147 $w + $self->border * 2,
1119 $h + $self->border * 2, 1148 $h + $self->border * 2,
1120 ) 1149 )
1121} 1150}
1122 1151
1123sub size_allocate { 1152sub invoke_size_allocate {
1124 my ($self, $w, $h) = @_; 1153 my ($self, $w, $h) = @_;
1125 1154
1126 if ($self->{title}) { 1155 if ($self->{title_widget}) {
1127 $self->{title}{w} = $w; 1156 $self->{title_widget}{w} = $w;
1128 $self->{title}{h} = $h; 1157 $self->{title_widget}{h} = $h;
1129 $self->{title}->size_allocate ($w, $h); 1158 $self->{title_widget}->invoke_size_allocate ($w, $h);
1130 } 1159 }
1131 1160
1132 my $border = $self->border; 1161 my $border = $self->border;
1133 1162
1134 $h -= List::Util::max 0, $border * 2; 1163 $h -= List::Util::max 0, $border * 2;
1135 $w -= List::Util::max 0, $border * 2; 1164 $w -= List::Util::max 0, $border * 2;
1165
1166 $self->child->configure ($border, $border, $w, $h);
1167
1168 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1169 if $self->{close_button};
1170
1171 1
1172}
1173
1174sub invoke_delete {
1175 my ($self) = @_;
1176
1177 $self->hide;
1136 1178
1137 $self->child->configure ($border, $border, $w, $h); 1179 1
1138} 1180}
1139 1181
1140sub button_down { 1182sub invoke_button_down {
1141 my ($self, $ev, $x, $y) = @_; 1183 my ($self, $ev, $x, $y) = @_;
1142 1184
1143 my ($w, $h) = @$self{qw(w h)}; 1185 my ($w, $h) = @$self{qw(w h)};
1144 my $border = $self->border; 1186 my $border = $self->border;
1145 1187
… …
1176 1218
1177 ($x, $y) = ($ev->{x}, $ev->{y}); 1219 ($x, $y) = ($ev->{x}, $ev->{y});
1178 1220
1179 $self->move_abs ($bx + $x - $ox, $by + $y - $oy); 1221 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1180 # HACK: the next line is required to enforce placement 1222 # HACK: the next line is required to enforce placement
1181 $self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h}); 1223 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1182 }; 1224 };
1183 } else { 1225 } else {
1184 return 0; 1226 return 0;
1185 } 1227 }
1186 1228
1187 1 1229 1
1188} 1230}
1189 1231
1190sub button_up { 1232sub invoke_button_up {
1191 my ($self, $ev, $x, $y) = @_; 1233 my ($self, $ev, $x, $y) = @_;
1192 1234
1193 !!delete $self->{motion} 1235 ! ! delete $self->{motion}
1194} 1236}
1195 1237
1196sub mouse_motion { 1238sub invoke_mouse_motion {
1197 my ($self, $ev, $x, $y) = @_; 1239 my ($self, $ev, $x, $y) = @_;
1198 1240
1199 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1241 $self->{motion}->($ev, $x, $y) if $self->{motion};
1200 1242
1201 !!$self->{motion} 1243 ! ! $self->{motion}
1202} 1244}
1203 1245
1204sub _draw { 1246sub _draw {
1205 my ($self) = @_; 1247 my ($self) = @_;
1206 1248
… …
1232 1274
1233 glDisable GL_TEXTURE_2D; 1275 glDisable GL_TEXTURE_2D;
1234 1276
1235 $child->draw; 1277 $child->draw;
1236 1278
1237 if ($self->{title}) { 1279 if ($self->{title_widget}) {
1238 glTranslate 0, $border - $self->{h}; 1280 glTranslate 0, $border - $self->{h};
1239 $self->{title}->_draw; 1281 $self->{title_widget}->_draw;
1282
1283 glTranslate 0, - ($border - $self->{h});
1240 } 1284 }
1285
1286 $self->{close_button}->draw
1287 if $self->{close_button};
1241} 1288}
1242 1289
1243############################################################################# 1290#############################################################################
1244 1291
1245package CFClient::UI::Table; 1292package CFClient::UI::Table;
… …
1268 1315
1269 $child->set_parent ($self); 1316 $child->set_parent ($self);
1270 $self->{children}[$y][$x] = $child; 1317 $self->{children}[$y][$x] = $child;
1271 1318
1272 $self->realloc; 1319 $self->realloc;
1320}
1321
1322sub remove {
1323 my ($self, $child) = @_;
1324
1325 # TODO: not yet implemented
1273} 1326}
1274 1327
1275# TODO: move to container class maybe? send children a signal on removal? 1328# TODO: move to container class maybe? send children a signal on removal?
1276sub clear { 1329sub clear {
1277 my ($self) = @_; 1330 my ($self) = @_;
… …
1318 (sum @$ws), 1371 (sum @$ws),
1319 (sum @$hs), 1372 (sum @$hs),
1320 ) 1373 )
1321} 1374}
1322 1375
1323sub size_allocate { 1376sub invoke_size_allocate {
1324 my ($self, $w, $h) = @_; 1377 my ($self, $w, $h) = @_;
1325 1378
1326 my ($ws, $hs) = $self->get_wh; 1379 my ($ws, $hs) = $self->get_wh;
1327 1380
1328 my $req_w = (sum @$ws) || 1; 1381 my $req_w = (sum @$ws) || 1;
… …
1360 } 1413 }
1361 1414
1362 $y += $row_h; 1415 $y += $row_h;
1363 } 1416 }
1364 1417
1418 1
1365} 1419}
1366 1420
1367sub find_widget { 1421sub find_widget {
1368 my ($self, $x, $y) = @_; 1422 my ($self, $x, $y) = @_;
1369 1423
… …
1406 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1460 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1407 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1461 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1408 ) 1462 )
1409} 1463}
1410 1464
1411sub size_allocate { 1465sub invoke_size_allocate {
1412 my ($self, $w, $h) = @_; 1466 my ($self, $w, $h) = @_;
1413 1467
1414 my $space = $self->{vertical} ? $h : $w; 1468 my $space = $self->{vertical} ? $h : $w;
1415 my $children = $self->{children}; 1469 my @children = $self->visible_children;
1416 1470
1417 my @req; 1471 my @req;
1418 1472
1419 if ($self->{homogeneous}) { 1473 if ($self->{homogeneous}) {
1420 @req = ($space / (@$children || 1)) x @$children; 1474 @req = ($space / (@children || 1)) x @children;
1421 } else { 1475 } else {
1422 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children; 1476 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1423 my $req = List::Util::sum @req; 1477 my $req = List::Util::sum @req;
1424 1478
1425 if ($req > $space) { 1479 if ($req > $space) {
1426 # ah well, not enough space 1480 # ah well, not enough space
1427 $_ *= $space / $req for @req; 1481 $_ *= $space / $req for @req;
1428 } else { 1482 } else {
1429 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1; 1483 my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1430 1484
1431 $space = ($space - $req) / $expand; # remaining space to give away 1485 $space = ($space - $req) / $expand; # remaining space to give away
1432 1486
1433 $req[$_] += $space * $children->[$_]{expand} 1487 $req[$_] += $space * $children[$_]{expand}
1434 for 0 .. $#$children; 1488 for 0 .. $#children;
1435 } 1489 }
1436 } 1490 }
1437 1491
1438 CFClient::UI::harmonize \@req; 1492 CFClient::UI::harmonize \@req;
1439 1493
1440 my $pos = 0; 1494 my $pos = 0;
1441 for (0 .. $#$children) { 1495 for (0 .. $#children) {
1442 my $alloc = $req[$_]; 1496 my $alloc = $req[$_];
1443 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1497 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1444 1498
1445 $pos += $alloc; 1499 $pos += $alloc;
1446 } 1500 }
1447 1501
1448 1 1502 1
… …
1551 my ($self, $text) = @_; 1605 my ($self, $text) = @_;
1552 1606
1553 return if $self->{text} eq "T$text"; 1607 return if $self->{text} eq "T$text";
1554 $self->{text} = "T$text"; 1608 $self->{text} = "T$text";
1555 1609
1556 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1557 $self->{layout}->set_text ($text); 1610 $self->{layout}->set_text ($text);
1611
1558 delete $self->{req_h}; 1612 delete $self->{size_req};
1559
1560 $self->realloc; 1613 $self->realloc;
1561 $self->update; 1614 $self->update;
1562} 1615}
1563 1616
1564sub set_markup { 1617sub set_markup {
… …
1567 return if $self->{text} eq "M$markup"; 1620 return if $self->{text} eq "M$markup";
1568 $self->{text} = "M$markup"; 1621 $self->{text} = "M$markup";
1569 1622
1570 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1623 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1571 1624
1572 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1573 $self->{layout}->set_markup ($markup); 1625 $self->{layout}->set_markup ($markup);
1626
1574 delete $self->{req_h}; 1627 delete $self->{size_req};
1575
1576 $self->realloc; 1628 $self->realloc;
1577 $self->update; 1629 $self->update;
1578} 1630}
1579 1631
1580sub size_request { 1632sub size_request {
1581 my ($self) = @_; 1633 my ($self) = @_;
1582 1634
1583 if (exists $self->{req_h}) { 1635 $self->{size_req} ||= do {
1584 @$self{qw(req_w req_h)}
1585 } else {
1586 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1636 $self->{layout}->set_font ($self->{font}) if $self->{font};
1587 $self->{layout}->set_width ($self->{max_w} || -1); 1637 $self->{layout}->set_width ($self->{max_w} || -1);
1588 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1638 $self->{layout}->set_ellipsise ($self->{ellipsise});
1589 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1639 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1590 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1640 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1591 1641
1592 my ($w, $h) = $self->{layout}->size; 1642 my ($w, $h) = $self->{layout}->size;
1593 1643
1594 if (exists $self->{template}) { 1644 if (exists $self->{template}) {
1595 $self->{template}->set_font ($self->{font}) if $self->{font}; 1645 $self->{template}->set_font ($self->{font}) if $self->{font};
1646 $self->{template}->set_width ($self->{max_w} || -1);
1596 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 1647 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1597 1648
1598 my ($w2, $h2) = $self->{template}->size; 1649 my ($w2, $h2) = $self->{template}->size;
1599 1650
1600 $w = List::Util::max $w, $w2; 1651 $w = List::Util::max $w, $w2;
1601 $h = List::Util::max $h, $h2; 1652 $h = List::Util::max $h, $h2;
1602 } 1653 }
1603 1654
1604 ($w, $h) 1655 [$w, $h]
1605 } 1656 };
1606}
1607 1657
1658 @{ $self->{size_req} }
1659}
1660
1661sub baseline_shift {
1662 $_[0]{layout}->descent
1663}
1664
1608sub size_allocate { 1665sub invoke_size_allocate {
1609 my ($self, $w, $h) = @_; 1666 my ($self, $w, $h) = @_;
1610 1667
1611 delete $self->{ox}; 1668 delete $self->{ox};
1612 1669
1613 delete $self->{texture} 1670 delete $self->{texture}
1614 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w}; 1671 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1672
1673 1
1615} 1674}
1616 1675
1617sub set_fontsize { 1676sub set_fontsize {
1618 my ($self, $fontsize) = @_; 1677 my ($self, $fontsize) = @_;
1619 1678
1620 $self->{fontsize} = $fontsize; 1679 $self->{fontsize} = $fontsize;
1680 delete $self->{size_req};
1621 delete $self->{texture}; 1681 delete $self->{texture};
1622 1682
1623 $self->realloc; 1683 $self->realloc;
1624} 1684}
1625 1685
1686sub reconfigure {
1687 my ($self) = @_;
1688
1689 delete $self->{size_req};
1690 delete $self->{texture};
1691
1692 $self->SUPER::reconfigure;
1693}
1694
1626sub _draw { 1695sub _draw {
1627 my ($self) = @_; 1696 my ($self) = @_;
1628 1697
1629 $self->SUPER::_draw; # draw background, if applicable 1698 $self->SUPER::_draw; # draw background, if applicable
1630 1699
1631 my $tex = $self->{texture} ||= do { 1700 my $size = $self->{texture} ||= do {
1632 $self->{layout}->set_foreground (@{$self->{fg}}); 1701 $self->{layout}->set_foreground (@{$self->{fg}});
1633 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1702 $self->{layout}->set_font ($self->{font}) if $self->{font};
1634 $self->{layout}->set_width ($self->{w}); 1703 $self->{layout}->set_width ($self->{w});
1635 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1704 $self->{layout}->set_ellipsise ($self->{ellipsise});
1636 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1705 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1637 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1706 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1638 1707
1639 new_from_layout CFClient::Texture $self->{layout} 1708 [$self->{layout}->size]
1640 }; 1709 };
1641 1710
1642 unless (exists $self->{ox}) { 1711 unless (exists $self->{ox}) {
1643 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} 1712 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1644 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x} 1713 : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1645 : ($self->{w} - $tex->{w}) * 0.5); 1714 : ($self->{w} - $size->[0]) * 0.5);
1646 1715
1647 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 1716 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1648 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y} 1717 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1649 : ($self->{h} - $tex->{h}) * 0.5); 1718 : ($self->{h} - $size->[1]) * 0.5);
1650 }; 1719 };
1651 1720
1652 glEnable GL_TEXTURE_2D; 1721 my $w = List::Util::min $self->{w} + 4, $size->[0];
1653 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1722 my $h = List::Util::min $self->{h} + 2, $size->[1];
1654 1723
1655 glColor_premultiply @{$self->{fg}} 1724 $self->{layout}->render ($self->{ox}, $self->{oy});
1656 if $tex->{format} == GL_ALPHA;
1657
1658 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1659
1660 glDisable GL_TEXTURE_2D;
1661} 1725}
1662 1726
1663############################################################################# 1727#############################################################################
1664 1728
1665package CFClient::UI::EntryBase; 1729package CFClient::UI::EntryBase;
… …
1679 can_hover => 1, 1743 can_hover => 1,
1680 can_focus => 1, 1744 can_focus => 1,
1681 valign => 0, 1745 valign => 0,
1682 can_events => 1, 1746 can_events => 1,
1683 #text => ... 1747 #text => ...
1748 #hidden => "*",
1684 @_ 1749 @_
1685 ) 1750 )
1686} 1751}
1687 1752
1688sub _set_text { 1753sub _set_text {
… …
1695 $self->{last_activity} = $::NOW; 1760 $self->{last_activity} = $::NOW;
1696 $self->{text} = $text; 1761 $self->{text} = $text;
1697 1762
1698 $text =~ s/./*/g if $self->{hidden}; 1763 $text =~ s/./*/g if $self->{hidden};
1699 $self->{layout}->set_text ("$text "); 1764 $self->{layout}->set_text ("$text ");
1700 delete $self->{req_h}; 1765 delete $self->{size_req};
1701 1766
1702 $self->_emit (changed => $self->{text}); 1767 $self->emit (changed => $self->{text});
1703 1768
1704 $self->realloc; 1769 $self->realloc;
1705 $self->update; 1770 $self->update;
1706} 1771}
1707 1772
… …
1722 my ($w, $h) = $self->SUPER::size_request; 1787 my ($w, $h) = $self->SUPER::size_request;
1723 1788
1724 ($w + 1, $h) # add 1 for cursor 1789 ($w + 1, $h) # add 1 for cursor
1725} 1790}
1726 1791
1727sub key_down { 1792sub invoke_key_down {
1728 my ($self, $ev) = @_; 1793 my ($self, $ev) = @_;
1729 1794
1730 my $mod = $ev->{mod}; 1795 my $mod = $ev->{mod};
1731 my $sym = $ev->{sym}; 1796 my $sym = $ev->{sym};
1732 my $uni = $ev->{unicode}; 1797 my $uni = $ev->{unicode};
… …
1744 } elsif ($sym == CFClient::SDLK_HOME) { 1809 } elsif ($sym == CFClient::SDLK_HOME) {
1745 $self->{cursor} = 0; 1810 $self->{cursor} = 0;
1746 } elsif ($sym == CFClient::SDLK_END) { 1811 } elsif ($sym == CFClient::SDLK_END) {
1747 $self->{cursor} = length $text; 1812 $self->{cursor} = length $text;
1748 } elsif ($uni == 27) { 1813 } elsif ($uni == 27) {
1749 $self->_emit ('escape'); 1814 $self->emit ('escape');
1750 } elsif ($uni) { 1815 } elsif ($uni) {
1751 substr $text, $self->{cursor}++, 0, chr $uni; 1816 substr $text, $self->{cursor}++, 0, chr $uni;
1752 } else { 1817 } else {
1753 return 0; 1818 return 0;
1754 } 1819 }
… …
1758 $self->realloc; 1823 $self->realloc;
1759 1824
1760 1 1825 1
1761} 1826}
1762 1827
1763sub focus_in { 1828sub invoke_focus_in {
1764 my ($self) = @_; 1829 my ($self) = @_;
1765 1830
1766 $self->{last_activity} = $::NOW; 1831 $self->{last_activity} = $::NOW;
1767 1832
1768 $self->SUPER::focus_in; 1833 $self->SUPER::invoke_focus_in
1769} 1834}
1770 1835
1771sub button_down { 1836sub invoke_button_down {
1772 my ($self, $ev, $x, $y) = @_; 1837 my ($self, $ev, $x, $y) = @_;
1773 1838
1774 $self->SUPER::button_down ($ev, $x, $y); 1839 $self->SUPER::invoke_button_down ($ev, $x, $y);
1775 1840
1776 my $idx = $self->{layout}->xy_to_index ($x, $y); 1841 my $idx = $self->{layout}->xy_to_index ($x, $y);
1777 1842
1778 # byte-index to char-index 1843 # byte-index to char-index
1779 my $text = $self->{text}; 1844 my $text = $self->{text};
1780 utf8::encode $text; 1845 utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1781 $self->{cursor} = length substr $text, 0, $idx; 1846 $self->{cursor} = length $text;
1782 1847
1783 $self->_set_text ($self->{text}); 1848 $self->_set_text ($self->{text});
1784 $self->update; 1849 $self->update;
1785 1850
1786 1 1851 1
1787} 1852}
1788 1853
1789sub mouse_motion { 1854sub invoke_mouse_motion {
1790 my ($self, $ev, $x, $y) = @_; 1855 my ($self, $ev, $x, $y) = @_;
1791# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1856# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1792 1857
1793 0 1858 1
1794} 1859}
1795 1860
1796sub _draw { 1861sub _draw {
1797 my ($self) = @_; 1862 my ($self) = @_;
1798 1863
… …
1839 1904
1840our @ISA = CFClient::UI::EntryBase::; 1905our @ISA = CFClient::UI::EntryBase::;
1841 1906
1842use CFClient::OpenGL; 1907use CFClient::OpenGL;
1843 1908
1844sub key_down { 1909sub invoke_key_down {
1845 my ($self, $ev) = @_; 1910 my ($self, $ev) = @_;
1846 1911
1847 my $sym = $ev->{sym}; 1912 my $sym = $ev->{sym};
1848 1913
1849 if ($sym == 13) { 1914 if ($sym == 13) {
1850 unshift @{$self->{history}}, 1915 unshift @{$self->{history}},
1851 my $txt = $self->get_text; 1916 my $txt = $self->get_text;
1917
1852 $self->{history_pointer} = -1; 1918 $self->{history_pointer} = -1;
1853 $self->{history_saveback} = ''; 1919 $self->{history_saveback} = '';
1854 $self->_emit (activate => $txt); 1920 $self->emit (activate => $txt);
1855 $self->update; 1921 $self->update;
1856 1922
1857 } elsif ($sym == CFClient::SDLK_UP) { 1923 } elsif ($sym == CFClient::SDLK_UP) {
1858 if ($self->{history_pointer} < 0) { 1924 if ($self->{history_pointer} < 0) {
1859 $self->{history_saveback} = $self->get_text; 1925 $self->{history_saveback} = $self->get_text;
… …
1875 } else { 1941 } else {
1876 $self->set_text ($self->{history_saveback}); 1942 $self->set_text ($self->{history_saveback});
1877 } 1943 }
1878 1944
1879 } else { 1945 } else {
1880 return $self->SUPER::key_down ($ev) 1946 return $self->SUPER::invoke_key_down ($ev)
1881 } 1947 }
1882 1948
1883 1 1949 1
1884} 1950}
1885 1951
… …
1909 can_events => 1, 1975 can_events => 1,
1910 @_ 1976 @_
1911 ) 1977 )
1912} 1978}
1913 1979
1914sub activate { }
1915
1916sub button_up { 1980sub invoke_button_up {
1917 my ($self, $ev, $x, $y) = @_; 1981 my ($self, $ev, $x, $y) = @_;
1918 1982
1919 $self->emit ("activate") 1983 $self->emit ("activate")
1920 if $x >= 0 && $x < $self->{w} 1984 if $x >= 0 && $x < $self->{w}
1921 && $y >= 0 && $y < $self->{h}; 1985 && $y >= 0 && $y < $self->{h};
… …
1935 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 1999 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1936 2000
1937 glDisable GL_TEXTURE_2D; 2001 glDisable GL_TEXTURE_2D;
1938 2002
1939 $self->SUPER::_draw; 2003 $self->SUPER::_draw;
2004}
2005
2006#############################################################################
2007
2008package CFClient::UI::ImageButton;
2009
2010our @ISA = CFClient::UI::Image::;
2011
2012use CFClient::OpenGL;
2013
2014my %textures;
2015
2016sub new {
2017 my $class = shift;
2018
2019 my $self = $class->SUPER::new (
2020 padding_x => 4,
2021 padding_y => 4,
2022 fg => [1, 1, 1],
2023 active_fg => [0, 0, 1],
2024 can_hover => 1,
2025 align => 0,
2026 valign => 0,
2027 can_events => 1,
2028 @_
2029 );
2030}
2031
2032sub invoke_button_up {
2033 my ($self, $ev, $x, $y) = @_;
2034
2035 $self->emit ("activate")
2036 if $x >= 0 && $x < $self->{w}
2037 && $y >= 0 && $y < $self->{h};
2038
2039 1
1940} 2040}
1941 2041
1942############################################################################# 2042#############################################################################
1943 2043
1944package CFClient::UI::CheckBox; 2044package CFClient::UI::CheckBox;
… …
1971 my ($self) = @_; 2071 my ($self) = @_;
1972 2072
1973 (6) x 2 2073 (6) x 2
1974} 2074}
1975 2075
2076sub toggle {
2077 my ($self) = @_;
2078
2079 $self->{state} = !$self->{state};
2080 $self->emit (changed => $self->{state});
2081 $self->update;
2082}
2083
1976sub button_down { 2084sub invoke_button_down {
1977 my ($self, $ev, $x, $y) = @_; 2085 my ($self, $ev, $x, $y) = @_;
1978 2086
1979 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2087 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1980 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2088 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1981 $self->{state} = !$self->{state}; 2089 $self->toggle;
1982 $self->_emit (changed => $self->{state});
1983 } else { 2090 } else {
1984 return 0 2091 return 0
1985 } 2092 }
1986 2093
1987 1 2094 1
… …
2012package CFClient::UI::Image; 2119package CFClient::UI::Image;
2013 2120
2014our @ISA = CFClient::UI::Base::; 2121our @ISA = CFClient::UI::Base::;
2015 2122
2016use CFClient::OpenGL; 2123use CFClient::OpenGL;
2017use Carp qw/confess/;
2018 2124
2019our %loaded_images; 2125our %texture_cache;
2020 2126
2021sub new { 2127sub new {
2022 my $class = shift; 2128 my $class = shift;
2023 2129
2024 my $self = $class->SUPER::new (can_events => 0, @_); 2130 my $self = $class->SUPER::new (
2131 can_events => 0,
2132 @_,
2133 );
2025 2134
2026 $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; 2135 $self->{path} || $self->{tex}
2136 or Carp::croak "'path' or 'tex' attributes required";
2027 2137
2028 $loaded_images{$self->{image}} ||= 2138 $self->{tex} ||= $texture_cache{$self->{path}} ||=
2029 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; 2139 new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2030 2140
2031 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2141 Scalar::Util::weaken $texture_cache{$self->{path}};
2032 2142
2033 Scalar::Util::weaken $loaded_images{$self->{image}}; 2143 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2034
2035 $self->{aspect} = $tex->{w} / $tex->{h};
2036 2144
2037 $self 2145 $self
2038} 2146}
2039 2147
2040sub size_request { 2148sub size_request {
2041 my ($self) = @_; 2149 my ($self) = @_;
2042 2150
2043 ($self->{tex}->{w}, $self->{tex}->{h}) 2151 ($self->{tex}{w}, $self->{tex}{h})
2044} 2152}
2045 2153
2046sub _draw { 2154sub _draw {
2047 my ($self) = @_; 2155 my ($self) = @_;
2048 2156
… …
2157 my $ycut1 = max 0, min 1, $ycut; 2265 my $ycut1 = max 0, min 1, $ycut;
2158 my $ycut2 = max 0, min 1, $ycut - 1; 2266 my $ycut2 = max 0, min 1, $ycut - 1;
2159 2267
2160 my $h1 = $self->{h} * (1 - $ycut1); 2268 my $h1 = $self->{h} * (1 - $ycut1);
2161 my $h2 = $self->{h} * (1 - $ycut2); 2269 my $h2 = $self->{h} * (1 - $ycut2);
2270 my $h3 = $self->{h};
2271
2272 $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2162 2273
2163 glEnable GL_BLEND; 2274 glEnable GL_BLEND;
2164 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA, 2275 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2165 GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2276 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2166 glEnable GL_TEXTURE_2D; 2277 glEnable GL_TEXTURE_2D;
… …
2185 2296
2186 if ($t3) { 2297 if ($t3) {
2187 glBindTexture GL_TEXTURE_2D, $t3->{name}; 2298 glBindTexture GL_TEXTURE_2D, $t3->{name};
2188 glBegin GL_QUADS; 2299 glBegin GL_QUADS;
2189 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2; 2300 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2190 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h}; 2301 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2191 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h}; 2302 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2192 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2; 2303 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2193 glEnd; 2304 glEnd;
2194 } 2305 }
2195 2306
2196 glDisable GL_BLEND; 2307 glDisable GL_BLEND;
… …
2284 $self->update; 2395 $self->update;
2285 2396
2286 $self 2397 $self
2287} 2398}
2288 2399
2289sub changed { }
2290
2291sub set_range { 2400sub set_range {
2292 my ($self, $range) = @_; 2401 my ($self, $range) = @_;
2293 2402
2294 ($range, $self->{range}) = ($self->{range}, $range); 2403 ($range, $self->{range}) = ($self->{range}, $range);
2295 2404
2296 $self->update
2297 if "@$range" ne "@{$self->{range}}"; 2405 if ("@$range" ne "@{$self->{range}}") {
2406 $self->update;
2407 $self->set_value ($self->{range}[0]);
2408 }
2298} 2409}
2299 2410
2300sub set_value { 2411sub set_value {
2301 my ($self, $value) = @_; 2412 my ($self, $value) = @_;
2302 2413
… …
2313 if $unit; 2424 if $unit;
2314 2425
2315 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2426 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2316 2427
2317 if ($value != $old_value) { 2428 if ($value != $old_value) {
2318 $self->_emit (changed => $value); 2429 $self->emit (changed => $value);
2319 $self->update; 2430 $self->update;
2320 } 2431 }
2321} 2432}
2322 2433
2323sub size_request { 2434sub size_request {
2324 my ($self) = @_; 2435 my ($self) = @_;
2325 2436
2326 ($self->{req_w}, $self->{req_h}) 2437 ($self->{req_w}, $self->{req_h})
2327} 2438}
2328 2439
2329sub button_down { 2440sub invoke_button_down {
2330 my ($self, $ev, $x, $y) = @_; 2441 my ($self, $ev, $x, $y) = @_;
2331 2442
2332 $self->SUPER::button_down ($ev, $x, $y); 2443 $self->SUPER::invoke_button_down ($ev, $x, $y);
2333 2444
2334 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2445 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2335 2446
2336 $self->mouse_motion ($ev, $x, $y) 2447 $self->invoke_mouse_motion ($ev, $x, $y)
2337} 2448}
2338 2449
2339sub mouse_motion { 2450sub invoke_mouse_motion {
2340 my ($self, $ev, $x, $y) = @_; 2451 my ($self, $ev, $x, $y) = @_;
2341 2452
2342 if ($GRAB == $self) { 2453 if ($GRAB == $self) {
2343 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2454 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2344 2455
… …
2449sub set_range { shift->{slider}->set_range (@_) } 2560sub set_range { shift->{slider}->set_range (@_) }
2450sub set_value { shift->{slider}->set_value (@_) } 2561sub set_value { shift->{slider}->set_value (@_) }
2451 2562
2452############################################################################# 2563#############################################################################
2453 2564
2454package CFClient::UI::TextView; 2565package CFClient::UI::TextScroller;
2455 2566
2456our @ISA = CFClient::UI::HBox::; 2567our @ISA = CFClient::UI::HBox::;
2457 2568
2458use CFClient::OpenGL; 2569use CFClient::OpenGL;
2459 2570
… …
2461 my $class = shift; 2572 my $class = shift;
2462 2573
2463 my $self = $class->SUPER::new ( 2574 my $self = $class->SUPER::new (
2464 fontsize => 1, 2575 fontsize => 1,
2465 can_events => 0, 2576 can_events => 0,
2577 indent => 0,
2466 #font => default_font 2578 #font => default_font
2467 @_, 2579 @_,
2468 2580
2469 layout => (new CFClient::Layout 1), 2581 layout => (new CFClient::Layout),
2470 par => [], 2582 par => [],
2471 height => 0, 2583 height => 0,
2472 children => [ 2584 children => [
2473 (new CFClient::UI::Empty expand => 1), 2585 (new CFClient::UI::Empty expand => 1),
2474 (new CFClient::UI::Slider vertical => 1), 2586 (new CFClient::UI::Slider vertical => 1),
… …
2485 2597
2486 $self->{fontsize} = $fontsize; 2598 $self->{fontsize} = $fontsize;
2487 $self->reflow; 2599 $self->reflow;
2488} 2600}
2489 2601
2602sub size_request {
2603 my ($self) = @_;
2604
2605 my ($empty, $slider) = @{ $self->{children} };
2606
2607 local $self->{children} = [$empty, $slider];
2608 $self->SUPER::size_request
2609}
2610
2490sub size_allocate { 2611sub invoke_size_allocate {
2491 my ($self, $w, $h) = @_; 2612 my ($self, $w, $h) = @_;
2492 2613
2493 $self->SUPER::size_allocate ($w, $h); 2614 my ($empty, $slider, @other) = @{ $self->{children} };
2615 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2494 2616
2495 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2617 $self->{layout}->set_font ($self->{font}) if $self->{font};
2496 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2618 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2497 $self->{layout}->set_width ($self->{children}[0]{w}); 2619 $self->{layout}->set_width ($empty->{w});
2620 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2498 2621
2499 $self->reflow; 2622 $self->reflow;
2500}
2501 2623
2502sub text_size { 2624 local $self->{children} = [$empty, $slider];
2503 my ($self, $text, $indent) = @_; 2625 $self->SUPER::invoke_size_allocate ($w, $h)
2626}
2627
2628sub get_layout {
2629 my ($self, $para) = @_;
2504 2630
2505 my $layout = $self->{layout}; 2631 my $layout = $self->{layout};
2506 2632
2633 $layout->set_font ($self->{font}) if $self->{font};
2634 $layout->set_foreground (@{$para->{fg}});
2507 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2635 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2508 $layout->set_width ($self->{children}[0]{w} - $indent); 2636 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2637 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2509 $layout->set_markup ($text); 2638 $layout->set_markup ($para->{markup});
2639
2640 $layout->set_shapes (
2641 map
2642 +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
2643 @{$para->{widget}}
2510 2644 );
2645
2511 $layout->size 2646 $layout
2512} 2647}
2513 2648
2514sub reflow { 2649sub reflow {
2515 my ($self) = @_; 2650 my ($self) = @_;
2516 2651
… …
2525 $self->{children}[1]->set_value ($offset); 2660 $self->{children}[1]->set_value ($offset);
2526} 2661}
2527 2662
2528sub clear { 2663sub clear {
2529 my ($self) = @_; 2664 my ($self) = @_;
2665
2666 my (undef, undef, @other) = @{ $self->{children} };
2667 $self->remove ($_) for @other;
2530 2668
2531 $self->{par} = []; 2669 $self->{par} = [];
2532 $self->{height} = 0; 2670 $self->{height} = 0;
2533 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2671 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2534} 2672}
2535 2673
2536sub add_paragraph { 2674sub add_paragraph {
2537 my ($self, $color, $text, $indent) = @_; 2675 my ($self, $color, $para, $indent) = @_;
2538 2676
2539 for my $line (split /\n/, $text) { 2677 my ($text, @w) = ref $para ? @$para : $para;
2540 my ($w, $h) = $self->text_size ($line); 2678
2541 $self->{height} += $h; 2679 $para = {
2542 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 2680 w => 1e10,
2681 wrapped => 1,
2682 fg => $color,
2683 indent => $indent,
2684 markup => $text,
2685 widget => \@w,
2543 } 2686 };
2544 2687
2545 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 2688 $self->add (@w) if @w;
2689 push @{$self->{par}}, $para;
2690
2691 $self->{need_reflow}++;
2692 $self->update;
2693}
2694
2695sub scroll_to_bottom {
2696 my ($self) = @_;
2697
2698 $self->{scroll_to_bottom} = 1;
2699 $self->update;
2546} 2700}
2547 2701
2548sub update { 2702sub update {
2549 my ($self) = @_; 2703 my ($self) = @_;
2550 2704
… …
2552 2706
2553 return unless $self->{h} > 0; 2707 return unless $self->{h} > 0;
2554 2708
2555 delete $self->{texture}; 2709 delete $self->{texture};
2556 2710
2557 $ROOT->on_post_alloc ($self, sub { 2711 $ROOT->on_post_alloc ($self => sub {
2558 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2712 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2559 2713
2560 if (delete $self->{need_reflow}) { 2714 if (delete $self->{need_reflow}) {
2561 my $height = 0; 2715 my $height = 0;
2562 2716
2563 my $layout = $self->{layout};
2564
2565 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2566
2567 for (@{$self->{par}}) { 2717 for my $para (@{$self->{par}}) {
2568 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2718 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2569 $layout->set_width ($W - $_->[3]); 2719 my $layout = $self->get_layout ($para);
2570 $layout->set_markup ($_->[4]);
2571 my ($w, $h) = $layout->size; 2720 my ($w, $h) = $layout->size;
2572 $_->[0] = $w + $_->[3]; 2721
2573 $_->[1] = $h; 2722 $para->{w} = $w + $para->{indent};
2723 $para->{h} = $h;
2724 $para->{wrapped} = $layout->has_wrapped;
2574 } 2725 }
2575 2726
2576 $height += $_->[1]; 2727 $height += $para->{h};
2577 } 2728 }
2578 2729
2579 $self->{height} = $height; 2730 $self->{height} = $height;
2580 2731
2581 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]); 2732 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2582 2733
2583 delete $self->{texture}; 2734 delete $self->{texture};
2735 }
2736
2737 if (delete $self->{scroll_to_bottom}) {
2738 $self->{children}[1]->set_value (1e10);
2584 } 2739 }
2585 2740
2586 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2741 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2587 glClearColor 0, 0, 0, 0; 2742 glClearColor 0, 0, 0, 0;
2588 glClear GL_COLOR_BUFFER_BIT; 2743 glClear GL_COLOR_BUFFER_BIT;
… …
2592 my $y0 = $top; 2747 my $y0 = $top;
2593 my $y1 = $top + $H; 2748 my $y1 = $top + $H;
2594 2749
2595 my $y = 0; 2750 my $y = 0;
2596 2751
2597 my $layout = $self->{layout};
2598
2599 $layout->set_font ($self->{font}) if $self->{font};
2600
2601 glEnable GL_BLEND;
2602 #TODO# not correct in windows where rgba is forced off
2603 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2604
2605 for my $par (@{$self->{par}}) { 2752 for my $para (@{$self->{par}}) {
2606 my $h = $par->[1]; 2753 my $h = $para->{h};
2607 2754
2608 if ($y0 < $y + $h && $y < $y1) { 2755 if ($y0 < $y + $h && $y < $y1) {
2609 $layout->set_foreground (@{ $par->[2] });
2610 $layout->set_width ($W - $par->[3]);
2611 $layout->set_markup ($par->[4]);
2612 2756
2613 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2757 my $layout = $self->get_layout ($para);
2614 2758
2615 glRasterPos $par->[3], $y - $y0; 2759 $layout->render ($para->{indent}, $y - $y0);
2616 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2760
2761 if (my @w = @{ $para->{widget} }) {
2762 my @s = $layout->get_shapes;
2763
2764 for (@w) {
2765 my ($dx, $dy) = splice @s, 0, 2, ();
2766
2767 $_->{x} = $dx + $para->{indent};
2768 $_->{y} = $dy + $y - $y0;
2769
2770 $_->draw;
2771 }
2772 }
2617 } 2773 }
2618 2774
2619 $y += $h; 2775 $y += $h;
2620 } 2776 }
2621
2622 glDisable GL_BLEND;
2623 }; 2777 };
2624 }); 2778 });
2779}
2780
2781sub reconfigure {
2782 my ($self) = @_;
2783
2784 $self->SUPER::reconfigure;
2785
2786 $_->{w} = 1e10 for @{ $self->{par} };
2787 $self->reflow;
2625} 2788}
2626 2789
2627sub _draw { 2790sub _draw {
2628 my ($self) = @_; 2791 my ($self) = @_;
2629 2792
… …
2632 glColor 0, 0, 0, 1; 2795 glColor 0, 0, 0, 1;
2633 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2796 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2634 glDisable GL_TEXTURE_2D; 2797 glDisable GL_TEXTURE_2D;
2635 2798
2636 $self->{children}[1]->draw; 2799 $self->{children}[1]->draw;
2637
2638} 2800}
2639 2801
2640############################################################################# 2802#############################################################################
2641 2803
2642package CFClient::UI::Animator; 2804package CFClient::UI::Animator;
… …
2729 $tooltip .= "\n\n" . (ref $widget) . "\n" 2891 $tooltip .= "\n\n" . (ref $widget) . "\n"
2730 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" 2892 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2731 . "req $widget->{req_w} $widget->{req_h}\n" 2893 . "req $widget->{req_w} $widget->{req_h}\n"
2732 . "visible $widget->{visible}"; 2894 . "visible $widget->{visible}";
2733 } 2895 }
2896
2897 $tooltip =~ s/^\n+//;
2898 $tooltip =~ s/\n+$//;
2734 2899
2735 $self->add (new CFClient::UI::Label 2900 $self->add (new CFClient::UI::Label
2736 markup => $tooltip, 2901 markup => $tooltip,
2737 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2902 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2738 fontsize => 0.8, 2903 fontsize => 0.8,
… …
2748 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 2913 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2749 2914
2750 ($w + 4, $h + 4) 2915 ($w + 4, $h + 4)
2751} 2916}
2752 2917
2753sub size_allocate { 2918sub invoke_size_allocate {
2754 my ($self, $w, $h) = @_; 2919 my ($self, $w, $h) = @_;
2755 2920
2756 $self->SUPER::size_allocate ($w - 4, $h - 4); 2921 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2757} 2922}
2758 2923
2759sub visibility_change { 2924sub invoke_visibility_change {
2760 my ($self, $visible) = @_; 2925 my ($self, $visible) = @_;
2761 2926
2762 return unless $visible; 2927 return unless $visible;
2763 2928
2764 $self->{root}->on_post_alloc ("move_$self" => sub { 2929 $self->{root}->on_post_alloc ("move_$self" => sub {
… …
2766 or return; 2931 or return;
2767 2932
2768 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 2933 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2769 2934
2770 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 2935 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2771 if $x + $self->{w} > $::WIDTH; 2936 if $x + $self->{w} > $self->{root}{w};
2772 2937
2773 $self->move_abs ($x, $y); 2938 $self->move_abs ($x, $y);
2774 }); 2939 });
2775} 2940}
2776 2941
… …
2871 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3036 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2872 glDisable GL_TEXTURE_2D; 3037 glDisable GL_TEXTURE_2D;
2873 } 3038 }
2874} 3039}
2875 3040
2876sub DESTROY { 3041sub destroy {
2877 my ($self) = @_; 3042 my ($self) = @_;
2878 3043
2879 $self->{timer}->cancel 3044 $self->{timer}->cancel
2880 if $self->{timer}; 3045 if $self->{timer};
2881 3046
2882 $self->SUPER::DESTROY; 3047 $self->SUPER::destroy;
2883} 3048}
2884 3049
2885############################################################################# 3050#############################################################################
2886 3051
2887package CFClient::UI::Buttonbar; 3052package CFClient::UI::Buttonbar;
… …
2908 ); 3073 );
2909 3074
2910 $self->add ($self->{vbox} = new CFClient::UI::VBox); 3075 $self->add ($self->{vbox} = new CFClient::UI::VBox);
2911 3076
2912 for my $item (@{ $self->{items} }) { 3077 for my $item (@{ $self->{items} }) {
2913 my ($widget, $cb) = @$item; 3078 my ($widget, $cb, $tooltip) = @$item;
2914 3079
2915 # handle various types of items, only text for now 3080 # handle various types of items, only text for now
2916 if (!ref $widget) { 3081 if (!ref $widget) {
3082 if ($widget =~ /\t/) {
3083 my ($left, $right) = split /\t/, $widget, 2;
3084
3085 $widget = new CFClient::UI::HBox
3086 can_hover => 1,
3087 can_events => 1,
3088 tooltip => $tooltip,
3089 children => [
3090 (new CFClient::UI::Label markup => $left, expand => 1),
3091 (new CFClient::UI::Label markup => $right, align => +1),
3092 ],
3093 ;
3094
3095 } else {
2917 $widget = new CFClient::UI::Label 3096 $widget = new CFClient::UI::Label
2918 can_hover => 1, 3097 can_hover => 1,
2919 can_events => 1, 3098 can_events => 1,
2920 text => $widget; 3099 markup => $widget,
3100 tooltip => $tooltip;
3101 }
2921 } 3102 }
2922 3103
2923 $self->{item}{$widget} = $item; 3104 $self->{item}{$widget} = $item;
2924 3105
2925 $self->{vbox}->add ($widget); 3106 $self->{vbox}->add ($widget);
… …
2930 3111
2931# popup given the event (must be a mouse button down event currently) 3112# popup given the event (must be a mouse button down event currently)
2932sub popup { 3113sub popup {
2933 my ($self, $ev) = @_; 3114 my ($self, $ev) = @_;
2934 3115
2935 $self->_emit ("popdown"); 3116 $self->emit ("popdown");
2936 3117
2937 # maybe save $GRAB? must be careful about events... 3118 # maybe save $GRAB? must be careful about events...
2938 $GRAB = $self; 3119 $GRAB = $self;
2939 $self->{button} = $ev->{button}; 3120 $self->{button} = $ev->{button};
2940 3121
2941 $self->show; 3122 $self->show;
2942 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 3123 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2943} 3124}
2944 3125
2945sub mouse_motion { 3126sub invoke_mouse_motion {
2946 my ($self, $ev, $x, $y) = @_; 3127 my ($self, $ev, $x, $y) = @_;
2947 3128
2948 # TODO: should use vbox->find_widget or so 3129 # TODO: should use vbox->find_widget or so
2949 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3130 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2950 $self->{hover} = $self->{item}{$HOVER}; 3131 $self->{hover} = $self->{item}{$HOVER};
2951 3132
2952 0 3133 0
2953} 3134}
2954 3135
2955sub button_up { 3136sub invoke_button_up {
2956 my ($self, $ev, $x, $y) = @_; 3137 my ($self, $ev, $x, $y) = @_;
2957 3138
2958 if ($ev->{button} == $self->{button}) { 3139 if ($ev->{button} == $self->{button}) {
2959 undef $GRAB; 3140 undef $GRAB;
2960 $self->hide; 3141 $self->hide;
2961 3142
2962 $self->_emit ("popdown"); 3143 $self->emit ("popdown");
2963 $self->{hover}[1]->() if $self->{hover}; 3144 $self->{hover}[1]->() if $self->{hover};
2964 } else { 3145 } else {
2965 return 0 3146 return 0
2966 } 3147 }
2967 3148
… …
2994 3175
2995 $self->{current} = $self->{children}[0] 3176 $self->{current} = $self->{children}[0]
2996 if @{ $self->{children} }; 3177 if @{ $self->{children} };
2997} 3178}
2998 3179
3180sub get_current_page {
3181 my ($self) = @_;
3182
3183 $self->{current}
3184}
3185
2999sub set_current_page { 3186sub set_current_page {
3000 my ($self, $page_or_widget) = @_; 3187 my ($self, $page_or_widget) = @_;
3001 3188
3002 my $widget = ref $page_or_widget 3189 my $widget = ref $page_or_widget
3003 ? $page_or_widget 3190 ? $page_or_widget
3004 : $self->{children}[$page_or_widget]; 3191 : $self->{children}[$page_or_widget];
3005 3192
3006 $self->{current} = $widget; 3193 $self->{current} = $widget;
3007 $self->{current}->configure (0, 0, $self->{w}, $self->{h}); 3194 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3008 3195
3009 $self->_emit (page_changed => $self->{current}); 3196 $self->emit (page_changed => $self->{current});
3010 3197
3011 $self->realloc; 3198 $self->realloc;
3012} 3199}
3013 3200
3014sub visible_children { 3201sub visible_children {
… …
3019 my ($self) = @_; 3206 my ($self) = @_;
3020 3207
3021 $self->{current}->size_request 3208 $self->{current}->size_request
3022} 3209}
3023 3210
3024sub size_allocate { 3211sub invoke_size_allocate {
3025 my ($self, $w, $h) = @_; 3212 my ($self, $w, $h) = @_;
3026 3213
3027 $self->{current}->configure (0, 0, $w, $h); 3214 $self->{current}->configure (0, 0, $w, $h);
3215
3216 1
3028} 3217}
3029 3218
3030sub _draw { 3219sub _draw {
3031 my ($self) = @_; 3220 my ($self) = @_;
3032 3221
… …
3067 ); 3256 );
3068 3257
3069 $self->{multiplexer}->add ($widget); 3258 $self->{multiplexer}->add ($widget);
3070} 3259}
3071 3260
3261sub get_current_page {
3262 my ($self) = @_;
3263
3264 $self->{multiplexer}->get_current_page
3265}
3266
3072sub set_current_page { 3267sub set_current_page {
3073 my ($self, $page) = @_; 3268 my ($self, $page) = @_;
3074 3269
3075 $self->{multiplexer}->set_current_page ($page); 3270 $self->{multiplexer}->set_current_page ($page);
3076 $self->_emit (page_changed => $self->{multiplexer}{current}); 3271 $self->emit (page_changed => $self->{multiplexer}{current});
3272}
3273
3274#############################################################################
3275
3276package CFClient::UI::Combobox;
3277
3278use utf8;
3279
3280our @ISA = CFClient::UI::Button::;
3281
3282sub new {
3283 my $class = shift;
3284
3285 my $self = $class->SUPER::new (
3286 options => [], # [value, title, longdesc], ...
3287 value => undef,
3288 @_,
3289 );
3290
3291 $self->_set_value ($self->{value});
3292
3293 $self
3294}
3295
3296sub invoke_button_down {
3297 my ($self, $ev) = @_;
3298
3299 my @menu_items;
3300
3301 for (@{ $self->{options} }) {
3302 my ($value, $title, $tooltip) = @$_;
3303
3304 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3305 }
3306
3307 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
3308}
3309
3310sub _set_value {
3311 my ($self, $value) = @_;
3312
3313 my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
3314 or return;
3315
3316 $self->{value} = $item->[0];
3317 $self->set_markup ("$item->[1] ⇓");
3318 $self->set_tooltip ($item->[2]);
3319}
3320
3321sub set_value {
3322 my ($self, $value) = @_;
3323
3324 return unless $self->{value} ne $value;
3325
3326 $self->_set_value ($value);
3327 $self->emit (changed => $value);
3077} 3328}
3078 3329
3079############################################################################# 3330#############################################################################
3080 3331
3081package CFClient::UI::Statusbox; 3332package CFClient::UI::Statusbox;
… …
3180 $item->{count}++; 3431 $item->{count}++;
3181 } else { 3432 } else {
3182 $item->{count} = 1; 3433 $item->{count} = 1;
3183 $item->{text} = $item->{tooltip} = $text; 3434 $item->{text} = $item->{tooltip} = $text;
3184 } 3435 }
3185 $item->{id} = ++$self->{id}; 3436 $item->{id} += 0.2;#d#
3186 $item->{timeout} = $timeout; 3437 $item->{timeout} = $timeout;
3187 delete $item->{label}; 3438 delete $item->{label};
3188 } else { 3439 } else {
3189 $self->{item}{$group} = { 3440 $self->{item}{$group} = {
3190 id => ++$self->{id}, 3441 id => ++$self->{id},
… …
3196 count => 1, 3447 count => 1,
3197 %arg, 3448 %arg,
3198 }; 3449 };
3199 } 3450 }
3200 3451
3452 $ROOT->on_refresh (reorder => sub {
3201 $self->reorder; 3453 $self->reorder;
3454 });
3202} 3455}
3203 3456
3204sub reconfigure { 3457sub reconfigure {
3205 my ($self) = @_; 3458 my ($self) = @_;
3206 3459
… …
3209 3462
3210 $self->reorder; 3463 $self->reorder;
3211 $self->SUPER::reconfigure; 3464 $self->SUPER::reconfigure;
3212} 3465}
3213 3466
3214sub DESTROY { 3467sub destroy {
3215 my ($self) = @_; 3468 my ($self) = @_;
3216 3469
3217 $self->{timer}->cancel; 3470 $self->{timer}->cancel;
3218 3471
3219 $self->SUPER::DESTROY; 3472 $self->SUPER::destroy;
3220} 3473}
3221 3474
3222############################################################################# 3475#############################################################################
3223 3476
3224package CFClient::UI::Inventory; 3477package CFClient::UI::Inventory;
3225 3478
3226our @ISA = CFClient::UI::ScrolledWindow::; 3479our @ISA = CFClient::UI::Table::;
3227 3480
3228sub new { 3481sub new {
3229 my $class = shift; 3482 my $class = shift;
3230 3483
3231 my $self = $class->SUPER::new ( 3484 my $self = $class->SUPER::new (
3232 child => (new CFClient::UI::Table col_expand => [0, 1, 0]), 3485 col_expand => [0, 1, 0],
3233 @_, 3486 @_,
3234 ); 3487 );
3235 3488
3236 $self 3489 $self
3237} 3490}
3238 3491
3239sub set_items { 3492sub set_items {
3240 my ($self, $items) = @_; 3493 my ($self, $items) = @_;
3241 3494
3242 $self->{child}->clear; 3495 $self->clear;
3243 return unless $items; 3496 return unless $items;
3244 3497
3245 my @items = sort { 3498 my @items = sort {
3246 ($a->{type} <=> $b->{type}) 3499 ($a->{type} <=> $b->{type})
3247 or ($a->{name} cmp $b->{name}) 3500 or ($a->{name} cmp $b->{name})
3248 } @$items; 3501 } values %$items;
3249 3502
3250 $self->{real_items} = \@items; 3503 $self->{real_items} = \@items;
3251 3504
3252 my $row = 0; 3505 my $row = 0;
3253 for my $item (@items) { 3506 for my $item (@items) {
3254 CFClient::Item::update_widgets $item; 3507 CFClient::Item::update_widgets $item;
3255 3508
3256 $self->{child}->add (0, $row, $item->{face_widget}); 3509 $self->add (0, $row, $item->{face_widget});
3257 $self->{child}->add (1, $row, $item->{desc_widget}); 3510 $self->add (1, $row, $item->{desc_widget});
3258 $self->{child}->add (2, $row, $item->{weight_widget}); 3511 $self->add (2, $row, $item->{weight_widget});
3259 3512
3260 $row++; 3513 $row++;
3261 }
3262}
3263
3264#############################################################################
3265
3266package CFClient::UI::BindEditor;
3267
3268our @ISA = CFClient::UI::FancyFrame::;
3269
3270sub new {
3271 my $class = shift;
3272
3273 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3274
3275 $self->add (my $vb = new CFClient::UI::VBox);
3276
3277
3278 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3279 text => "start recording",
3280 tooltip => "Start/Stops recording of actions."
3281 ."All subsequent actions after the recording started will be captured."
3282 ."The actions are displayed after the record was stopped."
3283 ."To bind the action you have to click on the 'Bind' button",
3284 on_activate => sub {
3285 unless ($self->{recording}) {
3286 $self->start;
3287 } else {
3288 $self->stop;
3289 }
3290 });
3291
3292 $vb->add (new CFClient::UI::Label text => "Actions:");
3293 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3294
3295 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3296 $vb->add (my $hb = new CFClient::UI::HBox);
3297 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3298 $hb->add (new CFClient::UI::Button
3299 text => "bind",
3300 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3301 on_activate => sub {
3302 $self->ask_for_bind;
3303 });
3304
3305 $vb->add (my $hb = new CFClient::UI::HBox);
3306 $hb->add (new CFClient::UI::Button
3307 text => "ok",
3308 expand => 1,
3309 tooltip => "This closes the binding editor and saves the binding",
3310 on_activate => sub {
3311 $self->hide;
3312 $self->commit;
3313 });
3314
3315 $hb->add (new CFClient::UI::Button
3316 text => "cancel",
3317 expand => 1,
3318 tooltip => "This closes the binding editor without saving",
3319 on_activate => sub {
3320 $self->hide;
3321 $self->{binding_cancel}->()
3322 if $self->{binding_cancel};
3323 });
3324
3325 $self->update_binding_widgets;
3326
3327 $self
3328}
3329
3330sub commit {
3331 my ($self) = @_;
3332 my ($mod, $sym, $cmds) = $self->get_binding;
3333 if ($sym != 0 && @$cmds > 0) {
3334 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3335 ."'. Don't forget 'Save Config'!");
3336 $self->{binding_change}->($mod, $sym, $cmds)
3337 if $self->{binding_change};
3338 } else {
3339 $::STATUSBOX->add ("No action bound, no key or action specified!");
3340 $self->{binding_cancel}->()
3341 if $self->{binding_cancel};
3342 }
3343}
3344
3345sub start {
3346 my ($self) = @_;
3347
3348 $self->{rec_btn}->set_text ("stop recording");
3349 $self->{recording} = 1;
3350 $self->clear_command_list;
3351 $::CONN->start_record if $::CONN;
3352}
3353
3354sub stop {
3355 my ($self) = @_;
3356
3357 $self->{rec_btn}->set_text ("start recording");
3358 $self->{recording} = 0;
3359
3360 my $rec;
3361 $rec = $::CONN->stop_record if $::CONN;
3362 return unless ref $rec eq 'ARRAY';
3363 $self->set_command_list ($rec);
3364}
3365
3366
3367sub ask_for_bind_and_commit {
3368 my ($self) = @_;
3369 $self->ask_for_bind (1);
3370}
3371
3372sub ask_for_bind {
3373 my ($self, $commit) = @_;
3374
3375 CFClient::Binder::open_binding_dialog (sub {
3376 my ($mod, $sym) = @_;
3377 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3378 $self->update_binding_widgets;
3379 $self->commit if $commit;
3380 });
3381}
3382
3383# $mod and $sym are the modifiers and key symbol
3384# $cmds is a array ref of strings (the commands)
3385# $cb is the callback that is executed on OK
3386# $ccb is the callback that is executed on CANCEL and
3387# when the binding was unsuccessful on OK
3388sub set_binding {
3389 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3390
3391 $self->clear_command_list;
3392 $self->{recording} = 0;
3393 $self->{rec_btn}->set_text ("start recording");
3394
3395 $self->{binding} = [$mod, $sym];
3396 $self->{commands} = $cmds;
3397
3398 $self->{binding_change} = $cb;
3399 $self->{binding_cancel} = $ccb;
3400
3401 $self->update_binding_widgets;
3402}
3403
3404# this is a shortcut method that asks for a binding
3405# and then just binds it.
3406sub do_quick_binding {
3407 my ($self, $cmds) = @_;
3408 $self->set_binding (undef, undef, $cmds, sub {
3409 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3410 });
3411 $self->ask_for_bind (1);
3412}
3413
3414sub update_binding_widgets {
3415 my ($self) = @_;
3416 my ($mod, $sym, $cmds) = $self->get_binding;
3417 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3418 $self->set_command_list ($cmds);
3419}
3420
3421sub get_binding {
3422 my ($self) = @_;
3423 return (
3424 $self->{binding}->[0],
3425 $self->{binding}->[1],
3426 [ grep { defined $_ } @{$self->{commands}} ]
3427 );
3428}
3429
3430sub clear_command_list {
3431 my ($self) = @_;
3432 $self->{cmdbox}->clear ();
3433}
3434
3435sub set_command_list {
3436 my ($self, $cmds) = @_;
3437
3438 $self->{cmdbox}->clear ();
3439 $self->{commands} = $cmds;
3440
3441 my $idx = 0;
3442
3443 for (@$cmds) {
3444 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3445
3446 my $i = $idx;
3447 $hb->add (new CFClient::UI::Label text => $_);
3448 $hb->add (new CFClient::UI::Button
3449 text => "delete",
3450 tooltip => "Deletes the action from the record",
3451 on_activate => sub {
3452 $self->{cmdbox}->remove ($hb);
3453 $cmds->[$i] = undef;
3454 });
3455
3456
3457 $idx++
3458 } 3514 }
3459} 3515}
3460 3516
3461############################################################################# 3517#############################################################################
3462 3518
… …
3472 commands => [], 3528 commands => [],
3473 @_, 3529 @_,
3474 ) 3530 )
3475} 3531}
3476 3532
3477# XXX: Do sorting? Argl... 3533my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
3534
3535my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3536 "<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
3537my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3538 "<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
3539my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3540 "<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
3541my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3542 "<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
3543my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3544 "<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
3545
3546sub rebuild_spell_list {
3547 my ($self) = @_;
3548
3549 $CFClient::UI::ROOT->on_refresh ($self => sub {
3550 $self->clear;
3551
3552 return unless $::CONN;
3553
3554 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3555 $self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3556 $self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3557 $self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3558 $self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3559
3560 my $row = 0;
3561
3562 for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3563 my $spell = $self->{spell}{$_};
3564
3565 $row++;
3566
3567 my $spell_cb = sub {
3568 my ($widget, $ev) = @_;
3569
3570 if ($ev->{button} == 1) {
3571 $::CONN->user_send ("cast $spell->{name}");
3572 } elsif ($ev->{button} == 2) {
3573 $::CONN->user_send ("invoke $spell->{name}");
3574 } elsif ($ev->{button} == 3) {
3575 (new CFClient::UI::Menu
3576 items => [
3577 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3578 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3579 ],
3580 )->popup ($ev);
3581 } else {
3582 return 0;
3583 }
3584
3585 1
3586 };
3587
3588 my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3589
3590 #TODO: add path info to tooltip
3591 #$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
3592
3593 $self->add (0, $row, new CFClient::UI::Face
3594 face => $spell->{face},
3595 can_hover => 1,
3596 can_events => 1,
3597 tooltip => $tooltip,
3598 on_button_down => $spell_cb,
3599 );
3600
3601 $self->add (1, $row, new CFClient::UI::Label
3602 expand => 1,
3603 text => $spell->{name},
3604 can_hover => 1,
3605 can_events => 1,
3606 tooltip => $tooltip,
3607 on_button_down => $spell_cb,
3608 );
3609
3610 $self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3611 $self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3612 $self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3613 $self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3614 }
3615 });
3616}
3617
3478sub add_spell { 3618sub add_spell {
3479 my ($self, $spell) = @_; 3619 my ($self, $spell) = @_;
3620
3480 $self->{spells}->{$spell->{name}} = $spell; 3621 $self->{spell}->{$spell->{name}} = $spell;
3481 3622 $self->rebuild_spell_list;
3482 $self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3483 face => $spell->{face},
3484 can_hover => 1,
3485 can_events => 1,
3486 tooltip => $spell->{message});
3487
3488 $self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3489 text => $spell->{name},
3490 can_hover => 1,
3491 can_events => 1,
3492 tooltip => $spell->{message},
3493 expand => 1);
3494
3495 $self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3496 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3497 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3498 expand => 1);
3499
3500 $self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3501 text => "bind to key",
3502 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3503}
3504
3505sub rebuild_spell_list {
3506 my ($self) = @_;
3507 $self->{tbl_idx} = 0;
3508 $self->add_spell ($_) for values %{$self->{spells}};
3509} 3623}
3510 3624
3511sub remove_spell { 3625sub remove_spell {
3512 my ($self, $spell) = @_; 3626 my ($self, $spell) = @_;
3627
3513 delete $self->{spells}->{$spell->{name}}; 3628 delete $self->{spell}->{$spell->{name}};
3629 $self->rebuild_spell_list;
3630}
3631
3632sub clear_spells {
3633 my ($self) = @_;
3634
3635 $self->{spell} = {};
3514 $self->rebuild_spell_list; 3636 $self->rebuild_spell_list;
3515} 3637}
3516 3638
3517############################################################################# 3639#############################################################################
3518 3640
… …
3555 $coord = $max - $size if $coord > $max - $size; 3677 $coord = $max - $size if $coord > $max - $size;
3556 3678
3557 int $coord + 0.5 3679 int $coord + 0.5
3558} 3680}
3559 3681
3560sub size_allocate { 3682sub invoke_size_allocate {
3561 my ($self, $w, $h) = @_; 3683 my ($self, $w, $h) = @_;
3562 3684
3563 for my $child ($self->children) { 3685 for my $child ($self->children) {
3564 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3686 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3565 3687
… …
3569 $X = _to_pixel $X, $W, $self->{w}; 3691 $X = _to_pixel $X, $W, $self->{w};
3570 $Y = _to_pixel $Y, $H, $self->{h}; 3692 $Y = _to_pixel $Y, $H, $self->{h};
3571 3693
3572 $child->configure ($X, $Y, $W, $H); 3694 $child->configure ($X, $Y, $W, $H);
3573 } 3695 }
3696
3697 1
3574} 3698}
3575 3699
3576sub coord2local { 3700sub coord2local {
3577 my ($self, $x, $y) = @_; 3701 my ($self, $x, $y) = @_;
3578 3702
… …
3704 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 3828 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3705 3829
3706 $w = 0 if $w < 0; 3830 $w = 0 if $w < 0;
3707 $h = 0 if $h < 0; 3831 $h = 0 if $h < 0;
3708 3832
3833 $w = max $widget->{min_w}, $w;
3834 $h = max $widget->{min_h}, $h;
3835
3836 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3837 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3838
3709 $w = int $w + 0.5; 3839 $w = int $w + 0.5;
3710 $h = int $h + 0.5; 3840 $h = int $h + 0.5;
3711 3841
3712 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 3842 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3713 $widget->{old_w} = $widget->{w}; 3843 $widget->{old_w} = $widget->{w};

Diff Legend

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