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.288 by root, Mon Jun 5 21:14:40 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;
… …
272 294
273 return unless $self->{visible}; 295 return unless $self->{visible};
274 296
275 $_->set_invisible for $self->children; 297 $_->set_invisible for $self->children;
276 298
299 delete $self->{visible};
277 delete $self->{root}; 300 delete $self->{root};
278 delete $self->{visible};
279 301
280 undef $GRAB if $GRAB == $self; 302 undef $GRAB if $GRAB == $self;
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) = @_;
… …
315} 336}
316 337
317sub move_abs { 338sub move_abs {
318 my ($self, $x, $y, $z) = @_; 339 my ($self, $x, $y, $z) = @_;
319 340
320 $self->{x} = List::Util::max 0, int $x; 341 $self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
321 $self->{y} = List::Util::max 0, int $y; 342 $self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
322 $self->{z} = $z if defined $z; 343 $self->{z} = $z if defined $z;
323 344
324 $self->update; 345 $self->update;
325} 346}
326 347
… …
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
… …
526} 571}
527 572
528sub reconfigure { 573sub reconfigure {
529 my ($self) = @_; 574 my ($self) = @_;
530 575
531 # some widgets cache req_w and req_h
532 delete $self->{req_w};
533 delete $self->{req_h};
534
535 $self->realloc; 576 $self->realloc;
536 $self->update; 577 $self->update;
537} 578}
538 579
539# using global variables seems a bit hacky, but passing through all drawing 580# using global variables seems a bit hacky, but passing through all drawing
… …
546 return unless $self->{h} && $self->{w}; 587 return unless $self->{h} && $self->{w};
547 588
548 # update screen rectangle 589 # update screen rectangle
549 local $draw_x = $draw_x + $self->{x}; 590 local $draw_x = $draw_x + $self->{x};
550 local $draw_y = $draw_y + $self->{y}; 591 local $draw_y = $draw_y + $self->{y};
551 local $draw_w = $draw_x + $self->{w};
552 local $draw_h = $draw_y + $self->{h};
553 592
554 # skip widgets that are entirely outside the drawing area 593 # skip widgets that are entirely outside the drawing area
555 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w) 594 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
556 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h); 595 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
557 596
… …
596} 635}
597 636
598sub DESTROY { 637sub DESTROY {
599 my ($self) = @_; 638 my ($self) = @_;
600 639
640 return if CFClient::in_destruct;
641
601 delete $WIDGET{$self+0}; 642 delete $WIDGET{$self+0};
602 #$self->deactivate; 643
644 eval { $self->destroy };
645 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
603} 646}
604 647
605############################################################################# 648#############################################################################
606 649
607package CFClient::UI::DrawBG; 650package CFClient::UI::DrawBG;
… …
688 if $children; 731 if $children;
689 732
690 $self 733 $self
691} 734}
692 735
736sub realloc {
737 my ($self) = @_;
738
739 $self->{force_realloc} = 1;
740 $self->{force_size_alloc} = 1;
741 $self->SUPER::realloc;
742}
743
693sub add { 744sub add {
694 my ($self, @widgets) = @_; 745 my ($self, @widgets) = @_;
695 746
696 $_->set_parent ($self) 747 $_->set_parent ($self)
697 for @widgets; 748 for @widgets;
… …
772} 823}
773 824
774sub add { 825sub add {
775 my ($self, $child) = @_; 826 my ($self, $child) = @_;
776 827
777 $self->{children} = []; 828 $self->SUPER::remove ($_) for @{ $self->{children} };
778
779 $self->SUPER::add ($child); 829 $self->SUPER::add ($child);
780} 830}
781 831
782sub remove { 832sub remove {
783 my ($self, $widget) = @_; 833 my ($self, $widget) = @_;
… …
792 842
793sub size_request { 843sub size_request {
794 $_[0]{children}[0]->size_request 844 $_[0]{children}[0]->size_request
795} 845}
796 846
797sub size_allocate { 847sub invoke_size_allocate {
798 my ($self, $w, $h) = @_; 848 my ($self, $w, $h) = @_;
799 849
800 $self->{children}[0]->configure (0, 0, $w, $h); 850 $self->{children}[0]->configure (0, 0, $w, $h);
851
852 1
801} 853}
802 854
803############################################################################# 855#############################################################################
804 856
805# back-buffered drawing area 857# back-buffered drawing area
… …
821 873
822 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 874 $ROOT->on_post_alloc ($self => sub { $self->render_child });
823 $self->SUPER::update; 875 $self->SUPER::update;
824} 876}
825 877
826sub size_allocate { 878sub invoke_size_allocate {
827 my ($self, $w, $h) = @_; 879 my ($self, $w, $h) = @_;
828 880
829 $self->SUPER::size_allocate ($w, $h);
830 $self->update; 881 $self->update;
882
883 $self->SUPER::invoke_size_allocate ($w, $h)
831} 884}
832 885
833sub _render { 886sub _render {
834 my ($self) = @_; 887 my ($self) = @_;
835 888
… …
896 $h = 10 if $self->{scroll_y}; 949 $h = 10 if $self->{scroll_y};
897 950
898 ($w, $h) 951 ($w, $h)
899} 952}
900 953
901sub size_allocate { 954sub invoke_size_allocate {
902 my ($self, $w, $h) = @_; 955 my ($self, $w, $h) = @_;
903 956
904 my $child = $self->child; 957 my $child = $self->child;
905 958
906 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w}; 959 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
907 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h}; 960 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
908 961
909 $self->child->configure (0, 0, $w, $h); 962 $self->child->configure (0, 0, $w, $h);
910 $self->update; 963 $self->update;
964
965 1
911} 966}
912 967
913sub set_offset { 968sub set_offset {
914 my ($self, $x, $y) = @_; 969 my ($self, $x, $y) = @_;
915 970
… …
978 $self->{vp}->set_offset (0, $_[1]); 1033 $self->{vp}->set_offset (0, $_[1]);
979 }, 1034 },
980 ; 1035 ;
981 1036
982 $self = $class->SUPER::new ( 1037 $self = $class->SUPER::new (
983 vp => (new CFClient::UI::ViewPort expand => 1), 1038 vp => (new CFClient::UI::ViewPort expand => 1),
1039 can_events => 1,
984 slider => $slider, 1040 slider => $slider,
985 %arg, 1041 %arg,
986 ); 1042 );
987 1043
988 $self->SUPER::add ($self->{vp}, $self->{slider}); 1044 $self->SUPER::add ($self->{vp}, $self->{slider});
989 $self->add ($child) if $child; 1045 $self->add ($child) if $child;
990 1046
991 $self 1047 $self
992} 1048}
993 1049
1050#TODO# update range on size_allocate depending on child
1051
994sub add { 1052sub add {
995 my ($self, $widget) = @_; 1053 my ($self, $widget) = @_;
996 1054
997 $self->{vp}->add ($self->{child} = $widget); 1055 $self->{vp}->add ($self->{child} = $widget);
998} 1056}
999 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
1000sub update { 1074sub update {
1001 my ($self) = @_; 1075 my ($self) = @_;
1002 1076
1003 $self->SUPER::update; 1077 $self->SUPER::update;
1004 1078
1005 # todo: overwrite size_allocate of child 1079 $self->update_slider;
1006 my $child = $self->{vp}->child;
1007 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1008} 1080}
1009 1081
1010sub size_allocate { 1082sub invoke_size_allocate {
1011 my ($self, $w, $h) = @_; 1083 my ($self, $w, $h) = @_;
1012 1084
1085 $self->update_slider;
1086
1013 $self->SUPER::size_allocate ($w, $h); 1087 $self->SUPER::invoke_size_allocate ($w, $h)
1014
1015 my $child = $self->{vp}->child;
1016 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1017} 1088}
1018
1019#TODO# update range on size_allocate depending on child
1020# update viewport offset on scroll
1021 1089
1022############################################################################# 1090#############################################################################
1023 1091
1024package CFClient::UI::Frame; 1092package CFClient::UI::Frame;
1025 1093
… …
1076 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1144 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1077 1145
1078sub new { 1146sub new {
1079 my ($class, %arg) = @_; 1147 my ($class, %arg) = @_;
1080 1148
1081 my $title = delete $arg{title};
1082
1083 my $self = $class->SUPER::new ( 1149 my $self = $class->SUPER::new (
1084 bg => [1, 1, 1, 1], 1150 bg => [1, 1, 1, 1],
1085 border_bg => [1, 1, 1, 1], 1151 border_bg => [1, 1, 1, 1],
1086 border => 0.6, 1152 border => 0.6,
1087 can_events => 1, 1153 can_events => 1,
1088 min_w => 16, 1154 min_w => 64,
1089 min_h => 16, 1155 min_h => 32,
1090 %arg, 1156 %arg,
1091 ); 1157 );
1092 1158
1093 $self->{title} = new CFClient::UI::Label 1159 $self->{title_widget} = new CFClient::UI::Label
1094 align => 0, 1160 align => 0,
1095 valign => 1, 1161 valign => 1,
1096 text => $title, 1162 text => $self->{title},
1097 fontsize => $self->{border} 1163 fontsize => $self->{border},
1098 if defined $title; 1164 if exists $self->{title};
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 }
1099 1174
1100 $self 1175 $self
1101} 1176}
1102 1177
1103sub add { 1178sub add {
1104 my ($self, @widgets) = @_; 1179 my ($self, @widgets) = @_;
1105 1180
1106 $self->SUPER::add (@widgets); 1181 $self->SUPER::add (@widgets);
1182 $self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1107 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title}; 1183 $self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1108} 1184}
1109 1185
1110sub border { 1186sub border {
1111 int $_[0]{border} * $::FONTSIZE 1187 int $_[0]{border} * $::FONTSIZE
1112} 1188}
1113 1189
1114sub size_request { 1190sub size_request {
1115 my ($self) = @_; 1191 my ($self) = @_;
1116 1192
1117 $self->{title}->size_request 1193 $self->{title_widget}->size_request
1118 if $self->{title}; 1194 if $self->{title_widget};
1195
1196 $self->{close_button}->size_request
1197 if $self->{close_button};
1119 1198
1120 my ($w, $h) = $self->SUPER::size_request; 1199 my ($w, $h) = $self->SUPER::size_request;
1121 1200
1122 ( 1201 (
1123 $w + $self->border * 2, 1202 $w + $self->border * 2,
1124 $h + $self->border * 2, 1203 $h + $self->border * 2,
1125 ) 1204 )
1126} 1205}
1127 1206
1128sub size_allocate { 1207sub invoke_size_allocate {
1129 my ($self, $w, $h) = @_; 1208 my ($self, $w, $h) = @_;
1130 1209
1131 if ($self->{title}) { 1210 if ($self->{title_widget}) {
1132 $self->{title}{w} = $w; 1211 $self->{title_widget}{w} = $w;
1133 $self->{title}{h} = $h; 1212 $self->{title_widget}{h} = $h;
1134 $self->{title}->size_allocate ($w, $h); 1213 $self->{title_widget}->invoke_size_allocate ($w, $h);
1135 } 1214 }
1136 1215
1137 my $border = $self->border; 1216 my $border = $self->border;
1138 1217
1139 $h -= List::Util::max 0, $border * 2; 1218 $h -= List::Util::max 0, $border * 2;
1140 $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;
1141 1233
1142 $self->child->configure ($border, $border, $w, $h); 1234 1
1143} 1235}
1144 1236
1145sub button_down { 1237sub invoke_button_down {
1146 my ($self, $ev, $x, $y) = @_; 1238 my ($self, $ev, $x, $y) = @_;
1147 1239
1148 my ($w, $h) = @$self{qw(w h)}; 1240 my ($w, $h) = @$self{qw(w h)};
1149 my $border = $self->border; 1241 my $border = $self->border;
1150 1242
… …
1181 1273
1182 ($x, $y) = ($ev->{x}, $ev->{y}); 1274 ($x, $y) = ($ev->{x}, $ev->{y});
1183 1275
1184 $self->move_abs ($bx + $x - $ox, $by + $y - $oy); 1276 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1185 # HACK: the next line is required to enforce placement 1277 # HACK: the next line is required to enforce placement
1186 $self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h}); 1278 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1187 }; 1279 };
1188 } else { 1280 } else {
1189 return 0; 1281 return 0;
1190 } 1282 }
1191 1283
1192 1 1284 1
1193} 1285}
1194 1286
1195sub button_up { 1287sub invoke_button_up {
1196 my ($self, $ev, $x, $y) = @_; 1288 my ($self, $ev, $x, $y) = @_;
1197 1289
1198 !!delete $self->{motion} 1290 ! ! delete $self->{motion}
1199} 1291}
1200 1292
1201sub mouse_motion { 1293sub invoke_mouse_motion {
1202 my ($self, $ev, $x, $y) = @_; 1294 my ($self, $ev, $x, $y) = @_;
1203 1295
1204 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1296 $self->{motion}->($ev, $x, $y) if $self->{motion};
1205 1297
1206 !!$self->{motion} 1298 ! ! $self->{motion}
1207} 1299}
1208 1300
1209sub _draw { 1301sub _draw {
1210 my ($self) = @_; 1302 my ($self) = @_;
1211 1303
… …
1237 1329
1238 glDisable GL_TEXTURE_2D; 1330 glDisable GL_TEXTURE_2D;
1239 1331
1240 $child->draw; 1332 $child->draw;
1241 1333
1242 if ($self->{title}) { 1334 if ($self->{title_widget}) {
1243 glTranslate 0, $border - $self->{h}; 1335 glTranslate 0, $border - $self->{h};
1244 $self->{title}->_draw; 1336 $self->{title_widget}->_draw;
1337
1338 glTranslate 0, - ($border - $self->{h});
1245 } 1339 }
1340
1341 $self->{close_button}->draw
1342 if $self->{close_button};
1246} 1343}
1247 1344
1248############################################################################# 1345#############################################################################
1249 1346
1250package CFClient::UI::Table; 1347package CFClient::UI::Table;
… …
1267sub children { 1364sub children {
1268 grep $_, map @$_, grep $_, @{ $_[0]{children} } 1365 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1269} 1366}
1270 1367
1271sub add { 1368sub add {
1272 my ($self, $x, $y, $child) = @_; 1369 my ($self) = shift;
1273 1370
1371 while (@_) {
1372 my ($x, $y, $child) = splice @_, 0, 3, ();
1274 $child->set_parent ($self); 1373 $child->set_parent ($self);
1275 $self->{children}[$y][$x] = $child; 1374 $self->{children}[$y][$x] = $child;
1375 }
1276 1376
1377 $self->{force_realloc} = 1;
1378 $self->{force_size_alloc} = 1;
1277 $self->realloc; 1379 $self->realloc;
1380}
1381
1382sub remove {
1383 my ($self, $child) = @_;
1384
1385 # TODO: not yet implemented
1278} 1386}
1279 1387
1280# TODO: move to container class maybe? send children a signal on removal? 1388# TODO: move to container class maybe? send children a signal on removal?
1281sub clear { 1389sub clear {
1282 my ($self) = @_; 1390 my ($self) = @_;
… …
1323 (sum @$ws), 1431 (sum @$ws),
1324 (sum @$hs), 1432 (sum @$hs),
1325 ) 1433 )
1326} 1434}
1327 1435
1328sub size_allocate { 1436sub invoke_size_allocate {
1329 my ($self, $w, $h) = @_; 1437 my ($self, $w, $h) = @_;
1330 1438
1331 my ($ws, $hs) = $self->get_wh; 1439 my ($ws, $hs) = $self->get_wh;
1332 1440
1333 my $req_w = (sum @$ws) || 1; 1441 my $req_w = (sum @$ws) || 1;
… …
1365 } 1473 }
1366 1474
1367 $y += $row_h; 1475 $y += $row_h;
1368 } 1476 }
1369 1477
1478 1
1370} 1479}
1371 1480
1372sub find_widget { 1481sub find_widget {
1373 my ($self, $x, $y) = @_; 1482 my ($self, $x, $y) = @_;
1374 1483
… …
1411 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1520 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1412 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1521 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1413 ) 1522 )
1414} 1523}
1415 1524
1416sub size_allocate { 1525sub invoke_size_allocate {
1417 my ($self, $w, $h) = @_; 1526 my ($self, $w, $h) = @_;
1418 1527
1419 my $space = $self->{vertical} ? $h : $w; 1528 my $space = $self->{vertical} ? $h : $w;
1420 my $children = $self->{children}; 1529 my @children = $self->visible_children;
1421 1530
1422 my @req; 1531 my @req;
1423 1532
1424 if ($self->{homogeneous}) { 1533 if ($self->{homogeneous}) {
1425 @req = ($space / (@$children || 1)) x @$children; 1534 @req = ($space / (@children || 1)) x @children;
1426 } else { 1535 } else {
1427 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children; 1536 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1428 my $req = List::Util::sum @req; 1537 my $req = List::Util::sum @req;
1429 1538
1430 if ($req > $space) { 1539 if ($req > $space) {
1431 # ah well, not enough space 1540 # ah well, not enough space
1432 $_ *= $space / $req for @req; 1541 $_ *= $space / $req for @req;
1433 } else { 1542 } else {
1434 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1; 1543 my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1435 1544
1436 $space = ($space - $req) / $expand; # remaining space to give away 1545 $space = ($space - $req) / $expand; # remaining space to give away
1437 1546
1438 $req[$_] += $space * $children->[$_]{expand} 1547 $req[$_] += $space * $children[$_]{expand}
1439 for 0 .. $#$children; 1548 for 0 .. $#children;
1440 } 1549 }
1441 } 1550 }
1442 1551
1443 CFClient::UI::harmonize \@req; 1552 CFClient::UI::harmonize \@req;
1444 1553
1445 my $pos = 0; 1554 my $pos = 0;
1446 for (0 .. $#$children) { 1555 for (0 .. $#children) {
1447 my $alloc = $req[$_]; 1556 my $alloc = $req[$_];
1448 $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));
1449 1558
1450 $pos += $alloc; 1559 $pos += $alloc;
1451 } 1560 }
1452 1561
1453 1 1562 1
… …
1526 } 1635 }
1527 1636
1528 $self 1637 $self
1529} 1638}
1530 1639
1531sub escape($) {
1532 local $_ = $_[0];
1533
1534 s/&/&amp;/g;
1535 s/>/&gt;/g;
1536 s/</&lt;/g;
1537
1538 $_
1539}
1540
1541sub update { 1640sub update {
1542 my ($self) = @_; 1641 my ($self) = @_;
1543 1642
1544 delete $self->{texture}; 1643 delete $self->{texture};
1545 $self->SUPER::update; 1644 $self->SUPER::update;
… …
1556 my ($self, $text) = @_; 1655 my ($self, $text) = @_;
1557 1656
1558 return if $self->{text} eq "T$text"; 1657 return if $self->{text} eq "T$text";
1559 $self->{text} = "T$text"; 1658 $self->{text} = "T$text";
1560 1659
1561 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1562 $self->{layout}->set_text ($text); 1660 $self->{layout}->set_text ($text);
1563 1661
1564 delete $self->{req_h}; 1662 delete $self->{size_req};
1565 $self->realloc; 1663 $self->realloc;
1566 $self->update; 1664 $self->update;
1567} 1665}
1568 1666
1569sub set_markup { 1667sub set_markup {
… …
1572 return if $self->{text} eq "M$markup"; 1670 return if $self->{text} eq "M$markup";
1573 $self->{text} = "M$markup"; 1671 $self->{text} = "M$markup";
1574 1672
1575 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1673 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1576 1674
1577 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1578 $self->{layout}->set_markup ($markup); 1675 $self->{layout}->set_markup ($markup);
1579 1676
1580 delete $self->{req_h}; 1677 delete $self->{size_req};
1581 $self->realloc; 1678 $self->realloc;
1582 $self->update; 1679 $self->update;
1583} 1680}
1584 1681
1585sub size_request { 1682sub size_request {
1586 my ($self) = @_; 1683 my ($self) = @_;
1587 1684
1588 if (exists $self->{req_h}) { 1685 $self->{size_req} ||= do {
1589 @$self{qw(req_w req_h)}
1590 } else {
1591 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1686 $self->{layout}->set_font ($self->{font}) if $self->{font};
1592 $self->{layout}->set_width ($self->{max_w} || -1); 1687 $self->{layout}->set_width ($self->{max_w} || -1);
1593 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1688 $self->{layout}->set_ellipsise ($self->{ellipsise});
1594 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1689 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1595 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1690 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1596 1691
1597 my ($w, $h) = $self->{layout}->size; 1692 my ($w, $h) = $self->{layout}->size;
1598 1693
1599 if (exists $self->{template}) { 1694 if (exists $self->{template}) {
1600 $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);
1601 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 1697 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1602 1698
1603 my ($w2, $h2) = $self->{template}->size; 1699 my ($w2, $h2) = $self->{template}->size;
1604 1700
1605 $w = List::Util::max $w, $w2; 1701 $w = List::Util::max $w, $w2;
1606 $h = List::Util::max $h, $h2; 1702 $h = List::Util::max $h, $h2;
1607 } 1703 }
1608 1704
1609 ($w, $h) 1705 [$w, $h]
1610 } 1706 };
1611}
1612 1707
1708 @{ $self->{size_req} }
1709}
1710
1711sub baseline_shift {
1712 $_[0]{layout}->descent
1713}
1714
1613sub size_allocate { 1715sub invoke_size_allocate {
1614 my ($self, $w, $h) = @_; 1716 my ($self, $w, $h) = @_;
1615 1717
1616 delete $self->{ox}; 1718 delete $self->{ox};
1617 1719
1618 delete $self->{texture} 1720 delete $self->{texture}
1619 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
1620} 1724}
1621 1725
1622sub set_fontsize { 1726sub set_fontsize {
1623 my ($self, $fontsize) = @_; 1727 my ($self, $fontsize) = @_;
1624 1728
1625 $self->{fontsize} = $fontsize; 1729 $self->{fontsize} = $fontsize;
1730 delete $self->{size_req};
1626 delete $self->{texture}; 1731 delete $self->{texture};
1627 1732
1628 $self->realloc; 1733 $self->realloc;
1629} 1734}
1630 1735
1736sub reconfigure {
1737 my ($self) = @_;
1738
1739 delete $self->{size_req};
1740 delete $self->{texture};
1741
1742 $self->SUPER::reconfigure;
1743}
1744
1631sub _draw { 1745sub _draw {
1632 my ($self) = @_; 1746 my ($self) = @_;
1633 1747
1634 $self->SUPER::_draw; # draw background, if applicable 1748 $self->SUPER::_draw; # draw background, if applicable
1635 1749
1636 my $tex = $self->{texture} ||= do { 1750 my $size = $self->{texture} ||= do {
1637 $self->{layout}->set_foreground (@{$self->{fg}}); 1751 $self->{layout}->set_foreground (@{$self->{fg}});
1638 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1752 $self->{layout}->set_font ($self->{font}) if $self->{font};
1639 $self->{layout}->set_width ($self->{w}); 1753 $self->{layout}->set_width ($self->{w});
1640 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1754 $self->{layout}->set_ellipsise ($self->{ellipsise});
1641 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1755 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1642 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1756 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1643 1757
1644 new_from_layout CFClient::Texture $self->{layout} 1758 [$self->{layout}->size]
1645 }; 1759 };
1646 1760
1647 unless (exists $self->{ox}) { 1761 unless (exists $self->{ox}) {
1648 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} 1762 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1649 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x} 1763 : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1650 : ($self->{w} - $tex->{w}) * 0.5); 1764 : ($self->{w} - $size->[0]) * 0.5);
1651 1765
1652 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 1766 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1653 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y} 1767 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1654 : ($self->{h} - $tex->{h}) * 0.5); 1768 : ($self->{h} - $size->[1]) * 0.5);
1655 }; 1769 };
1656 1770
1657 glEnable GL_TEXTURE_2D; 1771 my $w = List::Util::min $self->{w} + 4, $size->[0];
1772 my $h = List::Util::min $self->{h} + 2, $size->[1];
1658 1773
1659 if ($tex->{format} == GL_ALPHA) { 1774 $self->{layout}->render ($self->{ox}, $self->{oy});
1660 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1661 glColor @{$self->{fg}};
1662 $tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1663 } else {
1664 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1665 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1666 }
1667
1668 glDisable GL_TEXTURE_2D;
1669} 1775}
1670 1776
1671############################################################################# 1777#############################################################################
1672 1778
1673package CFClient::UI::EntryBase; 1779package CFClient::UI::EntryBase;
… …
1687 can_hover => 1, 1793 can_hover => 1,
1688 can_focus => 1, 1794 can_focus => 1,
1689 valign => 0, 1795 valign => 0,
1690 can_events => 1, 1796 can_events => 1,
1691 #text => ... 1797 #text => ...
1798 #hidden => "*",
1692 @_ 1799 @_
1693 ) 1800 )
1694} 1801}
1695 1802
1696sub _set_text { 1803sub _set_text {
… …
1703 $self->{last_activity} = $::NOW; 1810 $self->{last_activity} = $::NOW;
1704 $self->{text} = $text; 1811 $self->{text} = $text;
1705 1812
1706 $text =~ s/./*/g if $self->{hidden}; 1813 $text =~ s/./*/g if $self->{hidden};
1707 $self->{layout}->set_text ("$text "); 1814 $self->{layout}->set_text ("$text ");
1708 delete $self->{req_h}; 1815 delete $self->{size_req};
1709 1816
1710 $self->_emit (changed => $self->{text}); 1817 $self->emit (changed => $self->{text});
1711 1818
1712 $self->realloc; 1819 $self->realloc;
1713 $self->update; 1820 $self->update;
1714} 1821}
1715 1822
… …
1730 my ($w, $h) = $self->SUPER::size_request; 1837 my ($w, $h) = $self->SUPER::size_request;
1731 1838
1732 ($w + 1, $h) # add 1 for cursor 1839 ($w + 1, $h) # add 1 for cursor
1733} 1840}
1734 1841
1735sub key_down { 1842sub invoke_key_down {
1736 my ($self, $ev) = @_; 1843 my ($self, $ev) = @_;
1737 1844
1738 my $mod = $ev->{mod}; 1845 my $mod = $ev->{mod};
1739 my $sym = $ev->{sym}; 1846 my $sym = $ev->{sym};
1740 my $uni = $ev->{unicode}; 1847 my $uni = $ev->{unicode};
… …
1752 } elsif ($sym == CFClient::SDLK_HOME) { 1859 } elsif ($sym == CFClient::SDLK_HOME) {
1753 $self->{cursor} = 0; 1860 $self->{cursor} = 0;
1754 } elsif ($sym == CFClient::SDLK_END) { 1861 } elsif ($sym == CFClient::SDLK_END) {
1755 $self->{cursor} = length $text; 1862 $self->{cursor} = length $text;
1756 } elsif ($uni == 27) { 1863 } elsif ($uni == 27) {
1757 $self->_emit ('escape'); 1864 $self->emit ('escape');
1758 } elsif ($uni) { 1865 } elsif ($uni) {
1759 substr $text, $self->{cursor}++, 0, chr $uni; 1866 substr $text, $self->{cursor}++, 0, chr $uni;
1760 } else { 1867 } else {
1761 return 0; 1868 return 0;
1762 } 1869 }
… …
1766 $self->realloc; 1873 $self->realloc;
1767 1874
1768 1 1875 1
1769} 1876}
1770 1877
1771sub focus_in { 1878sub invoke_focus_in {
1772 my ($self) = @_; 1879 my ($self) = @_;
1773 1880
1774 $self->{last_activity} = $::NOW; 1881 $self->{last_activity} = $::NOW;
1775 1882
1776 $self->SUPER::focus_in; 1883 $self->SUPER::invoke_focus_in
1777} 1884}
1778 1885
1779sub button_down { 1886sub invoke_button_down {
1780 my ($self, $ev, $x, $y) = @_; 1887 my ($self, $ev, $x, $y) = @_;
1781 1888
1782 $self->SUPER::button_down ($ev, $x, $y); 1889 $self->SUPER::invoke_button_down ($ev, $x, $y);
1783 1890
1784 my $idx = $self->{layout}->xy_to_index ($x, $y); 1891 my $idx = $self->{layout}->xy_to_index ($x, $y);
1785 1892
1786 # byte-index to char-index 1893 # byte-index to char-index
1787 my $text = $self->{text}; 1894 my $text = $self->{text};
1788 utf8::encode $text; 1895 utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1789 $self->{cursor} = length substr $text, 0, $idx; 1896 $self->{cursor} = length $text;
1790 1897
1791 $self->_set_text ($self->{text}); 1898 $self->_set_text ($self->{text});
1792 $self->update; 1899 $self->update;
1793 1900
1794 1 1901 1
1795} 1902}
1796 1903
1797sub mouse_motion { 1904sub invoke_mouse_motion {
1798 my ($self, $ev, $x, $y) = @_; 1905 my ($self, $ev, $x, $y) = @_;
1799# 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#
1800 1907
1801 0 1908 1
1802} 1909}
1803 1910
1804sub _draw { 1911sub _draw {
1805 my ($self) = @_; 1912 my ($self) = @_;
1806 1913
… …
1847 1954
1848our @ISA = CFClient::UI::EntryBase::; 1955our @ISA = CFClient::UI::EntryBase::;
1849 1956
1850use CFClient::OpenGL; 1957use CFClient::OpenGL;
1851 1958
1852sub key_down { 1959sub invoke_key_down {
1853 my ($self, $ev) = @_; 1960 my ($self, $ev) = @_;
1854 1961
1855 my $sym = $ev->{sym}; 1962 my $sym = $ev->{sym};
1856 1963
1857 if ($sym == 13) { 1964 if ($sym == 13) {
1858 unshift @{$self->{history}}, 1965 unshift @{$self->{history}},
1859 my $txt = $self->get_text; 1966 my $txt = $self->get_text;
1967
1860 $self->{history_pointer} = -1; 1968 $self->{history_pointer} = -1;
1861 $self->{history_saveback} = ''; 1969 $self->{history_saveback} = '';
1862 $self->_emit (activate => $txt); 1970 $self->emit (activate => $txt);
1863 $self->update; 1971 $self->update;
1864 1972
1865 } elsif ($sym == CFClient::SDLK_UP) { 1973 } elsif ($sym == CFClient::SDLK_UP) {
1866 if ($self->{history_pointer} < 0) { 1974 if ($self->{history_pointer} < 0) {
1867 $self->{history_saveback} = $self->get_text; 1975 $self->{history_saveback} = $self->get_text;
… …
1883 } else { 1991 } else {
1884 $self->set_text ($self->{history_saveback}); 1992 $self->set_text ($self->{history_saveback});
1885 } 1993 }
1886 1994
1887 } else { 1995 } else {
1888 return $self->SUPER::key_down ($ev) 1996 return $self->SUPER::invoke_key_down ($ev)
1889 } 1997 }
1890 1998
1891 1 1999 1
1892} 2000}
1893 2001
… …
1917 can_events => 1, 2025 can_events => 1,
1918 @_ 2026 @_
1919 ) 2027 )
1920} 2028}
1921 2029
1922sub activate { }
1923
1924sub button_up { 2030sub invoke_button_up {
1925 my ($self, $ev, $x, $y) = @_; 2031 my ($self, $ev, $x, $y) = @_;
1926 2032
1927 $self->emit ("activate") 2033 $self->emit ("activate")
1928 if $x >= 0 && $x < $self->{w} 2034 if $x >= 0 && $x < $self->{w}
1929 && $y >= 0 && $y < $self->{h}; 2035 && $y >= 0 && $y < $self->{h};
… …
1943 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 2049 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1944 2050
1945 glDisable GL_TEXTURE_2D; 2051 glDisable GL_TEXTURE_2D;
1946 2052
1947 $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
1948} 2090}
1949 2091
1950############################################################################# 2092#############################################################################
1951 2093
1952package CFClient::UI::CheckBox; 2094package CFClient::UI::CheckBox;
… …
1979 my ($self) = @_; 2121 my ($self) = @_;
1980 2122
1981 (6) x 2 2123 (6) x 2
1982} 2124}
1983 2125
2126sub toggle {
2127 my ($self) = @_;
2128
2129 $self->{state} = !$self->{state};
2130 $self->emit (changed => $self->{state});
2131 $self->update;
2132}
2133
1984sub button_down { 2134sub invoke_button_down {
1985 my ($self, $ev, $x, $y) = @_; 2135 my ($self, $ev, $x, $y) = @_;
1986 2136
1987 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2137 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1988 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2138 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1989 $self->{state} = !$self->{state}; 2139 $self->toggle;
1990 $self->_emit (changed => $self->{state});
1991 } else { 2140 } else {
1992 return 0 2141 return 0
1993 } 2142 }
1994 2143
1995 1 2144 1
… …
2020package CFClient::UI::Image; 2169package CFClient::UI::Image;
2021 2170
2022our @ISA = CFClient::UI::Base::; 2171our @ISA = CFClient::UI::Base::;
2023 2172
2024use CFClient::OpenGL; 2173use CFClient::OpenGL;
2025use Carp qw/confess/;
2026 2174
2027our %loaded_images; 2175our %texture_cache;
2028 2176
2029sub new { 2177sub new {
2030 my $class = shift; 2178 my $class = shift;
2031 2179
2032 my $self = $class->SUPER::new (can_events => 0, @_); 2180 my $self = $class->SUPER::new (
2181 can_events => 0,
2182 @_,
2183 );
2033 2184
2034 $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";
2035 2187
2036 $loaded_images{$self->{image}} ||= 2188 $self->{tex} ||= $texture_cache{$self->{path}} ||=
2037 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;
2038 2190
2039 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2191 Scalar::Util::weaken $texture_cache{$self->{path}};
2040 2192
2041 Scalar::Util::weaken $loaded_images{$self->{image}}; 2193 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2042
2043 $self->{aspect} = $tex->{w} / $tex->{h};
2044 2194
2045 $self 2195 $self
2046} 2196}
2047 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
2048sub size_request { 2216sub size_request {
2049 my ($self) = @_; 2217 my ($self) = @_;
2050 2218
2051 ($self->{tex}->{w}, $self->{tex}->{h}) 2219 ($self->{tex}{w}, $self->{tex}{h})
2052} 2220}
2053 2221
2054sub _draw { 2222sub _draw {
2055 my ($self) = @_; 2223 my ($self) = @_;
2056 2224
… …
2066 } 2234 }
2067 2235
2068 glEnable GL_TEXTURE_2D; 2236 glEnable GL_TEXTURE_2D;
2069 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2237 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2070 2238
2071 $tex->draw_quad_alpha (0, 0, $w, $h); 2239 $tex->draw_quad (0, 0, $w, $h);
2072 2240
2073 glDisable GL_TEXTURE_2D; 2241 glDisable GL_TEXTURE_2D;
2074} 2242}
2075 2243
2076############################################################################# 2244#############################################################################
… …
2165 my $ycut1 = max 0, min 1, $ycut; 2333 my $ycut1 = max 0, min 1, $ycut;
2166 my $ycut2 = max 0, min 1, $ycut - 1; 2334 my $ycut2 = max 0, min 1, $ycut - 1;
2167 2335
2168 my $h1 = $self->{h} * (1 - $ycut1); 2336 my $h1 = $self->{h} * (1 - $ycut1);
2169 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);
2170 2341
2171 glEnable GL_BLEND; 2342 glEnable GL_BLEND;
2172 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA, 2343 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2173 GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2344 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2174 glEnable GL_TEXTURE_2D; 2345 glEnable GL_TEXTURE_2D;
… …
2193 2364
2194 if ($t3) { 2365 if ($t3) {
2195 glBindTexture GL_TEXTURE_2D, $t3->{name}; 2366 glBindTexture GL_TEXTURE_2D, $t3->{name};
2196 glBegin GL_QUADS; 2367 glBegin GL_QUADS;
2197 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2; 2368 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2198 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h}; 2369 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2199 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h}; 2370 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2200 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2; 2371 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2201 glEnd; 2372 glEnd;
2202 } 2373 }
2203 2374
2204 glDisable GL_BLEND; 2375 glDisable GL_BLEND;
… …
2292 $self->update; 2463 $self->update;
2293 2464
2294 $self 2465 $self
2295} 2466}
2296 2467
2297sub changed { }
2298
2299sub set_range { 2468sub set_range {
2300 my ($self, $range) = @_; 2469 my ($self, $range) = @_;
2301 2470
2302 ($range, $self->{range}) = ($self->{range}, $range); 2471 ($range, $self->{range}) = ($self->{range}, $range);
2303 2472
2304 $self->update
2305 if "@$range" ne "@{$self->{range}}"; 2473 if ("@$range" ne "@{$self->{range}}") {
2474 $self->update;
2475 $self->set_value ($self->{range}[0]);
2476 }
2306} 2477}
2307 2478
2308sub set_value { 2479sub set_value {
2309 my ($self, $value) = @_; 2480 my ($self, $value) = @_;
2310 2481
… …
2321 if $unit; 2492 if $unit;
2322 2493
2323 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2494 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2324 2495
2325 if ($value != $old_value) { 2496 if ($value != $old_value) {
2326 $self->_emit (changed => $value); 2497 $self->emit (changed => $value);
2327 $self->update; 2498 $self->update;
2328 } 2499 }
2329} 2500}
2330 2501
2331sub size_request { 2502sub size_request {
2332 my ($self) = @_; 2503 my ($self) = @_;
2333 2504
2334 ($self->{req_w}, $self->{req_h}) 2505 ($self->{req_w}, $self->{req_h})
2335} 2506}
2336 2507
2337sub button_down { 2508sub invoke_button_down {
2338 my ($self, $ev, $x, $y) = @_; 2509 my ($self, $ev, $x, $y) = @_;
2339 2510
2340 $self->SUPER::button_down ($ev, $x, $y); 2511 $self->SUPER::invoke_button_down ($ev, $x, $y);
2341 2512
2342 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2513 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2343 2514
2344 $self->mouse_motion ($ev, $x, $y) 2515 $self->invoke_mouse_motion ($ev, $x, $y)
2345} 2516}
2346 2517
2347sub mouse_motion { 2518sub invoke_mouse_motion {
2348 my ($self, $ev, $x, $y) = @_; 2519 my ($self, $ev, $x, $y) = @_;
2349 2520
2350 if ($GRAB == $self) { 2521 if ($GRAB == $self) {
2351 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2522 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2352 2523
… …
2358 } else { 2529 } else {
2359 return 0; 2530 return 0;
2360 } 2531 }
2361 2532
2362 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
2363} 2544}
2364 2545
2365sub update { 2546sub update {
2366 my ($self) = @_; 2547 my ($self) = @_;
2367 2548
… …
2457sub set_range { shift->{slider}->set_range (@_) } 2638sub set_range { shift->{slider}->set_range (@_) }
2458sub set_value { shift->{slider}->set_value (@_) } 2639sub set_value { shift->{slider}->set_value (@_) }
2459 2640
2460############################################################################# 2641#############################################################################
2461 2642
2462package CFClient::UI::TextView; 2643package CFClient::UI::TextScroller;
2463 2644
2464our @ISA = CFClient::UI::HBox::; 2645our @ISA = CFClient::UI::HBox::;
2465 2646
2466use CFClient::OpenGL; 2647use CFClient::OpenGL;
2467 2648
2468sub new { 2649sub new {
2469 my $class = shift; 2650 my $class = shift;
2470 2651
2471 my $self = $class->SUPER::new ( 2652 my $self = $class->SUPER::new (
2472 fontsize => 1, 2653 fontsize => 1,
2473 can_events => 0, 2654 can_events => 1,
2655 indent => 0,
2474 #font => default_font 2656 #font => default_font
2475 @_, 2657 @_,
2476 2658
2477 layout => (new CFClient::Layout 1), 2659 layout => (new CFClient::Layout),
2478 par => [], 2660 par => [],
2479 height => 0, 2661 height => 0,
2480 children => [ 2662 children => [
2481 (new CFClient::UI::Empty expand => 1), 2663 (new CFClient::UI::Empty expand => 1),
2482 (new CFClient::UI::Slider vertical => 1), 2664 (new CFClient::UI::Slider vertical => 1),
… …
2493 2675
2494 $self->{fontsize} = $fontsize; 2676 $self->{fontsize} = $fontsize;
2495 $self->reflow; 2677 $self->reflow;
2496} 2678}
2497 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
2498sub size_allocate { 2689sub invoke_size_allocate {
2499 my ($self, $w, $h) = @_; 2690 my ($self, $w, $h) = @_;
2500 2691
2501 $self->SUPER::size_allocate ($w, $h); 2692 my ($empty, $slider, @other) = @{ $self->{children} };
2693 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2502 2694
2503 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2695 $self->{layout}->set_font ($self->{font}) if $self->{font};
2504 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2696 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2505 $self->{layout}->set_width ($self->{children}[0]{w}); 2697 $self->{layout}->set_width ($empty->{w});
2698 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2506 2699
2507 $self->reflow; 2700 $self->reflow;
2508}
2509 2701
2510sub text_size { 2702 local $self->{children} = [$empty, $slider];
2703 $self->SUPER::invoke_size_allocate ($w, $h)
2704}
2705
2706sub invoke_mouse_wheel {
2511 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) = @_;
2512 2718
2513 my $layout = $self->{layout}; 2719 my $layout = $self->{layout};
2514 2720
2721 $layout->set_font ($self->{font}) if $self->{font};
2722 $layout->set_foreground (@{$para->{fg}});
2515 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2723 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2516 $layout->set_width ($self->{children}[0]{w} - $indent); 2724 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2725 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2517 $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}}
2518 2732 );
2733
2519 $layout->size 2734 $layout
2520} 2735}
2521 2736
2522sub reflow { 2737sub reflow {
2523 my ($self) = @_; 2738 my ($self) = @_;
2524 2739
… …
2533 $self->{children}[1]->set_value ($offset); 2748 $self->{children}[1]->set_value ($offset);
2534} 2749}
2535 2750
2536sub clear { 2751sub clear {
2537 my ($self) = @_; 2752 my ($self) = @_;
2753
2754 my (undef, undef, @other) = @{ $self->{children} };
2755 $self->remove ($_) for @other;
2538 2756
2539 $self->{par} = []; 2757 $self->{par} = [];
2540 $self->{height} = 0; 2758 $self->{height} = 0;
2541 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2759 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2542} 2760}
2543 2761
2544sub add_paragraph { 2762sub add_paragraph {
2545 my ($self, $color, $text, $indent) = @_; 2763 my ($self, $color, $para, $indent) = @_;
2546 2764
2547 for my $line (split /\n/, $text) { 2765 my ($text, @w) = ref $para ? @$para : $para;
2548 my ($w, $h) = $self->text_size ($line); 2766
2549 $self->{height} += $h; 2767 $para = {
2550 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,
2551 } 2774 };
2552 2775
2553 $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;
2554} 2788}
2555 2789
2556sub update { 2790sub update {
2557 my ($self) = @_; 2791 my ($self) = @_;
2558 2792
… …
2560 2794
2561 return unless $self->{h} > 0; 2795 return unless $self->{h} > 0;
2562 2796
2563 delete $self->{texture}; 2797 delete $self->{texture};
2564 2798
2565 $ROOT->on_post_alloc ($self, sub { 2799 $ROOT->on_post_alloc ($self => sub {
2566 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2800 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2567 2801
2568 if (delete $self->{need_reflow}) { 2802 if (delete $self->{need_reflow}) {
2569 my $height = 0; 2803 my $height = 0;
2570 2804
2571 my $layout = $self->{layout};
2572
2573 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2574
2575 for (@{$self->{par}}) { 2805 for my $para (@{$self->{par}}) {
2576 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2806 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2577 $layout->set_width ($W - $_->[3]); 2807 my $layout = $self->get_layout ($para);
2578 $layout->set_markup ($_->[4]);
2579 my ($w, $h) = $layout->size; 2808 my ($w, $h) = $layout->size;
2580 $_->[0] = $w + $_->[3]; 2809
2581 $_->[1] = $h; 2810 $para->{w} = $w + $para->{indent};
2811 $para->{h} = $h;
2812 $para->{wrapped} = $layout->has_wrapped;
2582 } 2813 }
2583 2814
2584 $height += $_->[1]; 2815 $height += $para->{h};
2585 } 2816 }
2586 2817
2587 $self->{height} = $height; 2818 $self->{height} = $height;
2588 2819
2589 $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]);
2590 2821
2591 delete $self->{texture}; 2822 delete $self->{texture};
2823 }
2824
2825 if (delete $self->{scroll_to_bottom}) {
2826 $self->{children}[1]->set_value (1e10);
2592 } 2827 }
2593 2828
2594 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2829 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2595 glClearColor 0, 0, 0, 0; 2830 glClearColor 0, 0, 0, 0;
2596 glClear GL_COLOR_BUFFER_BIT; 2831 glClear GL_COLOR_BUFFER_BIT;
… …
2600 my $y0 = $top; 2835 my $y0 = $top;
2601 my $y1 = $top + $H; 2836 my $y1 = $top + $H;
2602 2837
2603 my $y = 0; 2838 my $y = 0;
2604 2839
2605 my $layout = $self->{layout};
2606
2607 $layout->set_font ($self->{font}) if $self->{font};
2608
2609 glEnable GL_BLEND;
2610 #TODO# not correct in windows where rgba is forced off
2611 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2612
2613 for my $par (@{$self->{par}}) { 2840 for my $para (@{$self->{par}}) {
2614 my $h = $par->[1]; 2841 my $h = $para->{h};
2615 2842
2616 if ($y0 < $y + $h && $y < $y1) { 2843 if ($y0 < $y + $h && $y < $y1) {
2617 $layout->set_foreground (@{ $par->[2] });
2618 $layout->set_width ($W - $par->[3]);
2619 $layout->set_markup ($par->[4]);
2620 2844
2621 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2845 my $layout = $self->get_layout ($para);
2622 2846
2623 glRasterPos $par->[3], $y - $y0; 2847 $layout->render ($para->{indent}, $y - $y0);
2624 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 }
2625 } 2861 }
2626 2862
2627 $y += $h; 2863 $y += $h;
2628 } 2864 }
2629
2630 glDisable GL_BLEND;
2631 }; 2865 };
2632 }); 2866 });
2867}
2868
2869sub reconfigure {
2870 my ($self) = @_;
2871
2872 $self->SUPER::reconfigure;
2873
2874 $_->{w} = 1e10 for @{ $self->{par} };
2875 $self->reflow;
2633} 2876}
2634 2877
2635sub _draw { 2878sub _draw {
2636 my ($self) = @_; 2879 my ($self) = @_;
2637 2880
… …
2640 glColor 0, 0, 0, 1; 2883 glColor 0, 0, 0, 1;
2641 $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});
2642 glDisable GL_TEXTURE_2D; 2885 glDisable GL_TEXTURE_2D;
2643 2886
2644 $self->{children}[1]->draw; 2887 $self->{children}[1]->draw;
2645
2646} 2888}
2647 2889
2648############################################################################# 2890#############################################################################
2649 2891
2650package CFClient::UI::Animator; 2892package CFClient::UI::Animator;
… …
2737 $tooltip .= "\n\n" . (ref $widget) . "\n" 2979 $tooltip .= "\n\n" . (ref $widget) . "\n"
2738 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" 2980 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2739 . "req $widget->{req_w} $widget->{req_h}\n" 2981 . "req $widget->{req_w} $widget->{req_h}\n"
2740 . "visible $widget->{visible}"; 2982 . "visible $widget->{visible}";
2741 } 2983 }
2984
2985 $tooltip =~ s/^\n+//;
2986 $tooltip =~ s/\n+$//;
2742 2987
2743 $self->add (new CFClient::UI::Label 2988 $self->add (new CFClient::UI::Label
2744 markup => $tooltip, 2989 markup => $tooltip,
2745 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2990 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2746 fontsize => 0.8, 2991 fontsize => 0.8,
… …
2756 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 3001 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2757 3002
2758 ($w + 4, $h + 4) 3003 ($w + 4, $h + 4)
2759} 3004}
2760 3005
2761sub size_allocate { 3006sub invoke_size_allocate {
2762 my ($self, $w, $h) = @_; 3007 my ($self, $w, $h) = @_;
2763 3008
2764 $self->SUPER::size_allocate ($w - 4, $h - 4); 3009 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2765} 3010}
2766 3011
2767sub visibility_change { 3012sub invoke_visibility_change {
2768 my ($self, $visible) = @_; 3013 my ($self, $visible) = @_;
2769 3014
2770 return unless $visible; 3015 return unless $visible;
2771 3016
2772 $self->{root}->on_post_alloc ("move_$self" => sub { 3017 $self->{root}->on_post_alloc ("move_$self" => sub {
2773 my $widget = $self->{owner} 3018 my $widget = $self->{owner}
2774 or return; 3019 or return;
2775 3020
3021 if ($widget->{visible}) {
2776 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 3022 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2777 3023
2778 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 3024 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2779 if $x + $self->{w} > $::WIDTH; 3025 if $x + $self->{w} > $self->{root}{w};
2780 3026
2781 $self->move_abs ($x, $y); 3027 $self->move_abs ($x, $y);
3028 } else {
3029 $self->hide;
3030 }
2782 }); 3031 });
2783} 3032}
2784 3033
2785sub _draw { 3034sub _draw {
2786 my ($self) = @_; 3035 my ($self) = @_;
… …
2879 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3128 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2880 glDisable GL_TEXTURE_2D; 3129 glDisable GL_TEXTURE_2D;
2881 } 3130 }
2882} 3131}
2883 3132
2884sub DESTROY { 3133sub destroy {
2885 my ($self) = @_; 3134 my ($self) = @_;
2886 3135
2887 $self->{timer}->cancel 3136 $self->{timer}->cancel
2888 if $self->{timer}; 3137 if $self->{timer};
2889 3138
2890 $self->SUPER::DESTROY; 3139 $self->SUPER::destroy;
2891} 3140}
2892 3141
2893############################################################################# 3142#############################################################################
2894 3143
2895package CFClient::UI::Buttonbar; 3144package CFClient::UI::Buttonbar;
… …
2916 ); 3165 );
2917 3166
2918 $self->add ($self->{vbox} = new CFClient::UI::VBox); 3167 $self->add ($self->{vbox} = new CFClient::UI::VBox);
2919 3168
2920 for my $item (@{ $self->{items} }) { 3169 for my $item (@{ $self->{items} }) {
2921 my ($widget, $cb) = @$item; 3170 my ($widget, $cb, $tooltip) = @$item;
2922 3171
2923 # handle various types of items, only text for now 3172 # handle various types of items, only text for now
2924 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 {
2925 $widget = new CFClient::UI::Label 3188 $widget = new CFClient::UI::Label
2926 can_hover => 1, 3189 can_hover => 1,
2927 can_events => 1, 3190 can_events => 1,
2928 text => $widget; 3191 markup => $widget,
3192 tooltip => $tooltip;
3193 }
2929 } 3194 }
2930 3195
2931 $self->{item}{$widget} = $item; 3196 $self->{item}{$widget} = $item;
2932 3197
2933 $self->{vbox}->add ($widget); 3198 $self->{vbox}->add ($widget);
… …
2938 3203
2939# 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)
2940sub popup { 3205sub popup {
2941 my ($self, $ev) = @_; 3206 my ($self, $ev) = @_;
2942 3207
2943 $self->_emit ("popdown"); 3208 $self->emit ("popdown");
2944 3209
2945 # maybe save $GRAB? must be careful about events... 3210 # maybe save $GRAB? must be careful about events...
2946 $GRAB = $self; 3211 $GRAB = $self;
2947 $self->{button} = $ev->{button}; 3212 $self->{button} = $ev->{button};
2948 3213
2949 $self->show; 3214 $self->show;
2950 $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);
2951} 3216}
2952 3217
2953sub mouse_motion { 3218sub invoke_mouse_motion {
2954 my ($self, $ev, $x, $y) = @_; 3219 my ($self, $ev, $x, $y) = @_;
2955 3220
2956 # TODO: should use vbox->find_widget or so 3221 # TODO: should use vbox->find_widget or so
2957 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3222 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2958 $self->{hover} = $self->{item}{$HOVER}; 3223 $self->{hover} = $self->{item}{$HOVER};
2959 3224
2960 0 3225 0
2961} 3226}
2962 3227
2963sub button_up { 3228sub invoke_button_up {
2964 my ($self, $ev, $x, $y) = @_; 3229 my ($self, $ev, $x, $y) = @_;
2965 3230
2966 if ($ev->{button} == $self->{button}) { 3231 if ($ev->{button} == $self->{button}) {
2967 undef $GRAB; 3232 undef $GRAB;
2968 $self->hide; 3233 $self->hide;
2969 3234
2970 $self->_emit ("popdown"); 3235 $self->emit ("popdown");
2971 $self->{hover}[1]->() if $self->{hover}; 3236 $self->{hover}[1]->() if $self->{hover};
2972 } else { 3237 } else {
2973 return 0 3238 return 0
2974 } 3239 }
2975 3240
… …
3002 3267
3003 $self->{current} = $self->{children}[0] 3268 $self->{current} = $self->{children}[0]
3004 if @{ $self->{children} }; 3269 if @{ $self->{children} };
3005} 3270}
3006 3271
3272sub get_current_page {
3273 my ($self) = @_;
3274
3275 $self->{current}
3276}
3277
3007sub set_current_page { 3278sub set_current_page {
3008 my ($self, $page_or_widget) = @_; 3279 my ($self, $page_or_widget) = @_;
3009 3280
3010 my $widget = ref $page_or_widget 3281 my $widget = ref $page_or_widget
3011 ? $page_or_widget 3282 ? $page_or_widget
3012 : $self->{children}[$page_or_widget]; 3283 : $self->{children}[$page_or_widget];
3013 3284
3014 $self->{current} = $widget; 3285 $self->{current} = $widget;
3015 $self->{current}->configure (0, 0, $self->{w}, $self->{h}); 3286 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3016 3287
3017 $self->_emit (page_changed => $self->{current}); 3288 $self->emit (page_changed => $self->{current});
3018 3289
3019 $self->realloc; 3290 $self->realloc;
3020} 3291}
3021 3292
3022sub visible_children { 3293sub visible_children {
… …
3027 my ($self) = @_; 3298 my ($self) = @_;
3028 3299
3029 $self->{current}->size_request 3300 $self->{current}->size_request
3030} 3301}
3031 3302
3032sub size_allocate { 3303sub invoke_size_allocate {
3033 my ($self, $w, $h) = @_; 3304 my ($self, $w, $h) = @_;
3034 3305
3035 $self->{current}->configure (0, 0, $w, $h); 3306 $self->{current}->configure (0, 0, $w, $h);
3307
3308 1
3036} 3309}
3037 3310
3038sub _draw { 3311sub _draw {
3039 my ($self) = @_; 3312 my ($self) = @_;
3040 3313
… …
3075 ); 3348 );
3076 3349
3077 $self->{multiplexer}->add ($widget); 3350 $self->{multiplexer}->add ($widget);
3078} 3351}
3079 3352
3353sub get_current_page {
3354 my ($self) = @_;
3355
3356 $self->{multiplexer}->get_current_page
3357}
3358
3080sub set_current_page { 3359sub set_current_page {
3081 my ($self, $page) = @_; 3360 my ($self, $page) = @_;
3082 3361
3083 $self->{multiplexer}->set_current_page ($page); 3362 $self->{multiplexer}->set_current_page ($page);
3084 $self->_emit (page_changed => $self->{multiplexer}{current}); 3363 $self->emit (page_changed => $self->{multiplexer}{current});
3364}
3365
3366#############################################################################
3367
3368package CFClient::UI::Combobox;
3369
3370use utf8;
3371
3372our @ISA = CFClient::UI::Button::;
3373
3374sub new {
3375 my $class = shift;
3376
3377 my $self = $class->SUPER::new (
3378 options => [], # [value, title, longdesc], ...
3379 value => undef,
3380 @_,
3381 );
3382
3383 $self->_set_value ($self->{value});
3384
3385 $self
3386}
3387
3388sub invoke_button_down {
3389 my ($self, $ev) = @_;
3390
3391 my @menu_items;
3392
3393 for (@{ $self->{options} }) {
3394 my ($value, $title, $tooltip) = @$_;
3395
3396 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3397 }
3398
3399 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
3400}
3401
3402sub _set_value {
3403 my ($self, $value) = @_;
3404
3405 my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
3406 or return;
3407
3408 $self->{value} = $item->[0];
3409 $self->set_markup ("$item->[1] ⇓");
3410 $self->set_tooltip ($item->[2]);
3411}
3412
3413sub set_value {
3414 my ($self, $value) = @_;
3415
3416 return unless $self->{value} ne $value;
3417
3418 $self->_set_value ($value);
3419 $self->emit (changed => $value);
3085} 3420}
3086 3421
3087############################################################################# 3422#############################################################################
3088 3423
3089package CFClient::UI::Statusbox; 3424package CFClient::UI::Statusbox;
… …
3188 $item->{count}++; 3523 $item->{count}++;
3189 } else { 3524 } else {
3190 $item->{count} = 1; 3525 $item->{count} = 1;
3191 $item->{text} = $item->{tooltip} = $text; 3526 $item->{text} = $item->{tooltip} = $text;
3192 } 3527 }
3193 $item->{id} = ++$self->{id}; 3528 $item->{id} += 0.2;#d#
3194 $item->{timeout} = $timeout; 3529 $item->{timeout} = $timeout;
3195 delete $item->{label}; 3530 delete $item->{label};
3196 } else { 3531 } else {
3197 $self->{item}{$group} = { 3532 $self->{item}{$group} = {
3198 id => ++$self->{id}, 3533 id => ++$self->{id},
… …
3204 count => 1, 3539 count => 1,
3205 %arg, 3540 %arg,
3206 }; 3541 };
3207 } 3542 }
3208 3543
3544 $ROOT->on_refresh (reorder => sub {
3209 $self->reorder; 3545 $self->reorder;
3546 });
3210} 3547}
3211 3548
3212sub reconfigure { 3549sub reconfigure {
3213 my ($self) = @_; 3550 my ($self) = @_;
3214 3551
… …
3217 3554
3218 $self->reorder; 3555 $self->reorder;
3219 $self->SUPER::reconfigure; 3556 $self->SUPER::reconfigure;
3220} 3557}
3221 3558
3222sub DESTROY { 3559sub destroy {
3223 my ($self) = @_; 3560 my ($self) = @_;
3224 3561
3225 $self->{timer}->cancel; 3562 $self->{timer}->cancel;
3226 3563
3227 $self->SUPER::DESTROY; 3564 $self->SUPER::destroy;
3228} 3565}
3229 3566
3230############################################################################# 3567#############################################################################
3231 3568
3232package CFClient::UI::Inventory; 3569package CFClient::UI::Inventory;
3233 3570
3234our @ISA = CFClient::UI::ScrolledWindow::; 3571our @ISA = CFClient::UI::Table::;
3235 3572
3236sub new { 3573sub new {
3237 my $class = shift; 3574 my $class = shift;
3238 3575
3239 my $self = $class->SUPER::new ( 3576 my $self = $class->SUPER::new (
3240 child => (new CFClient::UI::Table col_expand => [0, 1, 0]), 3577 col_expand => [0, 1, 0],
3578 items => [],
3241 @_, 3579 @_,
3242 ); 3580 );
3243 3581
3582 $self->set_sort_order (undef);
3583
3244 $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;
3245} 3620}
3246 3621
3247sub set_items { 3622sub set_items {
3248 my ($self, $items) = @_; 3623 my ($self, $items) = @_;
3249 3624
3250 $self->{child}->clear; 3625 $self->{items} = [$items ? values %$items : ()];
3251 return unless $items;
3252
3253 my @items = sort {
3254 ($a->{type} <=> $b->{type})
3255 or ($a->{name} cmp $b->{name})
3256 } @$items;
3257
3258 $self->{real_items} = \@items;
3259
3260 my $row = 0;
3261 for my $item (@items) {
3262 CFClient::Item::update_widgets $item;
3263
3264 $self->{child}->add (0, $row, $item->{face_widget});
3265 $self->{child}->add (1, $row, $item->{desc_widget});
3266 $self->{child}->add (2, $row, $item->{weight_widget});
3267
3268 $row++;
3269 }
3270}
3271
3272#############################################################################
3273
3274package CFClient::UI::BindEditor;
3275
3276our @ISA = CFClient::UI::FancyFrame::;
3277
3278sub new {
3279 my $class = shift;
3280
3281 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3282
3283 $self->add (my $vb = new CFClient::UI::VBox);
3284
3285
3286 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3287 text => "start recording",
3288 tooltip => "Start/Stops recording of actions."
3289 ."All subsequent actions after the recording started will be captured."
3290 ."The actions are displayed after the record was stopped."
3291 ."To bind the action you have to click on the 'Bind' button",
3292 on_activate => sub {
3293 unless ($self->{recording}) {
3294 $self->start;
3295 } else {
3296 $self->stop;
3297 }
3298 });
3299
3300 $vb->add (new CFClient::UI::Label text => "Actions:");
3301 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3302
3303 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3304 $vb->add (my $hb = new CFClient::UI::HBox);
3305 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3306 $hb->add (new CFClient::UI::Button
3307 text => "bind",
3308 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3309 on_activate => sub {
3310 $self->ask_for_bind;
3311 });
3312
3313 $vb->add (my $hb = new CFClient::UI::HBox);
3314 $hb->add (new CFClient::UI::Button
3315 text => "ok",
3316 expand => 1,
3317 tooltip => "This closes the binding editor and saves the binding",
3318 on_activate => sub {
3319 $self->hide;
3320 $self->commit;
3321 });
3322
3323 $hb->add (new CFClient::UI::Button
3324 text => "cancel",
3325 expand => 1,
3326 tooltip => "This closes the binding editor without saving",
3327 on_activate => sub {
3328 $self->hide;
3329 $self->{binding_cancel}->()
3330 if $self->{binding_cancel};
3331 });
3332
3333 $self->update_binding_widgets; 3626 $self->update_items;
3334
3335 $self
3336}
3337
3338sub commit {
3339 my ($self) = @_;
3340 my ($mod, $sym, $cmds) = $self->get_binding;
3341 if ($sym != 0 && @$cmds > 0) {
3342 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3343 ."'. Don't forget 'Save Config'!");
3344 $self->{binding_change}->($mod, $sym, $cmds)
3345 if $self->{binding_change};
3346 } else {
3347 $::STATUSBOX->add ("No action bound, no key or action specified!");
3348 $self->{binding_cancel}->()
3349 if $self->{binding_cancel};
3350 }
3351}
3352
3353sub start {
3354 my ($self) = @_;
3355
3356 $self->{rec_btn}->set_text ("stop recording");
3357 $self->{recording} = 1;
3358 $self->clear_command_list;
3359 $::CONN->start_record if $::CONN;
3360}
3361
3362sub stop {
3363 my ($self) = @_;
3364
3365 $self->{rec_btn}->set_text ("start recording");
3366 $self->{recording} = 0;
3367
3368 my $rec;
3369 $rec = $::CONN->stop_record if $::CONN;
3370 return unless ref $rec eq 'ARRAY';
3371 $self->set_command_list ($rec);
3372}
3373
3374
3375sub ask_for_bind_and_commit {
3376 my ($self) = @_;
3377 $self->ask_for_bind (1);
3378}
3379
3380sub ask_for_bind {
3381 my ($self, $commit) = @_;
3382
3383 CFClient::Binder::open_binding_dialog (sub {
3384 my ($mod, $sym) = @_;
3385 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3386 $self->update_binding_widgets;
3387 $self->commit if $commit;
3388 });
3389}
3390
3391# $mod and $sym are the modifiers and key symbol
3392# $cmds is a array ref of strings (the commands)
3393# $cb is the callback that is executed on OK
3394# $ccb is the callback that is executed on CANCEL and
3395# when the binding was unsuccessful on OK
3396sub set_binding {
3397 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3398
3399 $self->clear_command_list;
3400 $self->{recording} = 0;
3401 $self->{rec_btn}->set_text ("start recording");
3402
3403 $self->{binding} = [$mod, $sym];
3404 $self->{commands} = $cmds;
3405
3406 $self->{binding_change} = $cb;
3407 $self->{binding_cancel} = $ccb;
3408
3409 $self->update_binding_widgets;
3410}
3411
3412# this is a shortcut method that asks for a binding
3413# and then just binds it.
3414sub do_quick_binding {
3415 my ($self, $cmds) = @_;
3416 $self->set_binding (undef, undef, $cmds, sub {
3417 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3418 });
3419 $self->ask_for_bind (1);
3420}
3421
3422sub update_binding_widgets {
3423 my ($self) = @_;
3424 my ($mod, $sym, $cmds) = $self->get_binding;
3425 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3426 $self->set_command_list ($cmds);
3427}
3428
3429sub get_binding {
3430 my ($self) = @_;
3431 return (
3432 $self->{binding}->[0],
3433 $self->{binding}->[1],
3434 [ grep { defined $_ } @{$self->{commands}} ]
3435 );
3436}
3437
3438sub clear_command_list {
3439 my ($self) = @_;
3440 $self->{cmdbox}->clear ();
3441}
3442
3443sub set_command_list {
3444 my ($self, $cmds) = @_;
3445
3446 $self->{cmdbox}->clear ();
3447 $self->{commands} = $cmds;
3448
3449 my $idx = 0;
3450
3451 for (@$cmds) {
3452 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3453
3454 my $i = $idx;
3455 $hb->add (new CFClient::UI::Label text => $_);
3456 $hb->add (new CFClient::UI::Button
3457 text => "delete",
3458 tooltip => "Deletes the action from the record",
3459 on_activate => sub {
3460 $self->{cmdbox}->remove ($hb);
3461 $cmds->[$i] = undef;
3462 });
3463
3464
3465 $idx++
3466 }
3467} 3627}
3468 3628
3469############################################################################# 3629#############################################################################
3470 3630
3471package CFClient::UI::SpellList; 3631package CFClient::UI::SpellList;
… …
3480 commands => [], 3640 commands => [],
3481 @_, 3641 @_,
3482 ) 3642 )
3483} 3643}
3484 3644
3485# XXX: Do sorting? Argl... 3645my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
3646
3647my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3648 "<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
3649my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3650 "<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
3651my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3652 "<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
3653my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3654 "<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
3655my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3656 "<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
3657
3658sub rebuild_spell_list {
3659 my ($self) = @_;
3660
3661 $CFClient::UI::ROOT->on_refresh ($self => sub {
3662 $self->clear;
3663
3664 return unless $::CONN;
3665
3666 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3667 $self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3668 $self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3669 $self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3670 $self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3671
3672 my $row = 0;
3673
3674 for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3675 my $spell = $self->{spell}{$_};
3676
3677 $row++;
3678
3679 my $spell_cb = sub {
3680 my ($widget, $ev) = @_;
3681
3682 if ($ev->{button} == 1) {
3683 $::CONN->user_send ("cast $spell->{name}");
3684 } elsif ($ev->{button} == 2) {
3685 $::CONN->user_send ("invoke $spell->{name}");
3686 } elsif ($ev->{button} == 3) {
3687 (new CFClient::UI::Menu
3688 items => [
3689 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3690 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3691 ],
3692 )->popup ($ev);
3693 } else {
3694 return 0;
3695 }
3696
3697 1
3698 };
3699
3700 my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3701
3702 #TODO: add path info to tooltip
3703 #$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
3704
3705 $self->add (0, $row, new CFClient::UI::Face
3706 face => $spell->{face},
3707 can_hover => 1,
3708 can_events => 1,
3709 tooltip => $tooltip,
3710 on_button_down => $spell_cb,
3711 );
3712
3713 $self->add (1, $row, new CFClient::UI::Label
3714 expand => 1,
3715 text => $spell->{name},
3716 can_hover => 1,
3717 can_events => 1,
3718 tooltip => $tooltip,
3719 on_button_down => $spell_cb,
3720 );
3721
3722 $self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3723 $self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3724 $self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3725 $self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3726 }
3727 });
3728}
3729
3486sub add_spell { 3730sub add_spell {
3487 my ($self, $spell) = @_; 3731 my ($self, $spell) = @_;
3732
3488 $self->{spells}->{$spell->{name}} = $spell; 3733 $self->{spell}->{$spell->{name}} = $spell;
3489 3734 $self->rebuild_spell_list;
3490 $self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3491 face => $spell->{face},
3492 can_hover => 1,
3493 can_events => 1,
3494 tooltip => $spell->{message});
3495
3496 $self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3497 text => $spell->{name},
3498 can_hover => 1,
3499 can_events => 1,
3500 tooltip => $spell->{message},
3501 expand => 1);
3502
3503 $self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3504 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3505 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3506 expand => 1);
3507
3508 $self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3509 text => "bind to key",
3510 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3511}
3512
3513sub rebuild_spell_list {
3514 my ($self) = @_;
3515 $self->{tbl_idx} = 0;
3516 $self->add_spell ($_) for values %{$self->{spells}};
3517} 3735}
3518 3736
3519sub remove_spell { 3737sub remove_spell {
3520 my ($self, $spell) = @_; 3738 my ($self, $spell) = @_;
3739
3521 delete $self->{spells}->{$spell->{name}}; 3740 delete $self->{spell}->{$spell->{name}};
3741 $self->rebuild_spell_list;
3742}
3743
3744sub clear_spells {
3745 my ($self) = @_;
3746
3747 $self->{spell} = {};
3522 $self->rebuild_spell_list; 3748 $self->rebuild_spell_list;
3523} 3749}
3524 3750
3525############################################################################# 3751#############################################################################
3526 3752
… …
3563 $coord = $max - $size if $coord > $max - $size; 3789 $coord = $max - $size if $coord > $max - $size;
3564 3790
3565 int $coord + 0.5 3791 int $coord + 0.5
3566} 3792}
3567 3793
3568sub size_allocate { 3794sub invoke_size_allocate {
3569 my ($self, $w, $h) = @_; 3795 my ($self, $w, $h) = @_;
3570 3796
3571 for my $child ($self->children) { 3797 for my $child ($self->children) {
3572 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)};
3573 3799
… …
3577 $X = _to_pixel $X, $W, $self->{w}; 3803 $X = _to_pixel $X, $W, $self->{w};
3578 $Y = _to_pixel $Y, $H, $self->{h}; 3804 $Y = _to_pixel $Y, $H, $self->{h};
3579 3805
3580 $child->configure ($X, $Y, $W, $H); 3806 $child->configure ($X, $Y, $W, $H);
3581 } 3807 }
3808
3809 1
3582} 3810}
3583 3811
3584sub coord2local { 3812sub coord2local {
3585 my ($self, $x, $y) = @_; 3813 my ($self, $x, $y) = @_;
3586 3814
… …
3712 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 3940 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3713 3941
3714 $w = 0 if $w < 0; 3942 $w = 0 if $w < 0;
3715 $h = 0 if $h < 0; 3943 $h = 0 if $h < 0;
3716 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
3717 $w = int $w + 0.5; 3951 $w = int $w + 0.5;
3718 $h = int $h + 0.5; 3952 $h = int $h + 0.5;
3719 3953
3720 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}) {
3721 $widget->{old_w} = $widget->{w}; 3955 $widget->{old_w} = $widget->{w};

Diff Legend

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