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.337 by root, Mon Jul 24 04:24:43 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
… …
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";
339} 360}
340 361
362sub baseline_shift {
363 0
364}
365
341sub configure { 366sub configure {
342 my ($self, $x, $y, $w, $h) = @_; 367 my ($self, $x, $y, $w, $h) = @_;
343 368
344 if ($self->{aspect}) { 369 if ($self->{aspect}) {
345 my ($ow, $oh) = ($w, $h); 370 my ($ow, $oh) = ($w, $h);
346 371
347 $w = List::Util::min $w, int $h * $self->{aspect}; 372 $w = List::Util::min $w, CFClient::ceil $h * $self->{aspect};
348 $h = List::Util::min $h, int $w / $self->{aspect}; 373 $h = List::Util::min $h, CFClient::ceil $w / $self->{aspect};
349 374
350 # use alignment to adjust x, y 375 # use alignment to adjust x, y
351 376
352 $x += int 0.5 * ($ow - $w); 377 $x += int 0.5 * ($ow - $w);
353 $y += int 0.5 * ($oh - $h); 378 $y += int 0.5 * ($oh - $h);
… …
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};
… …
1979 my ($self) = @_; 2085 my ($self) = @_;
1980 2086
1981 (6) x 2 2087 (6) x 2
1982} 2088}
1983 2089
2090sub toggle {
2091 my ($self) = @_;
2092
2093 $self->{state} = !$self->{state};
2094 $self->emit (changed => $self->{state});
2095 $self->update;
2096}
2097
1984sub button_down { 2098sub invoke_button_down {
1985 my ($self, $ev, $x, $y) = @_; 2099 my ($self, $ev, $x, $y) = @_;
1986 2100
1987 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2101 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1988 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2102 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1989 $self->{state} = !$self->{state}; 2103 $self->toggle;
1990 $self->_emit (changed => $self->{state});
1991 } else { 2104 } else {
1992 return 0 2105 return 0
1993 } 2106 }
1994 2107
1995 1 2108 1
… …
2020package CFClient::UI::Image; 2133package CFClient::UI::Image;
2021 2134
2022our @ISA = CFClient::UI::Base::; 2135our @ISA = CFClient::UI::Base::;
2023 2136
2024use CFClient::OpenGL; 2137use CFClient::OpenGL;
2025use Carp qw/confess/;
2026 2138
2027our %loaded_images; 2139our %texture_cache;
2028 2140
2029sub new { 2141sub new {
2030 my $class = shift; 2142 my $class = shift;
2031 2143
2032 my $self = $class->SUPER::new (can_events => 0, @_); 2144 my $self = $class->SUPER::new (
2145 can_events => 0,
2146 @_,
2147 );
2033 2148
2034 $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; 2149 $self->{path} || $self->{tex}
2150 or Carp::croak "'path' or 'tex' attributes required";
2035 2151
2036 $loaded_images{$self->{image}} ||= 2152 $self->{tex} ||= $texture_cache{$self->{path}} ||=
2037 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; 2153 new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2038 2154
2039 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2155 Scalar::Util::weaken $texture_cache{$self->{path}};
2040 2156
2041 Scalar::Util::weaken $loaded_images{$self->{image}}; 2157 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2042
2043 $self->{aspect} = $tex->{w} / $tex->{h};
2044 2158
2045 $self 2159 $self
2046} 2160}
2047 2161
2162sub STORABLE_freeze {
2163 my ($self, $cloning) = @_;
2164
2165 $self->{path}
2166 or die "cannot serialise CFClient::UI::Image on non-loadable images\n";
2167
2168 $self->{path}
2169}
2170
2171sub STORABLE_attach {
2172 my ($self, $cloning, $path) = @_;
2173
2174 $self->new (path => $path)
2175}
2176
2048sub size_request { 2177sub size_request {
2049 my ($self) = @_; 2178 my ($self) = @_;
2050 2179
2051 ($self->{tex}->{w}, $self->{tex}->{h}) 2180 ($self->{tex}{w}, $self->{tex}{h})
2052} 2181}
2053 2182
2054sub _draw { 2183sub _draw {
2055 my ($self) = @_; 2184 my ($self) = @_;
2056 2185
… …
2066 } 2195 }
2067 2196
2068 glEnable GL_TEXTURE_2D; 2197 glEnable GL_TEXTURE_2D;
2069 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2198 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2070 2199
2071 $tex->draw_quad_alpha (0, 0, $w, $h); 2200 $tex->draw_quad (0, 0, $w, $h);
2072 2201
2073 glDisable GL_TEXTURE_2D; 2202 glDisable GL_TEXTURE_2D;
2203}
2204
2205#############################################################################
2206
2207package CFClient::UI::ImageButton;
2208
2209our @ISA = CFClient::UI::Image::;
2210
2211use CFClient::OpenGL;
2212
2213my %textures;
2214
2215sub new {
2216 my $class = shift;
2217
2218 my $self = $class->SUPER::new (
2219 padding_x => 4,
2220 padding_y => 4,
2221 fg => [1, 1, 1],
2222 active_fg => [0, 0, 1],
2223 can_hover => 1,
2224 align => 0,
2225 valign => 0,
2226 can_events => 1,
2227 @_
2228 );
2229}
2230
2231sub invoke_button_up {
2232 my ($self, $ev, $x, $y) = @_;
2233
2234 $self->emit ("activate")
2235 if $x >= 0 && $x < $self->{w}
2236 && $y >= 0 && $y < $self->{h};
2237
2238 1
2074} 2239}
2075 2240
2076############################################################################# 2241#############################################################################
2077 2242
2078package CFClient::UI::VGauge; 2243package CFClient::UI::VGauge;
… …
2165 my $ycut1 = max 0, min 1, $ycut; 2330 my $ycut1 = max 0, min 1, $ycut;
2166 my $ycut2 = max 0, min 1, $ycut - 1; 2331 my $ycut2 = max 0, min 1, $ycut - 1;
2167 2332
2168 my $h1 = $self->{h} * (1 - $ycut1); 2333 my $h1 = $self->{h} * (1 - $ycut1);
2169 my $h2 = $self->{h} * (1 - $ycut2); 2334 my $h2 = $self->{h} * (1 - $ycut2);
2335 my $h3 = $self->{h};
2336
2337 $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2170 2338
2171 glEnable GL_BLEND; 2339 glEnable GL_BLEND;
2172 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA, 2340 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2173 GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2341 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2174 glEnable GL_TEXTURE_2D; 2342 glEnable GL_TEXTURE_2D;
… …
2193 2361
2194 if ($t3) { 2362 if ($t3) {
2195 glBindTexture GL_TEXTURE_2D, $t3->{name}; 2363 glBindTexture GL_TEXTURE_2D, $t3->{name};
2196 glBegin GL_QUADS; 2364 glBegin GL_QUADS;
2197 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2; 2365 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2198 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h}; 2366 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2199 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h}; 2367 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2200 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2; 2368 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2201 glEnd; 2369 glEnd;
2202 } 2370 }
2203 2371
2204 glDisable GL_BLEND; 2372 glDisable GL_BLEND;
… …
2292 $self->update; 2460 $self->update;
2293 2461
2294 $self 2462 $self
2295} 2463}
2296 2464
2297sub changed { }
2298
2299sub set_range { 2465sub set_range {
2300 my ($self, $range) = @_; 2466 my ($self, $range) = @_;
2301 2467
2302 ($range, $self->{range}) = ($self->{range}, $range); 2468 ($range, $self->{range}) = ($self->{range}, $range);
2303 2469
2304 $self->update
2305 if "@$range" ne "@{$self->{range}}"; 2470 if ("@$range" ne "@{$self->{range}}") {
2471 $self->update;
2472 $self->set_value ($self->{range}[0]);
2473 }
2306} 2474}
2307 2475
2308sub set_value { 2476sub set_value {
2309 my ($self, $value) = @_; 2477 my ($self, $value) = @_;
2310 2478
… …
2321 if $unit; 2489 if $unit;
2322 2490
2323 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2491 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2324 2492
2325 if ($value != $old_value) { 2493 if ($value != $old_value) {
2326 $self->_emit (changed => $value); 2494 $self->emit (changed => $value);
2327 $self->update; 2495 $self->update;
2328 } 2496 }
2329} 2497}
2330 2498
2331sub size_request { 2499sub size_request {
2332 my ($self) = @_; 2500 my ($self) = @_;
2333 2501
2334 ($self->{req_w}, $self->{req_h}) 2502 ($self->{req_w}, $self->{req_h})
2335} 2503}
2336 2504
2337sub button_down { 2505sub invoke_button_down {
2338 my ($self, $ev, $x, $y) = @_; 2506 my ($self, $ev, $x, $y) = @_;
2339 2507
2340 $self->SUPER::button_down ($ev, $x, $y); 2508 $self->SUPER::invoke_button_down ($ev, $x, $y);
2341 2509
2342 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2510 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2343 2511
2344 $self->mouse_motion ($ev, $x, $y) 2512 $self->invoke_mouse_motion ($ev, $x, $y)
2345} 2513}
2346 2514
2347sub mouse_motion { 2515sub invoke_mouse_motion {
2348 my ($self, $ev, $x, $y) = @_; 2516 my ($self, $ev, $x, $y) = @_;
2349 2517
2350 if ($GRAB == $self) { 2518 if ($GRAB == $self) {
2351 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2519 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2352 2520
… …
2358 } else { 2526 } else {
2359 return 0; 2527 return 0;
2360 } 2528 }
2361 2529
2362 1 2530 1
2531}
2532
2533sub invoke_mouse_wheel {
2534 my ($self, $ev) = @_;
2535
2536 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
2537
2538 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.2);
2539
2540 ! ! $delta
2363} 2541}
2364 2542
2365sub update { 2543sub update {
2366 my ($self) = @_; 2544 my ($self) = @_;
2367 2545
… …
2457sub set_range { shift->{slider}->set_range (@_) } 2635sub set_range { shift->{slider}->set_range (@_) }
2458sub set_value { shift->{slider}->set_value (@_) } 2636sub set_value { shift->{slider}->set_value (@_) }
2459 2637
2460############################################################################# 2638#############################################################################
2461 2639
2462package CFClient::UI::TextView; 2640package CFClient::UI::TextScroller;
2463 2641
2464our @ISA = CFClient::UI::HBox::; 2642our @ISA = CFClient::UI::HBox::;
2465 2643
2466use CFClient::OpenGL; 2644use CFClient::OpenGL;
2467 2645
2468sub new { 2646sub new {
2469 my $class = shift; 2647 my $class = shift;
2470 2648
2471 my $self = $class->SUPER::new ( 2649 my $self = $class->SUPER::new (
2472 fontsize => 1, 2650 fontsize => 1,
2473 can_events => 0, 2651 can_events => 1,
2652 indent => 0,
2474 #font => default_font 2653 #font => default_font
2475 @_, 2654 @_,
2476 2655
2477 layout => (new CFClient::Layout 1), 2656 layout => (new CFClient::Layout),
2478 par => [], 2657 par => [],
2479 height => 0, 2658 height => 0,
2480 children => [ 2659 children => [
2481 (new CFClient::UI::Empty expand => 1), 2660 (new CFClient::UI::Empty expand => 1),
2482 (new CFClient::UI::Slider vertical => 1), 2661 (new CFClient::UI::Slider vertical => 1),
… …
2493 2672
2494 $self->{fontsize} = $fontsize; 2673 $self->{fontsize} = $fontsize;
2495 $self->reflow; 2674 $self->reflow;
2496} 2675}
2497 2676
2677sub size_request {
2678 my ($self) = @_;
2679
2680 my ($empty, $slider) = @{ $self->{children} };
2681
2682 local $self->{children} = [$empty, $slider];
2683 $self->SUPER::size_request
2684}
2685
2498sub size_allocate { 2686sub invoke_size_allocate {
2499 my ($self, $w, $h) = @_; 2687 my ($self, $w, $h) = @_;
2500 2688
2501 $self->SUPER::size_allocate ($w, $h); 2689 my ($empty, $slider, @other) = @{ $self->{children} };
2690 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2502 2691
2503 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2692 $self->{layout}->set_font ($self->{font}) if $self->{font};
2504 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2693 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2505 $self->{layout}->set_width ($self->{children}[0]{w}); 2694 $self->{layout}->set_width ($empty->{w});
2695 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2506 2696
2507 $self->reflow; 2697 $self->reflow;
2508}
2509 2698
2510sub text_size { 2699 local $self->{children} = [$empty, $slider];
2700 $self->SUPER::invoke_size_allocate ($w, $h)
2701}
2702
2703sub invoke_mouse_wheel {
2511 my ($self, $text, $indent) = @_; 2704 my ($self, $ev) = @_;
2705
2706 return 0 unless $ev->{dy}; # only vertical movements
2707
2708 $self->{children}[1]->emit (mouse_wheel => $ev);
2709
2710 1
2711}
2712
2713sub get_layout {
2714 my ($self, $para) = @_;
2512 2715
2513 my $layout = $self->{layout}; 2716 my $layout = $self->{layout};
2514 2717
2718 $layout->set_font ($self->{font}) if $self->{font};
2719 $layout->set_foreground (@{$para->{fg}});
2515 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2720 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2516 $layout->set_width ($self->{children}[0]{w} - $indent); 2721 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2722 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2517 $layout->set_markup ($text); 2723 $layout->set_markup ($para->{markup});
2724
2725 $layout->set_shapes (
2726 map
2727 +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
2728 @{$para->{widget}}
2518 2729 );
2730
2519 $layout->size 2731 $layout
2520} 2732}
2521 2733
2522sub reflow { 2734sub reflow {
2523 my ($self) = @_; 2735 my ($self) = @_;
2524 2736
… …
2533 $self->{children}[1]->set_value ($offset); 2745 $self->{children}[1]->set_value ($offset);
2534} 2746}
2535 2747
2536sub clear { 2748sub clear {
2537 my ($self) = @_; 2749 my ($self) = @_;
2750
2751 my (undef, undef, @other) = @{ $self->{children} };
2752 $self->remove ($_) for @other;
2538 2753
2539 $self->{par} = []; 2754 $self->{par} = [];
2540 $self->{height} = 0; 2755 $self->{height} = 0;
2541 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2756 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2542} 2757}
2543 2758
2544sub add_paragraph { 2759sub add_paragraph {
2545 my ($self, $color, $text, $indent) = @_; 2760 my ($self, $color, $para, $indent) = @_;
2546 2761
2547 for my $line (split /\n/, $text) { 2762 my ($text, @w) = ref $para ? @$para : $para;
2548 my ($w, $h) = $self->text_size ($line); 2763
2549 $self->{height} += $h; 2764 $para = {
2550 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 2765 w => 1e10,
2766 wrapped => 1,
2767 fg => $color,
2768 indent => $indent,
2769 markup => $text,
2770 widget => \@w,
2551 } 2771 };
2552 2772
2553 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 2773 $self->add (@w) if @w;
2774 push @{$self->{par}}, $para;
2775
2776 $self->{need_reflow}++;
2777 $self->update;
2778}
2779
2780sub scroll_to_bottom {
2781 my ($self) = @_;
2782
2783 $self->{scroll_to_bottom} = 1;
2784 $self->update;
2554} 2785}
2555 2786
2556sub update { 2787sub update {
2557 my ($self) = @_; 2788 my ($self) = @_;
2558 2789
… …
2560 2791
2561 return unless $self->{h} > 0; 2792 return unless $self->{h} > 0;
2562 2793
2563 delete $self->{texture}; 2794 delete $self->{texture};
2564 2795
2565 $ROOT->on_post_alloc ($self, sub { 2796 $ROOT->on_post_alloc ($self => sub {
2566 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2797 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2567 2798
2568 if (delete $self->{need_reflow}) { 2799 if (delete $self->{need_reflow}) {
2569 my $height = 0; 2800 my $height = 0;
2570 2801
2571 my $layout = $self->{layout};
2572
2573 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2574
2575 for (@{$self->{par}}) { 2802 for my $para (@{$self->{par}}) {
2576 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2803 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2577 $layout->set_width ($W - $_->[3]); 2804 my $layout = $self->get_layout ($para);
2578 $layout->set_markup ($_->[4]);
2579 my ($w, $h) = $layout->size; 2805 my ($w, $h) = $layout->size;
2580 $_->[0] = $w + $_->[3]; 2806
2581 $_->[1] = $h; 2807 $para->{w} = $w + $para->{indent};
2808 $para->{h} = $h;
2809 $para->{wrapped} = $layout->has_wrapped;
2582 } 2810 }
2583 2811
2584 $height += $_->[1]; 2812 $height += $para->{h};
2585 } 2813 }
2586 2814
2587 $self->{height} = $height; 2815 $self->{height} = $height;
2588 2816
2589 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]); 2817 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2590 2818
2591 delete $self->{texture}; 2819 delete $self->{texture};
2820 }
2821
2822 if (delete $self->{scroll_to_bottom}) {
2823 $self->{children}[1]->set_value (1e10);
2592 } 2824 }
2593 2825
2594 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2826 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2595 glClearColor 0, 0, 0, 0; 2827 glClearColor 0, 0, 0, 0;
2596 glClear GL_COLOR_BUFFER_BIT; 2828 glClear GL_COLOR_BUFFER_BIT;
… …
2600 my $y0 = $top; 2832 my $y0 = $top;
2601 my $y1 = $top + $H; 2833 my $y1 = $top + $H;
2602 2834
2603 my $y = 0; 2835 my $y = 0;
2604 2836
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}}) { 2837 for my $para (@{$self->{par}}) {
2614 my $h = $par->[1]; 2838 my $h = $para->{h};
2615 2839
2616 if ($y0 < $y + $h && $y < $y1) { 2840 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 2841
2621 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2842 my $layout = $self->get_layout ($para);
2622 2843
2623 glRasterPos $par->[3], $y - $y0; 2844 $layout->render ($para->{indent}, $y - $y0);
2624 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2845
2846 if (my @w = @{ $para->{widget} }) {
2847 my @s = $layout->get_shapes;
2848
2849 for (@w) {
2850 my ($dx, $dy) = splice @s, 0, 2, ();
2851
2852 $_->{x} = $dx + $para->{indent};
2853 $_->{y} = $dy + $y - $y0;
2854
2855 $_->draw;
2856 }
2857 }
2625 } 2858 }
2626 2859
2627 $y += $h; 2860 $y += $h;
2628 } 2861 }
2629
2630 glDisable GL_BLEND;
2631 }; 2862 };
2632 }); 2863 });
2864}
2865
2866sub reconfigure {
2867 my ($self) = @_;
2868
2869 $self->SUPER::reconfigure;
2870
2871 $_->{w} = 1e10 for @{ $self->{par} };
2872 $self->reflow;
2633} 2873}
2634 2874
2635sub _draw { 2875sub _draw {
2636 my ($self) = @_; 2876 my ($self) = @_;
2637 2877
… …
2640 glColor 0, 0, 0, 1; 2880 glColor 0, 0, 0, 1;
2641 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2881 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2642 glDisable GL_TEXTURE_2D; 2882 glDisable GL_TEXTURE_2D;
2643 2883
2644 $self->{children}[1]->draw; 2884 $self->{children}[1]->draw;
2645
2646} 2885}
2647 2886
2648############################################################################# 2887#############################################################################
2649 2888
2650package CFClient::UI::Animator; 2889package CFClient::UI::Animator;
… …
2737 $tooltip .= "\n\n" . (ref $widget) . "\n" 2976 $tooltip .= "\n\n" . (ref $widget) . "\n"
2738 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" 2977 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2739 . "req $widget->{req_w} $widget->{req_h}\n" 2978 . "req $widget->{req_w} $widget->{req_h}\n"
2740 . "visible $widget->{visible}"; 2979 . "visible $widget->{visible}";
2741 } 2980 }
2981
2982 $tooltip =~ s/^\n+//;
2983 $tooltip =~ s/\n+$//;
2742 2984
2743 $self->add (new CFClient::UI::Label 2985 $self->add (new CFClient::UI::Label
2744 markup => $tooltip, 2986 markup => $tooltip,
2745 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2987 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2746 fontsize => 0.8, 2988 fontsize => 0.8,
… …
2756 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 2998 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2757 2999
2758 ($w + 4, $h + 4) 3000 ($w + 4, $h + 4)
2759} 3001}
2760 3002
2761sub size_allocate { 3003sub invoke_size_allocate {
2762 my ($self, $w, $h) = @_; 3004 my ($self, $w, $h) = @_;
2763 3005
2764 $self->SUPER::size_allocate ($w - 4, $h - 4); 3006 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2765} 3007}
2766 3008
2767sub visibility_change { 3009sub invoke_visibility_change {
2768 my ($self, $visible) = @_; 3010 my ($self, $visible) = @_;
2769 3011
2770 return unless $visible; 3012 return unless $visible;
2771 3013
2772 $self->{root}->on_post_alloc ("move_$self" => sub { 3014 $self->{root}->on_post_alloc ("move_$self" => sub {
2773 my $widget = $self->{owner} 3015 my $widget = $self->{owner}
2774 or return; 3016 or return;
2775 3017
3018 if ($widget->{visible}) {
2776 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 3019 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2777 3020
2778 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 3021 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2779 if $x + $self->{w} > $::WIDTH; 3022 if $x + $self->{w} > $self->{root}{w};
2780 3023
2781 $self->move_abs ($x, $y); 3024 $self->move_abs ($x, $y);
3025 } else {
3026 $self->hide;
3027 }
2782 }); 3028 });
2783} 3029}
2784 3030
2785sub _draw { 3031sub _draw {
2786 my ($self) = @_; 3032 my ($self) = @_;
… …
2812 3058
2813############################################################################# 3059#############################################################################
2814 3060
2815package CFClient::UI::Face; 3061package CFClient::UI::Face;
2816 3062
2817our @ISA = CFClient::UI::Base::; 3063our @ISA = CFClient::UI::DrawBG::;
2818 3064
2819use CFClient::OpenGL; 3065use CFClient::OpenGL;
2820 3066
2821sub new { 3067sub new {
2822 my $class = shift; 3068 my $class = shift;
… …
2859sub _draw { 3105sub _draw {
2860 my ($self) = @_; 3106 my ($self) = @_;
2861 3107
2862 return unless $::CONN; 3108 return unless $::CONN;
2863 3109
3110 $self->SUPER::_draw;
3111
2864 my $face; 3112 my $face;
2865 3113
2866 if ($self->{frame}) { 3114 if ($self->{frame}) {
2867 my $anim = $::CONN->{anim}[$self->{anim}]; 3115 my $anim = $::CONN->{anim}[$self->{anim}];
2868 3116
… …
2879 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3127 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2880 glDisable GL_TEXTURE_2D; 3128 glDisable GL_TEXTURE_2D;
2881 } 3129 }
2882} 3130}
2883 3131
2884sub DESTROY { 3132sub destroy {
2885 my ($self) = @_; 3133 my ($self) = @_;
2886 3134
2887 $self->{timer}->cancel 3135 $self->{timer}->cancel
2888 if $self->{timer}; 3136 if $self->{timer};
2889 3137
2890 $self->SUPER::DESTROY; 3138 $self->SUPER::destroy;
2891} 3139}
2892 3140
2893############################################################################# 3141#############################################################################
2894 3142
2895package CFClient::UI::Buttonbar; 3143package CFClient::UI::Buttonbar;
… …
2916 ); 3164 );
2917 3165
2918 $self->add ($self->{vbox} = new CFClient::UI::VBox); 3166 $self->add ($self->{vbox} = new CFClient::UI::VBox);
2919 3167
2920 for my $item (@{ $self->{items} }) { 3168 for my $item (@{ $self->{items} }) {
2921 my ($widget, $cb) = @$item; 3169 my ($widget, $cb, $tooltip) = @$item;
2922 3170
2923 # handle various types of items, only text for now 3171 # handle various types of items, only text for now
2924 if (!ref $widget) { 3172 if (!ref $widget) {
3173 if ($widget =~ /\t/) {
3174 my ($left, $right) = split /\t/, $widget, 2;
3175
3176 $widget = new CFClient::UI::HBox
3177 can_hover => 1,
3178 can_events => 1,
3179 tooltip => $tooltip,
3180 children => [
3181 (new CFClient::UI::Label markup => $left, expand => 1),
3182 (new CFClient::UI::Label markup => $right, align => +1),
3183 ],
3184 ;
3185
3186 } else {
2925 $widget = new CFClient::UI::Label 3187 $widget = new CFClient::UI::Label
2926 can_hover => 1, 3188 can_hover => 1,
2927 can_events => 1, 3189 can_events => 1,
2928 text => $widget; 3190 markup => $widget,
3191 tooltip => $tooltip;
3192 }
2929 } 3193 }
2930 3194
2931 $self->{item}{$widget} = $item; 3195 $self->{item}{$widget} = $item;
2932 3196
2933 $self->{vbox}->add ($widget); 3197 $self->{vbox}->add ($widget);
… …
2938 3202
2939# popup given the event (must be a mouse button down event currently) 3203# popup given the event (must be a mouse button down event currently)
2940sub popup { 3204sub popup {
2941 my ($self, $ev) = @_; 3205 my ($self, $ev) = @_;
2942 3206
2943 $self->_emit ("popdown"); 3207 $self->emit ("popdown");
2944 3208
2945 # maybe save $GRAB? must be careful about events... 3209 # maybe save $GRAB? must be careful about events...
2946 $GRAB = $self; 3210 $GRAB = $self;
2947 $self->{button} = $ev->{button}; 3211 $self->{button} = $ev->{button};
2948 3212
2949 $self->show; 3213 $self->show;
2950 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 3214 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2951} 3215}
2952 3216
2953sub mouse_motion { 3217sub invoke_mouse_motion {
2954 my ($self, $ev, $x, $y) = @_; 3218 my ($self, $ev, $x, $y) = @_;
2955 3219
2956 # TODO: should use vbox->find_widget or so 3220 # TODO: should use vbox->find_widget or so
2957 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3221 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2958 $self->{hover} = $self->{item}{$HOVER}; 3222 $self->{hover} = $self->{item}{$HOVER};
2959 3223
2960 0 3224 0
2961} 3225}
2962 3226
2963sub button_up { 3227sub invoke_button_up {
2964 my ($self, $ev, $x, $y) = @_; 3228 my ($self, $ev, $x, $y) = @_;
2965 3229
2966 if ($ev->{button} == $self->{button}) { 3230 if ($ev->{button} == $self->{button}) {
2967 undef $GRAB; 3231 undef $GRAB;
2968 $self->hide; 3232 $self->hide;
2969 3233
2970 $self->_emit ("popdown"); 3234 $self->emit ("popdown");
2971 $self->{hover}[1]->() if $self->{hover}; 3235 $self->{hover}[1]->() if $self->{hover};
2972 } else { 3236 } else {
2973 return 0 3237 return 0
2974 } 3238 }
2975 3239
… …
3002 3266
3003 $self->{current} = $self->{children}[0] 3267 $self->{current} = $self->{children}[0]
3004 if @{ $self->{children} }; 3268 if @{ $self->{children} };
3005} 3269}
3006 3270
3271sub get_current_page {
3272 my ($self) = @_;
3273
3274 $self->{current}
3275}
3276
3007sub set_current_page { 3277sub set_current_page {
3008 my ($self, $page_or_widget) = @_; 3278 my ($self, $page_or_widget) = @_;
3009 3279
3010 my $widget = ref $page_or_widget 3280 my $widget = ref $page_or_widget
3011 ? $page_or_widget 3281 ? $page_or_widget
3012 : $self->{children}[$page_or_widget]; 3282 : $self->{children}[$page_or_widget];
3013 3283
3014 $self->{current} = $widget; 3284 $self->{current} = $widget;
3015 $self->{current}->configure (0, 0, $self->{w}, $self->{h}); 3285 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3016 3286
3017 $self->_emit (page_changed => $self->{current}); 3287 $self->emit (page_changed => $self->{current});
3018 3288
3019 $self->realloc; 3289 $self->realloc;
3020} 3290}
3021 3291
3022sub visible_children { 3292sub visible_children {
… …
3027 my ($self) = @_; 3297 my ($self) = @_;
3028 3298
3029 $self->{current}->size_request 3299 $self->{current}->size_request
3030} 3300}
3031 3301
3032sub size_allocate { 3302sub invoke_size_allocate {
3033 my ($self, $w, $h) = @_; 3303 my ($self, $w, $h) = @_;
3034 3304
3035 $self->{current}->configure (0, 0, $w, $h); 3305 $self->{current}->configure (0, 0, $w, $h);
3306
3307 1
3036} 3308}
3037 3309
3038sub _draw { 3310sub _draw {
3039 my ($self) = @_; 3311 my ($self) = @_;
3040 3312
… …
3075 ); 3347 );
3076 3348
3077 $self->{multiplexer}->add ($widget); 3349 $self->{multiplexer}->add ($widget);
3078} 3350}
3079 3351
3352sub get_current_page {
3353 my ($self) = @_;
3354
3355 $self->{multiplexer}->get_current_page
3356}
3357
3080sub set_current_page { 3358sub set_current_page {
3081 my ($self, $page) = @_; 3359 my ($self, $page) = @_;
3082 3360
3083 $self->{multiplexer}->set_current_page ($page); 3361 $self->{multiplexer}->set_current_page ($page);
3084 $self->_emit (page_changed => $self->{multiplexer}{current}); 3362 $self->emit (page_changed => $self->{multiplexer}{current});
3363}
3364
3365#############################################################################
3366
3367package CFClient::UI::Selector;
3368
3369use utf8;
3370
3371our @ISA = CFClient::UI::Button::;
3372
3373sub new {
3374 my $class = shift;
3375
3376 my $self = $class->SUPER::new (
3377 options => [], # [value, title, longdesc], ...
3378 value => undef,
3379 @_,
3380 );
3381
3382 $self->_set_value ($self->{value});
3383
3384 $self
3385}
3386
3387sub invoke_button_down {
3388 my ($self, $ev) = @_;
3389
3390 my @menu_items;
3391
3392 for (@{ $self->{options} }) {
3393 my ($value, $title, $tooltip) = @$_;
3394
3395 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3396 }
3397
3398 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
3399}
3400
3401sub _set_value {
3402 my ($self, $value) = @_;
3403
3404 my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
3405 or return;
3406
3407 $self->{value} = $item->[0];
3408 $self->set_markup ("$item->[1] ⇓");
3409 $self->set_tooltip ($item->[2]);
3410}
3411
3412sub set_value {
3413 my ($self, $value) = @_;
3414
3415 return unless $self->{value} ne $value;
3416
3417 $self->_set_value ($value);
3418 $self->emit (changed => $value);
3085} 3419}
3086 3420
3087############################################################################# 3421#############################################################################
3088 3422
3089package CFClient::UI::Statusbox; 3423package CFClient::UI::Statusbox;
… …
3188 $item->{count}++; 3522 $item->{count}++;
3189 } else { 3523 } else {
3190 $item->{count} = 1; 3524 $item->{count} = 1;
3191 $item->{text} = $item->{tooltip} = $text; 3525 $item->{text} = $item->{tooltip} = $text;
3192 } 3526 }
3193 $item->{id} = ++$self->{id}; 3527 $item->{id} += 0.2;#d#
3194 $item->{timeout} = $timeout; 3528 $item->{timeout} = $timeout;
3195 delete $item->{label}; 3529 delete $item->{label};
3196 } else { 3530 } else {
3197 $self->{item}{$group} = { 3531 $self->{item}{$group} = {
3198 id => ++$self->{id}, 3532 id => ++$self->{id},
… …
3204 count => 1, 3538 count => 1,
3205 %arg, 3539 %arg,
3206 }; 3540 };
3207 } 3541 }
3208 3542
3543 $ROOT->on_refresh (reorder => sub {
3209 $self->reorder; 3544 $self->reorder;
3545 });
3210} 3546}
3211 3547
3212sub reconfigure { 3548sub reconfigure {
3213 my ($self) = @_; 3549 my ($self) = @_;
3214 3550
… …
3217 3553
3218 $self->reorder; 3554 $self->reorder;
3219 $self->SUPER::reconfigure; 3555 $self->SUPER::reconfigure;
3220} 3556}
3221 3557
3222sub DESTROY { 3558sub destroy {
3223 my ($self) = @_; 3559 my ($self) = @_;
3224 3560
3225 $self->{timer}->cancel; 3561 $self->{timer}->cancel;
3226 3562
3227 $self->SUPER::DESTROY; 3563 $self->SUPER::destroy;
3228} 3564}
3229 3565
3230############################################################################# 3566#############################################################################
3231 3567
3232package CFClient::UI::Inventory; 3568package CFClient::UI::Inventory;
3233 3569
3234our @ISA = CFClient::UI::ScrolledWindow::; 3570our @ISA = CFClient::UI::Table::;
3235 3571
3236sub new { 3572sub new {
3237 my $class = shift; 3573 my $class = shift;
3238 3574
3239 my $self = $class->SUPER::new ( 3575 my $self = $class->SUPER::new (
3240 child => (new CFClient::UI::Table col_expand => [0, 1, 0]), 3576 col_expand => [0, 1, 0],
3577 items => [],
3241 @_, 3578 @_,
3242 ); 3579 );
3243 3580
3581 $self->set_sort_order (undef);
3582
3244 $self 3583 $self
3584}
3585
3586sub update_items {
3587 my ($self) = @_;
3588
3589 $self->clear;
3590
3591 my @item = $self->{sort}->(@{ $self->{items} });
3592
3593 my @adds;
3594 my $row = 0;
3595 for my $item ($self->{sort}->(@{ $self->{items} })) {
3596 CFClient::Item::update_widgets $item;
3597
3598 push @adds, 0, $row, $item->{face_widget};
3599 push @adds, 1, $row, $item->{desc_widget};
3600 push @adds, 2, $row, $item->{weight_widget};
3601
3602 $row++;
3603 }
3604
3605 $self->add (@adds);
3606}
3607
3608sub set_sort_order {
3609 my ($self, $order) = @_;
3610
3611 $self->{sort} = $order ||= sub {
3612 sort {
3613 $a->{type} <=> $b->{type}
3614 or $a->{name} cmp $b->{name}
3615 } @_
3616 };
3617
3618 $self->update_items;
3245} 3619}
3246 3620
3247sub set_items { 3621sub set_items {
3248 my ($self, $items) = @_; 3622 my ($self, $items) = @_;
3249 3623
3250 $self->{child}->clear; 3624 $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; 3625 $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} 3626}
3468 3627
3469############################################################################# 3628#############################################################################
3470 3629
3471package CFClient::UI::SpellList; 3630package CFClient::UI::SpellList;
… …
3480 commands => [], 3639 commands => [],
3481 @_, 3640 @_,
3482 ) 3641 )
3483} 3642}
3484 3643
3485# XXX: Do sorting? Argl... 3644my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
3645
3646my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3647 "<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
3648my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3649 "<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
3650my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3651 "<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
3652my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3653 "<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
3654my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3655 "<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
3656
3657sub rebuild_spell_list {
3658 my ($self) = @_;
3659
3660 $CFClient::UI::ROOT->on_refresh ($self => sub {
3661 $self->clear;
3662
3663 return unless $::CONN;
3664
3665 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3666 $self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3667 $self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3668 $self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3669 $self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3670
3671 my $row = 0;
3672
3673 for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3674 my $spell = $self->{spell}{$_};
3675
3676 $row++;
3677
3678 my $spell_cb = sub {
3679 my ($widget, $ev) = @_;
3680
3681 if ($ev->{button} == 1) {
3682 $::CONN->user_send ("cast $spell->{name}");
3683 } elsif ($ev->{button} == 2) {
3684 $::CONN->user_send ("invoke $spell->{name}");
3685 } elsif ($ev->{button} == 3) {
3686 (new CFClient::UI::Menu
3687 items => [
3688 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3689 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3690 ],
3691 )->popup ($ev);
3692 } else {
3693 return 0;
3694 }
3695
3696 1
3697 };
3698
3699 my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3700
3701 #TODO: add path info to tooltip
3702 #$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
3703
3704 $self->add (0, $row, new CFClient::UI::Face
3705 face => $spell->{face},
3706 can_hover => 1,
3707 can_events => 1,
3708 tooltip => $tooltip,
3709 on_button_down => $spell_cb,
3710 );
3711
3712 $self->add (1, $row, new CFClient::UI::Label
3713 expand => 1,
3714 text => $spell->{name},
3715 can_hover => 1,
3716 can_events => 1,
3717 tooltip => $tooltip,
3718 on_button_down => $spell_cb,
3719 );
3720
3721 $self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3722 $self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3723 $self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3724 $self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3725 }
3726 });
3727}
3728
3486sub add_spell { 3729sub add_spell {
3487 my ($self, $spell) = @_; 3730 my ($self, $spell) = @_;
3731
3488 $self->{spells}->{$spell->{name}} = $spell; 3732 $self->{spell}->{$spell->{name}} = $spell;
3489 3733 $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} 3734}
3518 3735
3519sub remove_spell { 3736sub remove_spell {
3520 my ($self, $spell) = @_; 3737 my ($self, $spell) = @_;
3738
3521 delete $self->{spells}->{$spell->{name}}; 3739 delete $self->{spell}->{$spell->{name}};
3740 $self->rebuild_spell_list;
3741}
3742
3743sub clear_spells {
3744 my ($self) = @_;
3745
3746 $self->{spell} = {};
3522 $self->rebuild_spell_list; 3747 $self->rebuild_spell_list;
3523} 3748}
3524 3749
3525############################################################################# 3750#############################################################################
3526 3751
… …
3563 $coord = $max - $size if $coord > $max - $size; 3788 $coord = $max - $size if $coord > $max - $size;
3564 3789
3565 int $coord + 0.5 3790 int $coord + 0.5
3566} 3791}
3567 3792
3568sub size_allocate { 3793sub invoke_size_allocate {
3569 my ($self, $w, $h) = @_; 3794 my ($self, $w, $h) = @_;
3570 3795
3571 for my $child ($self->children) { 3796 for my $child ($self->children) {
3572 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3797 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3573 3798
… …
3577 $X = _to_pixel $X, $W, $self->{w}; 3802 $X = _to_pixel $X, $W, $self->{w};
3578 $Y = _to_pixel $Y, $H, $self->{h}; 3803 $Y = _to_pixel $Y, $H, $self->{h};
3579 3804
3580 $child->configure ($X, $Y, $W, $H); 3805 $child->configure ($X, $Y, $W, $H);
3581 } 3806 }
3807
3808 1
3582} 3809}
3583 3810
3584sub coord2local { 3811sub coord2local {
3585 my ($self, $x, $y) = @_; 3812 my ($self, $x, $y) = @_;
3586 3813
… …
3712 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 3939 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3713 3940
3714 $w = 0 if $w < 0; 3941 $w = 0 if $w < 0;
3715 $h = 0 if $h < 0; 3942 $h = 0 if $h < 0;
3716 3943
3944 $w = max $widget->{min_w}, $w;
3945 $h = max $widget->{min_h}, $h;
3946
3947# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
3948# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
3949
3950 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3951 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3952
3717 $w = int $w + 0.5; 3953 $w = int $w + 0.5;
3718 $h = int $h + 0.5; 3954 $h = int $h + 0.5;
3719 3955
3720 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 3956 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3721 $widget->{old_w} = $widget->{w}; 3957 $widget->{old_w} = $widget->{w};

Diff Legend

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