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.302 by root, Mon Jun 12 13:26:14 2006 UTC vs.
Revision 1.334 by root, Sun Jul 23 16:11:12 2006 UTC

… …
79sub feed_sdl_key_up_event { 79sub feed_sdl_key_up_event {
80 $FOCUS->emit (key_up => $_[0]) 80 $FOCUS->emit (key_up => $_[0])
81 if $FOCUS; 81 if $FOCUS;
82} 82}
83 83
84sub check_hover {
85 my ($widget) = @_;
86
87 if ($widget != $HOVER) {
88 my $hover = $HOVER; $HOVER = $widget;
89
90 $hover->update if $hover && $hover->{can_hover};
91 $HOVER->update if $HOVER && $HOVER->{can_hover};
92
93 $TOOLTIP_WATCHER->start;
94 }
95}
96
84sub feed_sdl_button_down_event { 97sub feed_sdl_button_down_event {
85 my ($ev) = @_; 98 my ($ev) = @_;
86 my ($x, $y) = ($ev->{x}, $ev->{y}); 99 my ($x, $y) = ($ev->{x}, $ev->{y});
87 100
88 if (!$BUTTON_STATE) { 101 unless ($BUTTON_STATE) {
89 my $widget = $ROOT->find_widget ($x, $y); 102 my $widget = $ROOT->find_widget ($x, $y);
90 103
91 $GRAB = $widget; 104 $GRAB = $widget;
92 $GRAB->update if $GRAB; 105 $GRAB->update if $GRAB;
93 106
94 $TOOLTIP_WATCHER->cb->(); 107 $TOOLTIP_WATCHER->cb->();
95 } 108 }
96 109
97 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 110 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
98 111
99 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y)) 112 if ($GRAB) {
100 if $GRAB; 113 if ($ev->{button} == 4 || $ev->{button} == 5) {
114 # mousewheel
115 $ev->{dx} = 0;
116 $ev->{dy} = $ev->{button} * 2 - 9;
117 $GRAB->emit (mouse_wheel => $ev);
118 } else {
119 $GRAB->emit (button_down => $ev)
120 }
121 }
101} 122}
102 123
103sub feed_sdl_button_up_event { 124sub feed_sdl_button_up_event {
104 my ($ev) = @_; 125 my ($ev) = @_;
105 my ($x, $y) = ($ev->{x}, $ev->{y});
106 126
107 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 127 my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108 128
109 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 129 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110 130
111 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y)) 131 $GRAB->emit (button_up => $ev)
112 if $GRAB; 132 if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113 133
114 if (!$BUTTON_STATE) { 134 unless ($BUTTON_STATE) {
115 my $grab = $GRAB; undef $GRAB; 135 my $grab = $GRAB; undef $GRAB;
116 $grab->update if $grab; 136 $grab->update if $grab;
117 $GRAB->update if $GRAB; 137 $GRAB->update if $GRAB;
118 138
139 check_hover $widget;
119 $TOOLTIP_WATCHER->cb->(); 140 $TOOLTIP_WATCHER->cb->();
120 } 141 }
121} 142}
122 143
123sub feed_sdl_motion_event { 144sub feed_sdl_motion_event {
124 my ($ev) = @_; 145 my ($ev) = @_;
125 my ($x, $y) = ($ev->{x}, $ev->{y}); 146 my ($x, $y) = ($ev->{x}, $ev->{y});
126 147
127 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 148 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128 149
129 if ($widget != $HOVER) { 150 check_hover $widget;
130 my $hover = $HOVER; $HOVER = $widget;
131 151
132 $hover->update if $hover && $hover->{can_hover}; 152 $HOVER->emit (mouse_motion => $ev)
133 $HOVER->update if $HOVER && $HOVER->{can_hover};
134
135 $TOOLTIP_WATCHER->start;
136 }
137
138 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
139 if $HOVER; 153 if $HOVER;
140} 154}
141 155
142# convert position array to integers 156# convert position array to integers
143sub harmonize { 157sub harmonize {
… …
189 203
190 } 204 }
191 } 205 }
192 206
193 reconfigure_widgets; 207 reconfigure_widgets;
208}
209
210#############################################################################
211
212package CFClient::UI::Event;
213
214sub xy {
215 $_[1]->coord2local ($_[0]{x}, $_[0]{y})
194} 216}
195 217
196############################################################################# 218#############################################################################
197 219
198package CFClient::UI::Base; 220package CFClient::UI::Base;
… …
281 undef $HOVER if $HOVER == $self; 303 undef $HOVER if $HOVER == $self;
282 304
283 $CFClient::UI::TOOLTIP_WATCHER->cb->() 305 $CFClient::UI::TOOLTIP_WATCHER->cb->()
284 if $TOOLTIP->{owner} == $self; 306 if $TOOLTIP->{owner} == $self;
285 307
286 $self->focus_out; 308 $self->emit ("focus_out");
287
288 $self->emit (visibility_change => 0); 309 $self->emit (visibility_change => 0);
289} 310}
290 311
291sub set_visibility { 312sub set_visibility {
292 my ($self, $visible) = @_; 313 my ($self, $visible) = @_;
… …
334} 355}
335 356
336sub size_request { 357sub size_request {
337 require Carp; 358 require Carp;
338 Carp::confess "size_request is abstract"; 359 Carp::confess "size_request is abstract";
360}
361
362sub baseline_shift {
363 0
339} 364}
340 365
341sub configure { 366sub configure {
342 my ($self, $x, $y, $w, $h) = @_; 367 my ($self, $x, $y, $w, $h) = @_;
343 368
… …
367 392
368 $self->{root}{size_alloc}{$self+0} = $self; 393 $self->{root}{size_alloc}{$self+0} = $self;
369 } 394 }
370} 395}
371 396
372sub size_allocate {
373 # nothing to be done
374}
375
376sub children { 397sub children {
377 # nop 398 # nop
378} 399}
379 400
380sub visible_children { 401sub visible_children {
… …
408 429
409# translate global coordinates to local coordinate system 430# translate global coordinates to local coordinate system
410sub coord2local { 431sub coord2local {
411 my ($self, $x, $y) = @_; 432 my ($self, $x, $y) = @_;
412 433
434 Carp::confess unless $self->{parent};#d#
435
413 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) 436 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
414} 437}
415 438
416# translate local coordinates to global coordinate system 439# translate local coordinates to global coordinate system
417sub coord2global { 440sub coord2global {
418 my ($self, $x, $y) = @_; 441 my ($self, $x, $y) = @_;
419 442
443 Carp::confess unless $self->{parent};#d#
444
420 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 445 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421} 446}
422 447
423sub focus_in { 448sub invoke_focus_in {
424 my ($self) = @_; 449 my ($self) = @_;
425 450
426 return if $FOCUS == $self; 451 return if $FOCUS == $self;
427 return unless $self->{can_focus}; 452 return unless $self->{can_focus};
428 453
429 my $focus = $FOCUS; $FOCUS = $self; 454 $FOCUS = $self;
430 455
431 $self->_emit (focus_in => $focus); 456 $self->update;
432 457
433 $focus->update if $focus; 458 0
434 $FOCUS->update;
435} 459}
436 460
437sub focus_out { 461sub invoke_focus_out {
438 my ($self) = @_; 462 my ($self) = @_;
439 463
440 return unless $FOCUS == $self; 464 return unless $FOCUS == $self;
441 465
442 my $focus = $FOCUS; undef $FOCUS; 466 undef $FOCUS;
443 467
444 $self->_emit (focus_out => $focus); 468 $self->update;
445 469
446 $focus->update if $focus; #?
447
448 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus 470 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449 unless $FOCUS; 471 unless $FOCUS;
450}
451 472
473 0
474}
475
476sub grab_focus {
477 my ($self) = @_;
478
479 $FOCUS->emit ("focus_out") if $FOCUS;
480 $self->emit ("focus_in");
481}
482
452sub mouse_motion { 0 } 483sub invoke_mouse_motion { 0 }
453sub button_up { 0 } 484sub invoke_button_up { 0 }
454sub key_down { 0 } 485sub invoke_key_down { 0 }
455sub key_up { 0 } 486sub invoke_key_up { 0 }
487sub invoke_mouse_wheel { 0 }
456 488
457sub button_down { 489sub invoke_button_down {
458 my ($self, $ev, $x, $y) = @_; 490 my ($self, $ev, $x, $y) = @_;
459 491
460 $self->focus_in; 492 $self->grab_focus;
461 493
462 0 494 0
495}
496
497sub connect {
498 my ($self, $signal, $cb) = @_;
499
500 push @{ $self->{signal_cb}{$signal} }, $cb;
501
502 defined wantarray and CFClient::guard {
503 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
504 @{ $self->{signal_cb}{$signal} };
505 }
506}
507
508my %has_coords = (
509 button_down => 1,
510 button_up => 1,
511 mouse_motion => 1,
512 mouse_wheel => 1,
513);
514
515sub emit {
516 my ($self, $signal, @args) = @_;
517
518 # I do not really like this solution, but I dislike duplication
519 # and needlessly verbose code, too.
520 my @append
521 = $has_coords{$signal}
522 ? $args[0]->xy ($self)
523 : ();
524
525 #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
526
527 #d##TODO# stop propagating at first true, do not use sum
528 (List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
529 || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append) # closure
530 || ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
463} 531}
464 532
465sub find_widget { 533sub find_widget {
466 my ($self, $x, $y) = @_; 534 my ($self, $x, $y) = @_;
467 535
… …
477sub set_parent { 545sub set_parent {
478 my ($self, $parent) = @_; 546 my ($self, $parent) = @_;
479 547
480 Scalar::Util::weaken ($self->{parent} = $parent); 548 Scalar::Util::weaken ($self->{parent} = $parent);
481 $self->set_visible if $parent->{visible}; 549 $self->set_visible if $parent->{visible};
482}
483
484sub connect {
485 my ($self, $signal, $cb) = @_;
486
487 push @{ $self->{signal_cb}{$signal} }, $cb;
488}
489
490sub _emit {
491 my ($self, $signal, @args) = @_;
492
493 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
494}
495
496sub emit {
497 my ($self, $signal, @args) = @_;
498
499 $self->_emit ($signal, @args)
500 || $self->$signal (@args);
501}
502
503sub visibility_change {
504 #my ($self, $visible) = @_;
505} 550}
506 551
507sub realloc { 552sub realloc {
508 my ($self) = @_; 553 my ($self) = @_;
509 554
… …
542 return unless $self->{h} && $self->{w}; 587 return unless $self->{h} && $self->{w};
543 588
544 # update screen rectangle 589 # update screen rectangle
545 local $draw_x = $draw_x + $self->{x}; 590 local $draw_x = $draw_x + $self->{x};
546 local $draw_y = $draw_y + $self->{y}; 591 local $draw_y = $draw_y + $self->{y};
547 local $draw_w = $draw_x + $self->{w};
548 local $draw_h = $draw_y + $self->{h};
549 592
550 # skip widgets that are entirely outside the drawing area 593 # skip widgets that are entirely outside the drawing area
551 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w) 594 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h); 595 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
553 596
… …
592} 635}
593 636
594sub DESTROY { 637sub DESTROY {
595 my ($self) = @_; 638 my ($self) = @_;
596 639
640 return if CFClient::in_destruct;
641
597 delete $WIDGET{$self+0}; 642 delete $WIDGET{$self+0};
598 643
599 eval { $self->destroy }; 644 eval { $self->destroy };
600 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/; 645 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
601} 646}
… …
686 if $children; 731 if $children;
687 732
688 $self 733 $self
689} 734}
690 735
736sub realloc {
737 my ($self) = @_;
738
739 $self->{force_realloc} = 1;
740 $self->{force_size_alloc} = 1;
741 $self->SUPER::realloc;
742}
743
691sub add { 744sub add {
692 my ($self, @widgets) = @_; 745 my ($self, @widgets) = @_;
693 746
694 $_->set_parent ($self) 747 $_->set_parent ($self)
695 for @widgets; 748 for @widgets;
… …
789 842
790sub size_request { 843sub size_request {
791 $_[0]{children}[0]->size_request 844 $_[0]{children}[0]->size_request
792} 845}
793 846
794sub size_allocate { 847sub invoke_size_allocate {
795 my ($self, $w, $h) = @_; 848 my ($self, $w, $h) = @_;
796 849
797 $self->{children}[0]->configure (0, 0, $w, $h); 850 $self->{children}[0]->configure (0, 0, $w, $h);
851
852 1
798} 853}
799 854
800############################################################################# 855#############################################################################
801 856
802# back-buffered drawing area 857# back-buffered drawing area
… …
818 873
819 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 874 $ROOT->on_post_alloc ($self => sub { $self->render_child });
820 $self->SUPER::update; 875 $self->SUPER::update;
821} 876}
822 877
823sub size_allocate { 878sub invoke_size_allocate {
824 my ($self, $w, $h) = @_; 879 my ($self, $w, $h) = @_;
825 880
826 $self->SUPER::size_allocate ($w, $h);
827 $self->update; 881 $self->update;
882
883 $self->SUPER::invoke_size_allocate ($w, $h)
828} 884}
829 885
830sub _render { 886sub _render {
831 my ($self) = @_; 887 my ($self) = @_;
832 888
… …
893 $h = 10 if $self->{scroll_y}; 949 $h = 10 if $self->{scroll_y};
894 950
895 ($w, $h) 951 ($w, $h)
896} 952}
897 953
898sub size_allocate { 954sub invoke_size_allocate {
899 my ($self, $w, $h) = @_; 955 my ($self, $w, $h) = @_;
900 956
901 my $child = $self->child; 957 my $child = $self->child;
902 958
903 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w}; 959 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
904 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h}; 960 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
905 961
906 $self->child->configure (0, 0, $w, $h); 962 $self->child->configure (0, 0, $w, $h);
907 $self->update; 963 $self->update;
964
965 1
908} 966}
909 967
910sub set_offset { 968sub set_offset {
911 my ($self, $x, $y) = @_; 969 my ($self, $x, $y) = @_;
912 970
… …
975 $self->{vp}->set_offset (0, $_[1]); 1033 $self->{vp}->set_offset (0, $_[1]);
976 }, 1034 },
977 ; 1035 ;
978 1036
979 $self = $class->SUPER::new ( 1037 $self = $class->SUPER::new (
980 vp => (new CFClient::UI::ViewPort expand => 1), 1038 vp => (new CFClient::UI::ViewPort expand => 1),
1039 can_events => 1,
981 slider => $slider, 1040 slider => $slider,
982 %arg, 1041 %arg,
983 ); 1042 );
984 1043
985 $self->SUPER::add ($self->{vp}, $self->{slider}); 1044 $self->SUPER::add ($self->{vp}, $self->{slider});
986 $self->add ($child) if $child; 1045 $self->add ($child) if $child;
987 1046
988 $self 1047 $self
989} 1048}
990 1049
1050#TODO# update range on size_allocate depending on child
1051
991sub add { 1052sub add {
992 my ($self, $widget) = @_; 1053 my ($self, $widget) = @_;
993 1054
994 $self->{vp}->add ($self->{child} = $widget); 1055 $self->{vp}->add ($self->{child} = $widget);
995} 1056}
996 1057
1058sub invoke_mouse_wheel {
1059 my ($self, $ev) = @_;
1060
1061 return 0 unless $ev->{dy}; # only vertical movements
1062
1063 $self->{slider}->emit (mouse_wheel => $ev);
1064
1065 1
1066}
1067
1068sub update_slider {
1069 my ($self) = @_;
1070
1071 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
1072}
1073
997sub update { 1074sub update {
998 my ($self) = @_; 1075 my ($self) = @_;
999 1076
1000 $self->SUPER::update; 1077 $self->SUPER::update;
1001 1078
1002 # todo: overwrite size_allocate of child 1079 $self->update_slider;
1003 my $child = $self->{vp}->child;
1004 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1005} 1080}
1006 1081
1007sub size_allocate { 1082sub invoke_size_allocate {
1008 my ($self, $w, $h) = @_; 1083 my ($self, $w, $h) = @_;
1009 1084
1085 $self->update_slider;
1086
1010 $self->SUPER::size_allocate ($w, $h); 1087 $self->SUPER::invoke_size_allocate ($w, $h)
1011
1012 my $child = $self->{vp}->child;
1013 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1014} 1088}
1015
1016#TODO# update range on size_allocate depending on child
1017# update viewport offset on scroll
1018 1089
1019############################################################################# 1090#############################################################################
1020 1091
1021package CFClient::UI::Frame; 1092package CFClient::UI::Frame;
1022 1093
… …
1078 my $self = $class->SUPER::new ( 1149 my $self = $class->SUPER::new (
1079 bg => [1, 1, 1, 1], 1150 bg => [1, 1, 1, 1],
1080 border_bg => [1, 1, 1, 1], 1151 border_bg => [1, 1, 1, 1],
1081 border => 0.6, 1152 border => 0.6,
1082 can_events => 1, 1153 can_events => 1,
1083 min_w => 16, 1154 min_w => 64,
1084 min_h => 16, 1155 min_h => 32,
1085 %arg, 1156 %arg,
1086 ); 1157 );
1087 1158
1088 $self->{title_widget} = new CFClient::UI::Label 1159 $self->{title_widget} = new CFClient::UI::Label
1089 align => 0, 1160 align => 0,
1090 valign => 1, 1161 valign => 1,
1091 text => $self->{title}, 1162 text => $self->{title},
1092 fontsize => $self->{border}, 1163 fontsize => $self->{border},
1093 if exists $self->{title}; 1164 if exists $self->{title};
1094 1165
1166 if ($self->{has_close_button}) {
1167 $self->{close_button} =
1168 new CFClient::UI::ImageButton
1169 path => 'x1_close.png',
1170 on_activate => sub { $self->emit ("delete") };
1171
1172 $self->CFClient::UI::Container::add ($self->{close_button});
1173 }
1174
1095 $self 1175 $self
1096} 1176}
1097 1177
1098sub add { 1178sub add {
1099 my ($self, @widgets) = @_; 1179 my ($self, @widgets) = @_;
1100 1180
1101 $self->SUPER::add (@widgets); 1181 $self->SUPER::add (@widgets);
1182 $self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1102 $self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget}; 1183 $self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1103} 1184}
1104 1185
1105sub border { 1186sub border {
1106 int $_[0]{border} * $::FONTSIZE 1187 int $_[0]{border} * $::FONTSIZE
… …
1109sub size_request { 1190sub size_request {
1110 my ($self) = @_; 1191 my ($self) = @_;
1111 1192
1112 $self->{title_widget}->size_request 1193 $self->{title_widget}->size_request
1113 if $self->{title_widget}; 1194 if $self->{title_widget};
1195
1196 $self->{close_button}->size_request
1197 if $self->{close_button};
1114 1198
1115 my ($w, $h) = $self->SUPER::size_request; 1199 my ($w, $h) = $self->SUPER::size_request;
1116 1200
1117 ( 1201 (
1118 $w + $self->border * 2, 1202 $w + $self->border * 2,
1119 $h + $self->border * 2, 1203 $h + $self->border * 2,
1120 ) 1204 )
1121} 1205}
1122 1206
1123sub size_allocate { 1207sub invoke_size_allocate {
1124 my ($self, $w, $h) = @_; 1208 my ($self, $w, $h) = @_;
1125 1209
1126 if ($self->{title_widget}) { 1210 if ($self->{title_widget}) {
1127 $self->{title_widget}{w} = $w; 1211 $self->{title_widget}{w} = $w;
1128 $self->{title_widget}{h} = $h; 1212 $self->{title_widget}{h} = $h;
1129 $self->{title_widget}->size_allocate ($w, $h); 1213 $self->{title_widget}->invoke_size_allocate ($w, $h);
1130 } 1214 }
1131 1215
1132 my $border = $self->border; 1216 my $border = $self->border;
1133 1217
1134 $h -= List::Util::max 0, $border * 2; 1218 $h -= List::Util::max 0, $border * 2;
1135 $w -= List::Util::max 0, $border * 2; 1219 $w -= List::Util::max 0, $border * 2;
1220
1221 $self->child->configure ($border, $border, $w, $h);
1222
1223 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1224 if $self->{close_button};
1225
1226 1
1227}
1228
1229sub invoke_delete {
1230 my ($self) = @_;
1231
1232 $self->hide;
1136 1233
1137 $self->child->configure ($border, $border, $w, $h); 1234 1
1138} 1235}
1139 1236
1140sub button_down { 1237sub invoke_button_down {
1141 my ($self, $ev, $x, $y) = @_; 1238 my ($self, $ev, $x, $y) = @_;
1142 1239
1143 my ($w, $h) = @$self{qw(w h)}; 1240 my ($w, $h) = @$self{qw(w h)};
1144 my $border = $self->border; 1241 my $border = $self->border;
1145 1242
… …
1176 1273
1177 ($x, $y) = ($ev->{x}, $ev->{y}); 1274 ($x, $y) = ($ev->{x}, $ev->{y});
1178 1275
1179 $self->move_abs ($bx + $x - $ox, $by + $y - $oy); 1276 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1180 # HACK: the next line is required to enforce placement 1277 # HACK: the next line is required to enforce placement
1181 $self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h}); 1278 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1182 }; 1279 };
1183 } else { 1280 } else {
1184 return 0; 1281 return 0;
1185 } 1282 }
1186 1283
1187 1 1284 1
1188} 1285}
1189 1286
1190sub button_up { 1287sub invoke_button_up {
1191 my ($self, $ev, $x, $y) = @_; 1288 my ($self, $ev, $x, $y) = @_;
1192 1289
1193 !!delete $self->{motion} 1290 ! ! delete $self->{motion}
1194} 1291}
1195 1292
1196sub mouse_motion { 1293sub invoke_mouse_motion {
1197 my ($self, $ev, $x, $y) = @_; 1294 my ($self, $ev, $x, $y) = @_;
1198 1295
1199 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1296 $self->{motion}->($ev, $x, $y) if $self->{motion};
1200 1297
1201 !!$self->{motion} 1298 ! ! $self->{motion}
1202} 1299}
1203 1300
1204sub _draw { 1301sub _draw {
1205 my ($self) = @_; 1302 my ($self) = @_;
1206 1303
… …
1235 $child->draw; 1332 $child->draw;
1236 1333
1237 if ($self->{title_widget}) { 1334 if ($self->{title_widget}) {
1238 glTranslate 0, $border - $self->{h}; 1335 glTranslate 0, $border - $self->{h};
1239 $self->{title_widget}->_draw; 1336 $self->{title_widget}->_draw;
1337
1338 glTranslate 0, - ($border - $self->{h});
1240 } 1339 }
1340
1341 $self->{close_button}->draw
1342 if $self->{close_button};
1241} 1343}
1242 1344
1243############################################################################# 1345#############################################################################
1244 1346
1245package CFClient::UI::Table; 1347package CFClient::UI::Table;
… …
1262sub children { 1364sub children {
1263 grep $_, map @$_, grep $_, @{ $_[0]{children} } 1365 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1264} 1366}
1265 1367
1266sub add { 1368sub add {
1267 my ($self, $x, $y, $child) = @_; 1369 my ($self) = shift;
1268 1370
1371 while (@_) {
1372 my ($x, $y, $child) = splice @_, 0, 3, ();
1269 $child->set_parent ($self); 1373 $child->set_parent ($self);
1270 $self->{children}[$y][$x] = $child; 1374 $self->{children}[$y][$x] = $child;
1375 }
1271 1376
1377 $self->{force_realloc} = 1;
1378 $self->{force_size_alloc} = 1;
1272 $self->realloc; 1379 $self->realloc;
1273} 1380}
1274 1381
1275sub remove { 1382sub remove {
1276 my ($self, $child) = @_; 1383 my ($self, $child) = @_;
… …
1324 (sum @$ws), 1431 (sum @$ws),
1325 (sum @$hs), 1432 (sum @$hs),
1326 ) 1433 )
1327} 1434}
1328 1435
1329sub size_allocate { 1436sub invoke_size_allocate {
1330 my ($self, $w, $h) = @_; 1437 my ($self, $w, $h) = @_;
1331 1438
1332 my ($ws, $hs) = $self->get_wh; 1439 my ($ws, $hs) = $self->get_wh;
1333 1440
1334 my $req_w = (sum @$ws) || 1; 1441 my $req_w = (sum @$ws) || 1;
… …
1366 } 1473 }
1367 1474
1368 $y += $row_h; 1475 $y += $row_h;
1369 } 1476 }
1370 1477
1478 1
1371} 1479}
1372 1480
1373sub find_widget { 1481sub find_widget {
1374 my ($self, $x, $y) = @_; 1482 my ($self, $x, $y) = @_;
1375 1483
… …
1412 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1520 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1413 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1521 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1414 ) 1522 )
1415} 1523}
1416 1524
1417sub size_allocate { 1525sub invoke_size_allocate {
1418 my ($self, $w, $h) = @_; 1526 my ($self, $w, $h) = @_;
1419 1527
1420 my $space = $self->{vertical} ? $h : $w; 1528 my $space = $self->{vertical} ? $h : $w;
1421 my $children = $self->{children}; 1529 my @children = $self->visible_children;
1422 1530
1423 my @req; 1531 my @req;
1424 1532
1425 if ($self->{homogeneous}) { 1533 if ($self->{homogeneous}) {
1426 @req = ($space / (@$children || 1)) x @$children; 1534 @req = ($space / (@children || 1)) x @children;
1427 } else { 1535 } else {
1428 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children; 1536 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1429 my $req = List::Util::sum @req; 1537 my $req = List::Util::sum @req;
1430 1538
1431 if ($req > $space) { 1539 if ($req > $space) {
1432 # ah well, not enough space 1540 # ah well, not enough space
1433 $_ *= $space / $req for @req; 1541 $_ *= $space / $req for @req;
1434 } else { 1542 } else {
1435 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1; 1543 my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1436 1544
1437 $space = ($space - $req) / $expand; # remaining space to give away 1545 $space = ($space - $req) / $expand; # remaining space to give away
1438 1546
1439 $req[$_] += $space * $children->[$_]{expand} 1547 $req[$_] += $space * $children[$_]{expand}
1440 for 0 .. $#$children; 1548 for 0 .. $#children;
1441 } 1549 }
1442 } 1550 }
1443 1551
1444 CFClient::UI::harmonize \@req; 1552 CFClient::UI::harmonize \@req;
1445 1553
1446 my $pos = 0; 1554 my $pos = 0;
1447 for (0 .. $#$children) { 1555 for (0 .. $#children) {
1448 my $alloc = $req[$_]; 1556 my $alloc = $req[$_];
1449 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1557 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1450 1558
1451 $pos += $alloc; 1559 $pos += $alloc;
1452 } 1560 }
1453 1561
1454 1 1562 1
… …
1527 } 1635 }
1528 1636
1529 $self 1637 $self
1530} 1638}
1531 1639
1532sub escape($) {
1533 local $_ = $_[0];
1534
1535 s/&/&amp;/g;
1536 s/>/&gt;/g;
1537 s/</&lt;/g;
1538
1539 $_
1540}
1541
1542sub update { 1640sub update {
1543 my ($self) = @_; 1641 my ($self) = @_;
1544 1642
1545 delete $self->{texture}; 1643 delete $self->{texture};
1546 $self->SUPER::update; 1644 $self->SUPER::update;
… …
1557 my ($self, $text) = @_; 1655 my ($self, $text) = @_;
1558 1656
1559 return if $self->{text} eq "T$text"; 1657 return if $self->{text} eq "T$text";
1560 $self->{text} = "T$text"; 1658 $self->{text} = "T$text";
1561 1659
1562 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1563 $self->{layout}->set_text ($text); 1660 $self->{layout}->set_text ($text);
1564 1661
1565 delete $self->{size_req}; 1662 delete $self->{size_req};
1566 $self->realloc; 1663 $self->realloc;
1567 $self->update; 1664 $self->update;
… …
1573 return if $self->{text} eq "M$markup"; 1670 return if $self->{text} eq "M$markup";
1574 $self->{text} = "M$markup"; 1671 $self->{text} = "M$markup";
1575 1672
1576 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1673 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1577 1674
1578 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1579 $self->{layout}->set_markup ($markup); 1675 $self->{layout}->set_markup ($markup);
1580 1676
1581 delete $self->{size_req}; 1677 delete $self->{size_req};
1582 $self->realloc; 1678 $self->realloc;
1583 $self->update; 1679 $self->update;
… …
1595 1691
1596 my ($w, $h) = $self->{layout}->size; 1692 my ($w, $h) = $self->{layout}->size;
1597 1693
1598 if (exists $self->{template}) { 1694 if (exists $self->{template}) {
1599 $self->{template}->set_font ($self->{font}) if $self->{font}; 1695 $self->{template}->set_font ($self->{font}) if $self->{font};
1696 $self->{template}->set_width ($self->{max_w} || -1);
1600 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 1697 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1601 1698
1602 my ($w2, $h2) = $self->{template}->size; 1699 my ($w2, $h2) = $self->{template}->size;
1603 1700
1604 $w = List::Util::max $w, $w2; 1701 $w = List::Util::max $w, $w2;
… …
1609 }; 1706 };
1610 1707
1611 @{ $self->{size_req} } 1708 @{ $self->{size_req} }
1612} 1709}
1613 1710
1711sub baseline_shift {
1712 $_[0]{layout}->descent
1713}
1714
1614sub size_allocate { 1715sub invoke_size_allocate {
1615 my ($self, $w, $h) = @_; 1716 my ($self, $w, $h) = @_;
1616 1717
1617 delete $self->{ox}; 1718 delete $self->{ox};
1618 1719
1619 delete $self->{texture} 1720 delete $self->{texture}
1620 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w}; 1721 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1722
1723 1
1621} 1724}
1622 1725
1623sub set_fontsize { 1726sub set_fontsize {
1624 my ($self, $fontsize) = @_; 1727 my ($self, $fontsize) = @_;
1625 1728
1626 $self->{fontsize} = $fontsize; 1729 $self->{fontsize} = $fontsize;
1730 delete $self->{size_req};
1627 delete $self->{texture}; 1731 delete $self->{texture};
1628 1732
1629 $self->realloc; 1733 $self->realloc;
1630} 1734}
1631 1735
1632sub reconfigure { 1736sub reconfigure {
1633 my ($self) = @_; 1737 my ($self) = @_;
1634 1738
1635 delete $self->{size_req}; 1739 delete $self->{size_req};
1740 delete $self->{texture};
1636 1741
1637 $self->SUPER::reconfigure; 1742 $self->SUPER::reconfigure;
1638} 1743}
1639 1744
1640sub _draw { 1745sub _draw {
1641 my ($self) = @_; 1746 my ($self) = @_;
1642 1747
1643 $self->SUPER::_draw; # draw background, if applicable 1748 $self->SUPER::_draw; # draw background, if applicable
1644 1749
1645 my $tex = $self->{texture} ||= do { 1750 my $size = $self->{texture} ||= do {
1646 $self->{layout}->set_foreground (@{$self->{fg}}); 1751 $self->{layout}->set_foreground (@{$self->{fg}});
1647 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1752 $self->{layout}->set_font ($self->{font}) if $self->{font};
1648 $self->{layout}->set_width ($self->{w}); 1753 $self->{layout}->set_width ($self->{w});
1649 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1754 $self->{layout}->set_ellipsise ($self->{ellipsise});
1650 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1755 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1651 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1756 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1652 1757
1653 new_from_layout CFClient::Texture $self->{layout} 1758 [$self->{layout}->size]
1654 }; 1759 };
1655 1760
1656 unless (exists $self->{ox}) { 1761 unless (exists $self->{ox}) {
1657 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} 1762 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1658 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x} 1763 : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1659 : ($self->{w} - $tex->{w}) * 0.5); 1764 : ($self->{w} - $size->[0]) * 0.5);
1660 1765
1661 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 1766 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1662 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y} 1767 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1663 : ($self->{h} - $tex->{h}) * 0.5); 1768 : ($self->{h} - $size->[1]) * 0.5);
1664 }; 1769 };
1665 1770
1666 glEnable GL_TEXTURE_2D;
1667
1668 my $w = List::Util::min $self->{w} + 4, $tex->{w}; 1771 my $w = List::Util::min $self->{w} + 4, $size->[0];
1669 my $h = List::Util::min $self->{h} + 2, $tex->{h}; 1772 my $h = List::Util::min $self->{h} + 2, $size->[1];
1670 1773
1671 if ($tex->{format} == GL_ALPHA) { 1774 $self->{layout}->render ($self->{ox}, $self->{oy});
1672 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1673 glColor @{$self->{fg}};
1674 $tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1675 } else {
1676 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1677 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1678 }
1679
1680 glDisable GL_TEXTURE_2D;
1681} 1775}
1682 1776
1683############################################################################# 1777#############################################################################
1684 1778
1685package CFClient::UI::EntryBase; 1779package CFClient::UI::EntryBase;
… …
1718 1812
1719 $text =~ s/./*/g if $self->{hidden}; 1813 $text =~ s/./*/g if $self->{hidden};
1720 $self->{layout}->set_text ("$text "); 1814 $self->{layout}->set_text ("$text ");
1721 delete $self->{size_req}; 1815 delete $self->{size_req};
1722 1816
1723 $self->_emit (changed => $self->{text}); 1817 $self->emit (changed => $self->{text});
1724 1818
1725 $self->realloc; 1819 $self->realloc;
1726 $self->update; 1820 $self->update;
1727} 1821}
1728 1822
… …
1743 my ($w, $h) = $self->SUPER::size_request; 1837 my ($w, $h) = $self->SUPER::size_request;
1744 1838
1745 ($w + 1, $h) # add 1 for cursor 1839 ($w + 1, $h) # add 1 for cursor
1746} 1840}
1747 1841
1748sub key_down { 1842sub invoke_key_down {
1749 my ($self, $ev) = @_; 1843 my ($self, $ev) = @_;
1750 1844
1751 my $mod = $ev->{mod}; 1845 my $mod = $ev->{mod};
1752 my $sym = $ev->{sym}; 1846 my $sym = $ev->{sym};
1753 my $uni = $ev->{unicode}; 1847 my $uni = $ev->{unicode};
… …
1765 } elsif ($sym == CFClient::SDLK_HOME) { 1859 } elsif ($sym == CFClient::SDLK_HOME) {
1766 $self->{cursor} = 0; 1860 $self->{cursor} = 0;
1767 } elsif ($sym == CFClient::SDLK_END) { 1861 } elsif ($sym == CFClient::SDLK_END) {
1768 $self->{cursor} = length $text; 1862 $self->{cursor} = length $text;
1769 } elsif ($uni == 27) { 1863 } elsif ($uni == 27) {
1770 $self->_emit ('escape'); 1864 $self->emit ('escape');
1771 } elsif ($uni) { 1865 } elsif ($uni) {
1772 substr $text, $self->{cursor}++, 0, chr $uni; 1866 substr $text, $self->{cursor}++, 0, chr $uni;
1773 } else { 1867 } else {
1774 return 0; 1868 return 0;
1775 } 1869 }
… …
1779 $self->realloc; 1873 $self->realloc;
1780 1874
1781 1 1875 1
1782} 1876}
1783 1877
1784sub focus_in { 1878sub invoke_focus_in {
1785 my ($self) = @_; 1879 my ($self) = @_;
1786 1880
1787 $self->{last_activity} = $::NOW; 1881 $self->{last_activity} = $::NOW;
1788 1882
1789 $self->SUPER::focus_in; 1883 $self->SUPER::invoke_focus_in
1790} 1884}
1791 1885
1792sub button_down { 1886sub invoke_button_down {
1793 my ($self, $ev, $x, $y) = @_; 1887 my ($self, $ev, $x, $y) = @_;
1794 1888
1795 $self->SUPER::button_down ($ev, $x, $y); 1889 $self->SUPER::invoke_button_down ($ev, $x, $y);
1796 1890
1797 my $idx = $self->{layout}->xy_to_index ($x, $y); 1891 my $idx = $self->{layout}->xy_to_index ($x, $y);
1798 1892
1799 # byte-index to char-index 1893 # byte-index to char-index
1800 my $text = $self->{text}; 1894 my $text = $self->{text};
1801 utf8::encode $text; 1895 utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1802 $self->{cursor} = length substr $text, 0, $idx; 1896 $self->{cursor} = length $text;
1803 1897
1804 $self->_set_text ($self->{text}); 1898 $self->_set_text ($self->{text});
1805 $self->update; 1899 $self->update;
1806 1900
1807 1 1901 1
1808} 1902}
1809 1903
1810sub mouse_motion { 1904sub invoke_mouse_motion {
1811 my ($self, $ev, $x, $y) = @_; 1905 my ($self, $ev, $x, $y) = @_;
1812# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1906# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1813 1907
1814 0 1908 1
1815} 1909}
1816 1910
1817sub _draw { 1911sub _draw {
1818 my ($self) = @_; 1912 my ($self) = @_;
1819 1913
… …
1860 1954
1861our @ISA = CFClient::UI::EntryBase::; 1955our @ISA = CFClient::UI::EntryBase::;
1862 1956
1863use CFClient::OpenGL; 1957use CFClient::OpenGL;
1864 1958
1865sub key_down { 1959sub invoke_key_down {
1866 my ($self, $ev) = @_; 1960 my ($self, $ev) = @_;
1867 1961
1868 my $sym = $ev->{sym}; 1962 my $sym = $ev->{sym};
1869 1963
1870 if ($sym == 13) { 1964 if ($sym == 13) {
1871 unshift @{$self->{history}}, 1965 unshift @{$self->{history}},
1872 my $txt = $self->get_text; 1966 my $txt = $self->get_text;
1967
1873 $self->{history_pointer} = -1; 1968 $self->{history_pointer} = -1;
1874 $self->{history_saveback} = ''; 1969 $self->{history_saveback} = '';
1875 $self->_emit (activate => $txt); 1970 $self->emit (activate => $txt);
1876 $self->update; 1971 $self->update;
1877 1972
1878 } elsif ($sym == CFClient::SDLK_UP) { 1973 } elsif ($sym == CFClient::SDLK_UP) {
1879 if ($self->{history_pointer} < 0) { 1974 if ($self->{history_pointer} < 0) {
1880 $self->{history_saveback} = $self->get_text; 1975 $self->{history_saveback} = $self->get_text;
… …
1896 } else { 1991 } else {
1897 $self->set_text ($self->{history_saveback}); 1992 $self->set_text ($self->{history_saveback});
1898 } 1993 }
1899 1994
1900 } else { 1995 } else {
1901 return $self->SUPER::key_down ($ev) 1996 return $self->SUPER::invoke_key_down ($ev)
1902 } 1997 }
1903 1998
1904 1 1999 1
1905} 2000}
1906 2001
… …
1930 can_events => 1, 2025 can_events => 1,
1931 @_ 2026 @_
1932 ) 2027 )
1933} 2028}
1934 2029
1935sub activate { }
1936
1937sub button_up { 2030sub invoke_button_up {
1938 my ($self, $ev, $x, $y) = @_; 2031 my ($self, $ev, $x, $y) = @_;
1939 2032
1940 $self->emit ("activate") 2033 $self->emit ("activate")
1941 if $x >= 0 && $x < $self->{w} 2034 if $x >= 0 && $x < $self->{w}
1942 && $y >= 0 && $y < $self->{h}; 2035 && $y >= 0 && $y < $self->{h};
… …
1956 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 2049 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1957 2050
1958 glDisable GL_TEXTURE_2D; 2051 glDisable GL_TEXTURE_2D;
1959 2052
1960 $self->SUPER::_draw; 2053 $self->SUPER::_draw;
2054}
2055
2056#############################################################################
2057
2058package CFClient::UI::ImageButton;
2059
2060our @ISA = CFClient::UI::Image::;
2061
2062use CFClient::OpenGL;
2063
2064my %textures;
2065
2066sub new {
2067 my $class = shift;
2068
2069 my $self = $class->SUPER::new (
2070 padding_x => 4,
2071 padding_y => 4,
2072 fg => [1, 1, 1],
2073 active_fg => [0, 0, 1],
2074 can_hover => 1,
2075 align => 0,
2076 valign => 0,
2077 can_events => 1,
2078 @_
2079 );
2080}
2081
2082sub invoke_button_up {
2083 my ($self, $ev, $x, $y) = @_;
2084
2085 $self->emit ("activate")
2086 if $x >= 0 && $x < $self->{w}
2087 && $y >= 0 && $y < $self->{h};
2088
2089 1
1961} 2090}
1962 2091
1963############################################################################# 2092#############################################################################
1964 2093
1965package CFClient::UI::CheckBox; 2094package CFClient::UI::CheckBox;
… …
1992 my ($self) = @_; 2121 my ($self) = @_;
1993 2122
1994 (6) x 2 2123 (6) x 2
1995} 2124}
1996 2125
2126sub toggle {
2127 my ($self) = @_;
2128
2129 $self->{state} = !$self->{state};
2130 $self->emit (changed => $self->{state});
2131 $self->update;
2132}
2133
1997sub button_down { 2134sub invoke_button_down {
1998 my ($self, $ev, $x, $y) = @_; 2135 my ($self, $ev, $x, $y) = @_;
1999 2136
2000 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2137 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2001 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2138 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2002 $self->{state} = !$self->{state}; 2139 $self->toggle;
2003 $self->_emit (changed => $self->{state});
2004 } else { 2140 } else {
2005 return 0 2141 return 0
2006 } 2142 }
2007 2143
2008 1 2144 1
… …
2033package CFClient::UI::Image; 2169package CFClient::UI::Image;
2034 2170
2035our @ISA = CFClient::UI::Base::; 2171our @ISA = CFClient::UI::Base::;
2036 2172
2037use CFClient::OpenGL; 2173use CFClient::OpenGL;
2038use Carp qw/confess/;
2039 2174
2040our %loaded_images; 2175our %texture_cache;
2041 2176
2042sub new { 2177sub new {
2043 my $class = shift; 2178 my $class = shift;
2044 2179
2045 my $self = $class->SUPER::new (can_events => 0, @_); 2180 my $self = $class->SUPER::new (
2181 can_events => 0,
2182 @_,
2183 );
2046 2184
2047 $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; 2185 $self->{path} || $self->{tex}
2186 or Carp::croak "'path' or 'tex' attributes required";
2048 2187
2049 $loaded_images{$self->{image}} ||= 2188 $self->{tex} ||= $texture_cache{$self->{path}} ||=
2050 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; 2189 new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2051 2190
2052 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2191 Scalar::Util::weaken $texture_cache{$self->{path}};
2053 2192
2054 Scalar::Util::weaken $loaded_images{$self->{image}}; 2193 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2055
2056 $self->{aspect} = $tex->{w} / $tex->{h};
2057 2194
2058 $self 2195 $self
2059} 2196}
2060 2197
2198sub STORABLE_freeze {
2199 my ($self, $cloning) = @_;
2200
2201 warn "freeze<$self>\n";#d#
2202
2203 $self->{path}
2204 or die "cannot serialise CFClient::UI::Image on non-loadable images\n";
2205
2206 $self->{path}
2207}
2208
2209sub STORABLE_attach {
2210 my ($self, $cloning, $path) = @_;
2211 warn "attach<@_>\n";#d#
2212
2213 $self->new (path => $path)
2214}
2215
2061sub size_request { 2216sub size_request {
2062 my ($self) = @_; 2217 my ($self) = @_;
2063 2218
2064 ($self->{tex}->{w}, $self->{tex}->{h}) 2219 ($self->{tex}{w}, $self->{tex}{h})
2065} 2220}
2066 2221
2067sub _draw { 2222sub _draw {
2068 my ($self) = @_; 2223 my ($self) = @_;
2069 2224
… …
2079 } 2234 }
2080 2235
2081 glEnable GL_TEXTURE_2D; 2236 glEnable GL_TEXTURE_2D;
2082 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2237 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2083 2238
2084 $tex->draw_quad_alpha (0, 0, $w, $h); 2239 $tex->draw_quad (0, 0, $w, $h);
2085 2240
2086 glDisable GL_TEXTURE_2D; 2241 glDisable GL_TEXTURE_2D;
2087} 2242}
2088 2243
2089############################################################################# 2244#############################################################################
… …
2178 my $ycut1 = max 0, min 1, $ycut; 2333 my $ycut1 = max 0, min 1, $ycut;
2179 my $ycut2 = max 0, min 1, $ycut - 1; 2334 my $ycut2 = max 0, min 1, $ycut - 1;
2180 2335
2181 my $h1 = $self->{h} * (1 - $ycut1); 2336 my $h1 = $self->{h} * (1 - $ycut1);
2182 my $h2 = $self->{h} * (1 - $ycut2); 2337 my $h2 = $self->{h} * (1 - $ycut2);
2338 my $h3 = $self->{h};
2339
2340 $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2183 2341
2184 glEnable GL_BLEND; 2342 glEnable GL_BLEND;
2185 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA, 2343 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2186 GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2344 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2187 glEnable GL_TEXTURE_2D; 2345 glEnable GL_TEXTURE_2D;
… …
2206 2364
2207 if ($t3) { 2365 if ($t3) {
2208 glBindTexture GL_TEXTURE_2D, $t3->{name}; 2366 glBindTexture GL_TEXTURE_2D, $t3->{name};
2209 glBegin GL_QUADS; 2367 glBegin GL_QUADS;
2210 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2; 2368 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2211 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h}; 2369 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2212 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h}; 2370 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2213 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2; 2371 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2214 glEnd; 2372 glEnd;
2215 } 2373 }
2216 2374
2217 glDisable GL_BLEND; 2375 glDisable GL_BLEND;
… …
2305 $self->update; 2463 $self->update;
2306 2464
2307 $self 2465 $self
2308} 2466}
2309 2467
2310sub changed { }
2311
2312sub set_range { 2468sub set_range {
2313 my ($self, $range) = @_; 2469 my ($self, $range) = @_;
2314 2470
2315 ($range, $self->{range}) = ($self->{range}, $range); 2471 ($range, $self->{range}) = ($self->{range}, $range);
2316 2472
… …
2336 if $unit; 2492 if $unit;
2337 2493
2338 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2494 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2339 2495
2340 if ($value != $old_value) { 2496 if ($value != $old_value) {
2341 $self->_emit (changed => $value); 2497 $self->emit (changed => $value);
2342 $self->update; 2498 $self->update;
2343 } 2499 }
2344} 2500}
2345 2501
2346sub size_request { 2502sub size_request {
2347 my ($self) = @_; 2503 my ($self) = @_;
2348 2504
2349 ($self->{req_w}, $self->{req_h}) 2505 ($self->{req_w}, $self->{req_h})
2350} 2506}
2351 2507
2352sub button_down { 2508sub invoke_button_down {
2353 my ($self, $ev, $x, $y) = @_; 2509 my ($self, $ev, $x, $y) = @_;
2354 2510
2355 $self->SUPER::button_down ($ev, $x, $y); 2511 $self->SUPER::invoke_button_down ($ev, $x, $y);
2356 2512
2357 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2513 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2358 2514
2359 $self->mouse_motion ($ev, $x, $y) 2515 $self->invoke_mouse_motion ($ev, $x, $y)
2360} 2516}
2361 2517
2362sub mouse_motion { 2518sub invoke_mouse_motion {
2363 my ($self, $ev, $x, $y) = @_; 2519 my ($self, $ev, $x, $y) = @_;
2364 2520
2365 if ($GRAB == $self) { 2521 if ($GRAB == $self) {
2366 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2522 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2367 2523
… …
2373 } else { 2529 } else {
2374 return 0; 2530 return 0;
2375 } 2531 }
2376 2532
2377 1 2533 1
2534}
2535
2536sub invoke_mouse_wheel {
2537 my ($self, $ev) = @_;
2538
2539 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
2540
2541 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.2);
2542
2543 ! ! $delta
2378} 2544}
2379 2545
2380sub update { 2546sub update {
2381 my ($self) = @_; 2547 my ($self) = @_;
2382 2548
… …
2483sub new { 2649sub new {
2484 my $class = shift; 2650 my $class = shift;
2485 2651
2486 my $self = $class->SUPER::new ( 2652 my $self = $class->SUPER::new (
2487 fontsize => 1, 2653 fontsize => 1,
2488 can_events => 0, 2654 can_events => 1,
2489 indent => 0, 2655 indent => 0,
2490 #font => default_font 2656 #font => default_font
2491 @_, 2657 @_,
2492 2658
2493 layout => (new CFClient::Layout 1), 2659 layout => (new CFClient::Layout),
2494 par => [], 2660 par => [],
2495 height => 0, 2661 height => 0,
2496 children => [ 2662 children => [
2497 (new CFClient::UI::Empty expand => 1), 2663 (new CFClient::UI::Empty expand => 1),
2498 (new CFClient::UI::Slider vertical => 1), 2664 (new CFClient::UI::Slider vertical => 1),
… …
2509 2675
2510 $self->{fontsize} = $fontsize; 2676 $self->{fontsize} = $fontsize;
2511 $self->reflow; 2677 $self->reflow;
2512} 2678}
2513 2679
2680sub size_request {
2681 my ($self) = @_;
2682
2683 my ($empty, $slider) = @{ $self->{children} };
2684
2685 local $self->{children} = [$empty, $slider];
2686 $self->SUPER::size_request
2687}
2688
2514sub size_allocate { 2689sub invoke_size_allocate {
2515 my ($self, $w, $h) = @_; 2690 my ($self, $w, $h) = @_;
2516 2691
2517 $self->SUPER::size_allocate ($w, $h); 2692 my ($empty, $slider, @other) = @{ $self->{children} };
2693 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2518 2694
2519 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2695 $self->{layout}->set_font ($self->{font}) if $self->{font};
2520 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2696 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2521 $self->{layout}->set_width ($self->{children}[0]{w}); 2697 $self->{layout}->set_width ($empty->{w});
2522 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 2698 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2523 2699
2524 $self->reflow; 2700 $self->reflow;
2525}
2526 2701
2527sub text_size { 2702 local $self->{children} = [$empty, $slider];
2703 $self->SUPER::invoke_size_allocate ($w, $h)
2704}
2705
2706sub invoke_mouse_wheel {
2528 my ($self, $text, $indent) = @_; 2707 my ($self, $ev) = @_;
2708
2709 return 0 unless $ev->{dy}; # only vertical movements
2710
2711 $self->{children}[1]->emit (mouse_wheel => $ev);
2712
2713 1
2714}
2715
2716sub get_layout {
2717 my ($self, $para) = @_;
2529 2718
2530 my $layout = $self->{layout}; 2719 my $layout = $self->{layout};
2531 2720
2721 $layout->set_font ($self->{font}) if $self->{font};
2722 $layout->set_foreground (@{$para->{fg}});
2532 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2723 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2533 $layout->set_width ($self->{children}[0]{w} - $indent); 2724 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2534 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 2725 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2535 $layout->set_markup ($text); 2726 $layout->set_markup ($para->{markup});
2727
2728 $layout->set_shapes (
2729 map
2730 +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
2731 @{$para->{widget}}
2536 2732 );
2733
2537 $layout->size 2734 $layout
2538} 2735}
2539 2736
2540sub reflow { 2737sub reflow {
2541 my ($self) = @_; 2738 my ($self) = @_;
2542 2739
… …
2551 $self->{children}[1]->set_value ($offset); 2748 $self->{children}[1]->set_value ($offset);
2552} 2749}
2553 2750
2554sub clear { 2751sub clear {
2555 my ($self) = @_; 2752 my ($self) = @_;
2753
2754 my (undef, undef, @other) = @{ $self->{children} };
2755 $self->remove ($_) for @other;
2556 2756
2557 $self->{par} = []; 2757 $self->{par} = [];
2558 $self->{height} = 0; 2758 $self->{height} = 0;
2559 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2759 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2560} 2760}
2561 2761
2562sub add_paragraph { 2762sub add_paragraph {
2563 my ($self, $color, $text, $indent) = @_; 2763 my ($self, $color, $para, $indent) = @_;
2564 2764
2565 for my $line (split /\n/, $text) { 2765 my ($text, @w) = ref $para ? @$para : $para;
2566 my ($w, $h) = $self->text_size ($line); 2766
2567 $self->{height} += $h; 2767 $para = {
2568 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 2768 w => 1e10,
2769 wrapped => 1,
2770 fg => $color,
2771 indent => $indent,
2772 markup => $text,
2773 widget => \@w,
2569 } 2774 };
2570 2775
2571 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 2776 $self->add (@w) if @w;
2777 push @{$self->{par}}, $para;
2778
2779 $self->{need_reflow}++;
2780 $self->update;
2781}
2782
2783sub scroll_to_bottom {
2784 my ($self) = @_;
2785
2786 $self->{scroll_to_bottom} = 1;
2787 $self->update;
2572} 2788}
2573 2789
2574sub update { 2790sub update {
2575 my ($self) = @_; 2791 my ($self) = @_;
2576 2792
… …
2584 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2800 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2585 2801
2586 if (delete $self->{need_reflow}) { 2802 if (delete $self->{need_reflow}) {
2587 my $height = 0; 2803 my $height = 0;
2588 2804
2589 my $layout = $self->{layout};
2590
2591 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2592
2593 for (@{$self->{par}}) { 2805 for my $para (@{$self->{par}}) {
2594 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2806 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2595 $layout->set_width ($W - $_->[3]); 2807 my $layout = $self->get_layout ($para);
2596 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2597 $layout->set_markup ($_->[4]);
2598 my ($w, $h) = $layout->size; 2808 my ($w, $h) = $layout->size;
2599 $_->[0] = $w + $_->[3]; 2809
2600 $_->[1] = $h; 2810 $para->{w} = $w + $para->{indent};
2811 $para->{h} = $h;
2812 $para->{wrapped} = $layout->has_wrapped;
2601 } 2813 }
2602 2814
2603 $height += $_->[1]; 2815 $height += $para->{h};
2604 } 2816 }
2605 2817
2606 $self->{height} = $height; 2818 $self->{height} = $height;
2607 2819
2608 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]); 2820 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2609 2821
2610 delete $self->{texture}; 2822 delete $self->{texture};
2823 }
2824
2825 if (delete $self->{scroll_to_bottom}) {
2826 $self->{children}[1]->set_value (1e10);
2611 } 2827 }
2612 2828
2613 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2829 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2614 glClearColor 0, 0, 0, 0; 2830 glClearColor 0, 0, 0, 0;
2615 glClear GL_COLOR_BUFFER_BIT; 2831 glClear GL_COLOR_BUFFER_BIT;
… …
2619 my $y0 = $top; 2835 my $y0 = $top;
2620 my $y1 = $top + $H; 2836 my $y1 = $top + $H;
2621 2837
2622 my $y = 0; 2838 my $y = 0;
2623 2839
2624 my $layout = $self->{layout};
2625
2626 $layout->set_font ($self->{font}) if $self->{font};
2627
2628 glEnable GL_BLEND;
2629 #TODO# not correct in windows where rgba is forced off
2630 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2631
2632 for my $par (@{$self->{par}}) { 2840 for my $para (@{$self->{par}}) {
2633 my $h = $par->[1]; 2841 my $h = $para->{h};
2634 2842
2635 if ($y0 < $y + $h && $y < $y1) { 2843 if ($y0 < $y + $h && $y < $y1) {
2636 $layout->set_foreground (@{ $par->[2] });
2637 $layout->set_width ($W - $par->[3]);
2638 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2639 $layout->set_markup ($par->[4]);
2640 2844
2641 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2845 my $layout = $self->get_layout ($para);
2642 2846
2643 glRasterPos $par->[3], $y - $y0; 2847 $layout->render ($para->{indent}, $y - $y0);
2644 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2848
2849 if (my @w = @{ $para->{widget} }) {
2850 my @s = $layout->get_shapes;
2851
2852 for (@w) {
2853 my ($dx, $dy) = splice @s, 0, 2, ();
2854
2855 $_->{x} = $dx + $para->{indent};
2856 $_->{y} = $dy + $y - $y0;
2857
2858 $_->draw;
2859 }
2860 }
2645 } 2861 }
2646 2862
2647 $y += $h; 2863 $y += $h;
2648 } 2864 }
2649
2650 glDisable GL_BLEND;
2651 }; 2865 };
2652 }); 2866 });
2867}
2868
2869sub reconfigure {
2870 my ($self) = @_;
2871
2872 $self->SUPER::reconfigure;
2873
2874 $_->{w} = 1e10 for @{ $self->{par} };
2875 $self->reflow;
2653} 2876}
2654 2877
2655sub _draw { 2878sub _draw {
2656 my ($self) = @_; 2879 my ($self) = @_;
2657 2880
… …
2660 glColor 0, 0, 0, 1; 2883 glColor 0, 0, 0, 1;
2661 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2884 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2662 glDisable GL_TEXTURE_2D; 2885 glDisable GL_TEXTURE_2D;
2663 2886
2664 $self->{children}[1]->draw; 2887 $self->{children}[1]->draw;
2665
2666} 2888}
2667 2889
2668############################################################################# 2890#############################################################################
2669 2891
2670package CFClient::UI::Animator; 2892package CFClient::UI::Animator;
… …
2779 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 3001 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2780 3002
2781 ($w + 4, $h + 4) 3003 ($w + 4, $h + 4)
2782} 3004}
2783 3005
2784sub size_allocate { 3006sub invoke_size_allocate {
2785 my ($self, $w, $h) = @_; 3007 my ($self, $w, $h) = @_;
2786 3008
2787 $self->SUPER::size_allocate ($w - 4, $h - 4); 3009 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2788} 3010}
2789 3011
2790sub visibility_change { 3012sub invoke_visibility_change {
2791 my ($self, $visible) = @_; 3013 my ($self, $visible) = @_;
2792 3014
2793 return unless $visible; 3015 return unless $visible;
2794 3016
2795 $self->{root}->on_post_alloc ("move_$self" => sub { 3017 $self->{root}->on_post_alloc ("move_$self" => sub {
2796 my $widget = $self->{owner} 3018 my $widget = $self->{owner}
2797 or return; 3019 or return;
2798 3020
3021 if ($widget->{visible}) {
2799 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 3022 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2800 3023
2801 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 3024 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2802 if $x + $self->{w} > $self->{root}{w}; 3025 if $x + $self->{w} > $self->{root}{w};
2803 3026
2804 $self->move_abs ($x, $y); 3027 $self->move_abs ($x, $y);
3028 } else {
3029 $self->hide;
3030 }
2805 }); 3031 });
2806} 3032}
2807 3033
2808sub _draw { 3034sub _draw {
2809 my ($self) = @_; 3035 my ($self) = @_;
… …
2943 for my $item (@{ $self->{items} }) { 3169 for my $item (@{ $self->{items} }) {
2944 my ($widget, $cb, $tooltip) = @$item; 3170 my ($widget, $cb, $tooltip) = @$item;
2945 3171
2946 # handle various types of items, only text for now 3172 # handle various types of items, only text for now
2947 if (!ref $widget) { 3173 if (!ref $widget) {
3174 if ($widget =~ /\t/) {
3175 my ($left, $right) = split /\t/, $widget, 2;
3176
3177 $widget = new CFClient::UI::HBox
3178 can_hover => 1,
3179 can_events => 1,
3180 tooltip => $tooltip,
3181 children => [
3182 (new CFClient::UI::Label markup => $left, expand => 1),
3183 (new CFClient::UI::Label markup => $right, align => +1),
3184 ],
3185 ;
3186
3187 } else {
2948 $widget = new CFClient::UI::Label 3188 $widget = new CFClient::UI::Label
2949 can_hover => 1, 3189 can_hover => 1,
2950 can_events => 1, 3190 can_events => 1,
2951 markup => $widget, 3191 markup => $widget,
2952 tooltip => $tooltip 3192 tooltip => $tooltip;
3193 }
2953 } 3194 }
2954 3195
2955 $self->{item}{$widget} = $item; 3196 $self->{item}{$widget} = $item;
2956 3197
2957 $self->{vbox}->add ($widget); 3198 $self->{vbox}->add ($widget);
… …
2962 3203
2963# popup given the event (must be a mouse button down event currently) 3204# popup given the event (must be a mouse button down event currently)
2964sub popup { 3205sub popup {
2965 my ($self, $ev) = @_; 3206 my ($self, $ev) = @_;
2966 3207
2967 $self->_emit ("popdown"); 3208 $self->emit ("popdown");
2968 3209
2969 # maybe save $GRAB? must be careful about events... 3210 # maybe save $GRAB? must be careful about events...
2970 $GRAB = $self; 3211 $GRAB = $self;
2971 $self->{button} = $ev->{button}; 3212 $self->{button} = $ev->{button};
2972 3213
2973 $self->show; 3214 $self->show;
2974 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 3215 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2975} 3216}
2976 3217
2977sub mouse_motion { 3218sub invoke_mouse_motion {
2978 my ($self, $ev, $x, $y) = @_; 3219 my ($self, $ev, $x, $y) = @_;
2979 3220
2980 # TODO: should use vbox->find_widget or so 3221 # TODO: should use vbox->find_widget or so
2981 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3222 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2982 $self->{hover} = $self->{item}{$HOVER}; 3223 $self->{hover} = $self->{item}{$HOVER};
2983 3224
2984 0 3225 0
2985} 3226}
2986 3227
2987sub button_up { 3228sub invoke_button_up {
2988 my ($self, $ev, $x, $y) = @_; 3229 my ($self, $ev, $x, $y) = @_;
2989 3230
2990 if ($ev->{button} == $self->{button}) { 3231 if ($ev->{button} == $self->{button}) {
2991 undef $GRAB; 3232 undef $GRAB;
2992 $self->hide; 3233 $self->hide;
2993 3234
2994 $self->_emit ("popdown"); 3235 $self->emit ("popdown");
2995 $self->{hover}[1]->() if $self->{hover}; 3236 $self->{hover}[1]->() if $self->{hover};
2996 } else { 3237 } else {
2997 return 0 3238 return 0
2998 } 3239 }
2999 3240
… …
3026 3267
3027 $self->{current} = $self->{children}[0] 3268 $self->{current} = $self->{children}[0]
3028 if @{ $self->{children} }; 3269 if @{ $self->{children} };
3029} 3270}
3030 3271
3272sub get_current_page {
3273 my ($self) = @_;
3274
3275 $self->{current}
3276}
3277
3031sub set_current_page { 3278sub set_current_page {
3032 my ($self, $page_or_widget) = @_; 3279 my ($self, $page_or_widget) = @_;
3033 3280
3034 my $widget = ref $page_or_widget 3281 my $widget = ref $page_or_widget
3035 ? $page_or_widget 3282 ? $page_or_widget
3036 : $self->{children}[$page_or_widget]; 3283 : $self->{children}[$page_or_widget];
3037 3284
3038 $self->{current} = $widget; 3285 $self->{current} = $widget;
3039 $self->{current}->configure (0, 0, $self->{w}, $self->{h}); 3286 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3040 3287
3041 $self->_emit (page_changed => $self->{current}); 3288 $self->emit (page_changed => $self->{current});
3042 3289
3043 $self->realloc; 3290 $self->realloc;
3044} 3291}
3045 3292
3046sub visible_children { 3293sub visible_children {
… …
3051 my ($self) = @_; 3298 my ($self) = @_;
3052 3299
3053 $self->{current}->size_request 3300 $self->{current}->size_request
3054} 3301}
3055 3302
3056sub size_allocate { 3303sub invoke_size_allocate {
3057 my ($self, $w, $h) = @_; 3304 my ($self, $w, $h) = @_;
3058 3305
3059 $self->{current}->configure (0, 0, $w, $h); 3306 $self->{current}->configure (0, 0, $w, $h);
3307
3308 1
3060} 3309}
3061 3310
3062sub _draw { 3311sub _draw {
3063 my ($self) = @_; 3312 my ($self) = @_;
3064 3313
… …
3099 ); 3348 );
3100 3349
3101 $self->{multiplexer}->add ($widget); 3350 $self->{multiplexer}->add ($widget);
3102} 3351}
3103 3352
3353sub get_current_page {
3354 my ($self) = @_;
3355
3356 $self->{multiplexer}->get_current_page
3357}
3358
3104sub set_current_page { 3359sub set_current_page {
3105 my ($self, $page) = @_; 3360 my ($self, $page) = @_;
3106 3361
3107 $self->{multiplexer}->set_current_page ($page); 3362 $self->{multiplexer}->set_current_page ($page);
3108 $self->_emit (page_changed => $self->{multiplexer}{current}); 3363 $self->emit (page_changed => $self->{multiplexer}{current});
3109} 3364}
3110 3365
3111############################################################################# 3366#############################################################################
3112 3367
3113package CFClient::UI::Combobox; 3368package CFClient::UI::Combobox;
… …
3128 $self->_set_value ($self->{value}); 3383 $self->_set_value ($self->{value});
3129 3384
3130 $self 3385 $self
3131} 3386}
3132 3387
3133sub button_down { 3388sub invoke_button_down {
3134 my ($self, $ev) = @_; 3389 my ($self, $ev) = @_;
3135 3390
3136 my @menu_items; 3391 my @menu_items;
3137 3392
3138 for (@{ $self->{options} }) { 3393 for (@{ $self->{options} }) {
… …
3159 my ($self, $value) = @_; 3414 my ($self, $value) = @_;
3160 3415
3161 return unless $self->{value} ne $value; 3416 return unless $self->{value} ne $value;
3162 3417
3163 $self->_set_value ($value); 3418 $self->_set_value ($value);
3164 $self->_emit (changed => $value); 3419 $self->emit (changed => $value);
3165} 3420}
3166 3421
3167############################################################################# 3422#############################################################################
3168 3423
3169package CFClient::UI::Statusbox; 3424package CFClient::UI::Statusbox;
… …
3284 count => 1, 3539 count => 1,
3285 %arg, 3540 %arg,
3286 }; 3541 };
3287 } 3542 }
3288 3543
3544 $ROOT->on_refresh (reorder => sub {
3289 $self->reorder; 3545 $self->reorder;
3546 });
3290} 3547}
3291 3548
3292sub reconfigure { 3549sub reconfigure {
3293 my ($self) = @_; 3550 my ($self) = @_;
3294 3551
… …
3309 3566
3310############################################################################# 3567#############################################################################
3311 3568
3312package CFClient::UI::Inventory; 3569package CFClient::UI::Inventory;
3313 3570
3314our @ISA = CFClient::UI::ScrolledWindow::; 3571our @ISA = CFClient::UI::Table::;
3315 3572
3316sub new { 3573sub new {
3317 my $class = shift; 3574 my $class = shift;
3318 3575
3319 my $self = $class->SUPER::new ( 3576 my $self = $class->SUPER::new (
3320 child => (new CFClient::UI::Table col_expand => [0, 1, 0]), 3577 col_expand => [0, 1, 0],
3578 items => [],
3321 @_, 3579 @_,
3322 ); 3580 );
3323 3581
3582 $self->set_sort_order (undef);
3583
3324 $self 3584 $self
3585}
3586
3587sub update_items {
3588 my ($self) = @_;
3589
3590 $self->clear;
3591
3592 my @item = $self->{sort}->(@{ $self->{items} });
3593
3594 my @adds;
3595 my $row = 0;
3596 for my $item ($self->{sort}->(@{ $self->{items} })) {
3597 CFClient::Item::update_widgets $item;
3598
3599 push @adds, 0, $row, $item->{face_widget};
3600 push @adds, 1, $row, $item->{desc_widget};
3601 push @adds, 2, $row, $item->{weight_widget};
3602
3603 $row++;
3604 }
3605
3606 $self->add (@adds);
3607}
3608
3609sub set_sort_order {
3610 my ($self, $order) = @_;
3611
3612 $self->{sort} = $order ||= sub {
3613 sort {
3614 $a->{type} <=> $b->{type}
3615 or $a->{name} cmp $b->{name}
3616 } @_
3617 };
3618
3619 $self->update_items;
3325} 3620}
3326 3621
3327sub set_items { 3622sub set_items {
3328 my ($self, $items) = @_; 3623 my ($self, $items) = @_;
3329 3624
3330 $self->{child}->clear; 3625 $self->{items} = [$items ? values %$items : ()];
3331 return unless $items;
3332
3333 my @items = sort {
3334 ($a->{type} <=> $b->{type})
3335 or ($a->{name} cmp $b->{name})
3336 } @$items;
3337
3338 $self->{real_items} = \@items;
3339
3340 my $row = 0;
3341 for my $item (@items) {
3342 CFClient::Item::update_widgets $item;
3343
3344 $self->{child}->add (0, $row, $item->{face_widget});
3345 $self->{child}->add (1, $row, $item->{desc_widget});
3346 $self->{child}->add (2, $row, $item->{weight_widget});
3347
3348 $row++;
3349 }
3350}
3351
3352#############################################################################
3353
3354package CFClient::UI::BindEditor;
3355
3356our @ISA = CFClient::UI::FancyFrame::;
3357
3358sub new {
3359 my $class = shift;
3360
3361 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3362
3363 $self->add (my $vb = new CFClient::UI::VBox);
3364
3365
3366 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3367 text => "start recording",
3368 tooltip => "Start/Stops recording of actions."
3369 ."All subsequent actions after the recording started will be captured."
3370 ."The actions are displayed after the record was stopped."
3371 ."To bind the action you have to click on the 'Bind' button",
3372 on_activate => sub {
3373 unless ($self->{recording}) {
3374 $self->start;
3375 } else {
3376 $self->stop;
3377 }
3378 });
3379
3380 $vb->add (new CFClient::UI::Label text => "Actions:");
3381 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3382
3383 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3384 $vb->add (my $hb = new CFClient::UI::HBox);
3385 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3386 $hb->add (new CFClient::UI::Button
3387 text => "bind",
3388 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3389 on_activate => sub {
3390 $self->ask_for_bind;
3391 });
3392
3393 $vb->add (my $hb = new CFClient::UI::HBox);
3394 $hb->add (new CFClient::UI::Button
3395 text => "ok",
3396 expand => 1,
3397 tooltip => "This closes the binding editor and saves the binding",
3398 on_activate => sub {
3399 $self->hide;
3400 $self->commit;
3401 });
3402
3403 $hb->add (new CFClient::UI::Button
3404 text => "cancel",
3405 expand => 1,
3406 tooltip => "This closes the binding editor without saving",
3407 on_activate => sub {
3408 $self->hide;
3409 $self->{binding_cancel}->()
3410 if $self->{binding_cancel};
3411 });
3412
3413 $self->update_binding_widgets; 3626 $self->update_items;
3414
3415 $self
3416}
3417
3418sub commit {
3419 my ($self) = @_;
3420 my ($mod, $sym, $cmds) = $self->get_binding;
3421 if ($sym != 0 && @$cmds > 0) {
3422 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3423 ."'. Don't forget 'Save Config'!");
3424 $self->{binding_change}->($mod, $sym, $cmds)
3425 if $self->{binding_change};
3426 } else {
3427 $::STATUSBOX->add ("No action bound, no key or action specified!");
3428 $self->{binding_cancel}->()
3429 if $self->{binding_cancel};
3430 }
3431}
3432
3433sub start {
3434 my ($self) = @_;
3435
3436 $self->{rec_btn}->set_text ("stop recording");
3437 $self->{recording} = 1;
3438 $self->clear_command_list;
3439 $::CONN->start_record if $::CONN;
3440}
3441
3442sub stop {
3443 my ($self) = @_;
3444
3445 $self->{rec_btn}->set_text ("start recording");
3446 $self->{recording} = 0;
3447
3448 my $rec;
3449 $rec = $::CONN->stop_record if $::CONN;
3450 return unless ref $rec eq 'ARRAY';
3451 $self->set_command_list ($rec);
3452}
3453
3454
3455sub ask_for_bind_and_commit {
3456 my ($self) = @_;
3457 $self->ask_for_bind (1);
3458}
3459
3460sub ask_for_bind {
3461 my ($self, $commit) = @_;
3462
3463 CFClient::Binder::open_binding_dialog (sub {
3464 my ($mod, $sym) = @_;
3465 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3466 $self->update_binding_widgets;
3467 $self->commit if $commit;
3468 });
3469}
3470
3471# $mod and $sym are the modifiers and key symbol
3472# $cmds is a array ref of strings (the commands)
3473# $cb is the callback that is executed on OK
3474# $ccb is the callback that is executed on CANCEL and
3475# when the binding was unsuccessful on OK
3476sub set_binding {
3477 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3478
3479 $self->clear_command_list;
3480 $self->{recording} = 0;
3481 $self->{rec_btn}->set_text ("start recording");
3482
3483 $self->{binding} = [$mod, $sym];
3484 $self->{commands} = $cmds;
3485
3486 $self->{binding_change} = $cb;
3487 $self->{binding_cancel} = $ccb;
3488
3489 $self->update_binding_widgets;
3490}
3491
3492# this is a shortcut method that asks for a binding
3493# and then just binds it.
3494sub do_quick_binding {
3495 my ($self, $cmds) = @_;
3496 $self->set_binding (undef, undef, $cmds, sub {
3497 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3498 });
3499 $self->ask_for_bind (1);
3500}
3501
3502sub update_binding_widgets {
3503 my ($self) = @_;
3504 my ($mod, $sym, $cmds) = $self->get_binding;
3505 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3506 $self->set_command_list ($cmds);
3507}
3508
3509sub get_binding {
3510 my ($self) = @_;
3511 return (
3512 $self->{binding}->[0],
3513 $self->{binding}->[1],
3514 [ grep { defined $_ } @{$self->{commands}} ]
3515 );
3516}
3517
3518sub clear_command_list {
3519 my ($self) = @_;
3520 $self->{cmdbox}->clear ();
3521}
3522
3523sub set_command_list {
3524 my ($self, $cmds) = @_;
3525
3526 $self->{cmdbox}->clear ();
3527 $self->{commands} = $cmds;
3528
3529 my $idx = 0;
3530
3531 for (@$cmds) {
3532 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3533
3534 my $i = $idx;
3535 $hb->add (new CFClient::UI::Label text => $_);
3536 $hb->add (new CFClient::UI::Button
3537 text => "delete",
3538 tooltip => "Deletes the action from the record",
3539 on_activate => sub {
3540 $self->{cmdbox}->remove ($hb);
3541 $cmds->[$i] = undef;
3542 });
3543
3544
3545 $idx++
3546 }
3547} 3627}
3548 3628
3549############################################################################# 3629#############################################################################
3550 3630
3551package CFClient::UI::SpellList; 3631package CFClient::UI::SpellList;
… …
3604 } elsif ($ev->{button} == 2) { 3684 } elsif ($ev->{button} == 2) {
3605 $::CONN->user_send ("invoke $spell->{name}"); 3685 $::CONN->user_send ("invoke $spell->{name}");
3606 } elsif ($ev->{button} == 3) { 3686 } elsif ($ev->{button} == 3) {
3607 (new CFClient::UI::Menu 3687 (new CFClient::UI::Menu
3608 items => [ 3688 items => [
3609 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }], 3689 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3610 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }], 3690 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3611 ], 3691 ],
3612 )->popup ($ev); 3692 )->popup ($ev);
3613 } else { 3693 } else {
3614 return 0; 3694 return 0;
… …
3709 $coord = $max - $size if $coord > $max - $size; 3789 $coord = $max - $size if $coord > $max - $size;
3710 3790
3711 int $coord + 0.5 3791 int $coord + 0.5
3712} 3792}
3713 3793
3714sub size_allocate { 3794sub invoke_size_allocate {
3715 my ($self, $w, $h) = @_; 3795 my ($self, $w, $h) = @_;
3716 3796
3717 for my $child ($self->children) { 3797 for my $child ($self->children) {
3718 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3798 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3719 3799
… …
3723 $X = _to_pixel $X, $W, $self->{w}; 3803 $X = _to_pixel $X, $W, $self->{w};
3724 $Y = _to_pixel $Y, $H, $self->{h}; 3804 $Y = _to_pixel $Y, $H, $self->{h};
3725 3805
3726 $child->configure ($X, $Y, $W, $H); 3806 $child->configure ($X, $Y, $W, $H);
3727 } 3807 }
3808
3809 1
3728} 3810}
3729 3811
3730sub coord2local { 3812sub coord2local {
3731 my ($self, $x, $y) = @_; 3813 my ($self, $x, $y) = @_;
3732 3814
… …
3858 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 3940 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3859 3941
3860 $w = 0 if $w < 0; 3942 $w = 0 if $w < 0;
3861 $h = 0 if $h < 0; 3943 $h = 0 if $h < 0;
3862 3944
3945 $w = max $widget->{min_w}, $w;
3946 $h = max $widget->{min_h}, $h;
3947
3948 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3949 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3950
3863 $w = int $w + 0.5; 3951 $w = int $w + 0.5;
3864 $h = int $h + 0.5; 3952 $h = int $h + 0.5;
3865 3953
3866 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 3954 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3867 $widget->{old_w} = $widget->{w}; 3955 $widget->{old_w} = $widget->{w};

Diff Legend

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