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.252 by root, Sun May 28 23:21:28 2006 UTC vs.
Revision 1.261 by elmex, Tue May 30 14:45:56 2006 UTC

… …
17our $BUTTON_STATE; 17our $BUTTON_STATE;
18 18
19our %WIDGET; # all widgets, weak-referenced 19our %WIDGET; # all widgets, weak-referenced
20 20
21sub get_layout { 21sub get_layout {
22 my $layout;
23
22 for (grep { $_->{name} } values %WIDGET) { 24 for (grep { $_->{name} } values %WIDGET) {
23 $LAYOUT->{$_->{name}} = { 25 my $win = $layout->{$_->{name}} = { };
24 x => $_->{x} / $::WIDTH,
25 y => $_->{y} / $::HEIGHT,
26 w => $_->{w} / $::WIDTH,
27 h => $_->{h} / $::HEIGHT
28 }; 26
29 } 27 $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
28 $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
29 $win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
30 $win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
30 31
31 return $LAYOUT; 32 $win->{show} = $_->{visible} && $_->{is_toplevel};
33 }
34
35 $layout
32} 36}
33 37
34sub set_layout { 38sub set_layout {
35 my ($layout) = @_; 39 my ($layout) = @_;
40
36 $LAYOUT = $layout; 41 $LAYOUT = $layout;
37} 42}
38 43
39sub check_tooltip { 44sub check_tooltip {
40 if (!$GRAB) { 45 if (!$GRAB) {
41 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 46 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
42 if (length $widget->{tooltip}) { 47 if (length $widget->{tooltip}) {
43 48
44 if ($TOOLTIP->{owner} != $widget) { 49 if ($TOOLTIP->{owner} != $widget) {
50 $TOOLTIP->hide;
51
45 $TOOLTIP->{owner} = $widget; 52 $TOOLTIP->{owner} = $widget;
46 53
47 my $tip = $widget->{tooltip}; 54 my $tip = $widget->{tooltip};
48 55
49 $tip = $tip->($widget) if CODE:: eq ref $tip; 56 $tip = $tip->($widget) if CODE:: eq ref $tip;
50 57
51 $TOOLTIP->set_tooltip_from ($widget); 58 $TOOLTIP->set_tooltip_from ($widget);
52
53 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
54
55 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
56 if $x + $TOOLTIP->{w} > $::WIDTH;
57
58 $TOOLTIP->move ($x, $y);
59 $TOOLTIP->show; 59 $TOOLTIP->show;
60 } 60 }
61 61
62 return; 62 return;
63 } 63 }
… …
170sub rescale_widgets { 170sub rescale_widgets {
171 my ($sx, $sy) = @_; 171 my ($sx, $sy) = @_;
172 172
173 for my $widget (values %WIDGET) { 173 for my $widget (values %WIDGET) {
174 if ($widget->{is_toplevel}) { 174 if ($widget->{is_toplevel}) {
175 $widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
176 $widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
177
175 $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x}; 178 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
176 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 179 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
177 $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w}; 180 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
178 $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y}; 181 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
179 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 182 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
180 $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h}; 183 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
184
185 $widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
186 $widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
187
181 } 188 }
182 } 189 }
183 190
184 reconfigure_widgets; 191 reconfigure_widgets;
185} 192}
… …
194 201
195sub new { 202sub new {
196 my $class = shift; 203 my $class = shift;
197 204
198 my $self = bless { 205 my $self = bless {
199 x => 0, 206 x => "center",
200 y => 0, 207 y => "center",
201 z => 0, 208 z => 0,
209 w => undef,
210 h => undef,
202 can_events => 1, 211 can_events => 1,
203 @_ 212 @_
204 }, $class; 213 }, $class;
214
215 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
205 216
206 for (keys %$self) { 217 for (keys %$self) {
207 if (/^on_(.*)$/) { 218 if (/^on_(.*)$/) {
208 $self->connect ($1 => delete $self->{$_}); 219 $self->connect ($1 => delete $self->{$_});
209 } 220 }
210 } 221 }
211 222
212 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
213
214 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) { 223 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
215 $self->{req_x} = $layout->{x} * $::WIDTH; 224 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
216 $self->{req_y} = $layout->{y} * $::HEIGHT; 225 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
217 $self->{def_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH; 226 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
218 $self->{def_h} = ($layout->{h} != 0 ? $layout->{h} : 1) * $::HEIGHT; 227 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
228
229 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
230 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
231
232 $self->show if $layout->{show};
219 } 233 }
220 234
221 $self 235 $self
222} 236}
223 237
… …
232 my ($self) = @_; 246 my ($self) = @_;
233 247
234 return if $self->{parent}; 248 return if $self->{parent};
235 249
236 $CFClient::UI::ROOT->add ($self); 250 $CFClient::UI::ROOT->add ($self);
237}
238
239sub center {
240 my ($self) = @_;
241
242 $CFClient::UI::ROOT->on_post_alloc (
243 "center_$self" => sub {
244 $self->move (($self->{parent}{w} - $self->{w}) * 0.5, ($self->{parent}{h} - $self->{h}) * 0.5);
245 },
246 );
247
248 $self->update;
249} 251}
250 252
251sub set_visible { 253sub set_visible {
252 my ($self) = @_; 254 my ($self) = @_;
253 255
… …
308 310
309 $self->{parent}->remove ($self) 311 $self->{parent}->remove ($self)
310 if $self->{parent}; 312 if $self->{parent};
311} 313}
312 314
313sub move { 315sub move_abs {
314 my ($self, $x, $y, $z) = @_; 316 my ($self, $x, $y, $z) = @_;
315 317
316 $self->{x} = int $x; 318 $self->{x} = List::Util::max 0, int $x;
317 $self->{y} = int $y; 319 $self->{y} = List::Util::max 0, int $y;
318 $self->{z} = $z if defined $z; 320 $self->{z} = $z if defined $z;
319 321
320 $self->update; 322 $self->update;
321} 323}
322 324
323sub set_size { 325sub set_size {
324 my ($self, $w, $h) = @_; 326 my ($self, $w, $h) = @_;
325 327
326 $self->{def_w} = $w; 328 $self->{force_w} = $w;
327 $self->{def_h} = $h; 329 $self->{force_h} = $h;
328 330
329 $self->realloc; 331 $self->realloc;
330} 332}
331 333
332sub size_request { 334sub size_request {
… …
336 338
337sub configure { 339sub configure {
338 my ($self, $x, $y, $w, $h) = @_; 340 my ($self, $x, $y, $w, $h) = @_;
339 341
340 if ($self->{aspect}) { 342 if ($self->{aspect}) {
343 my ($ow, $oh) = ($w, $h);
344
341 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 345 $w = List::Util::min $w, int $h * $self->{aspect};
342 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 346 $h = List::Util::min $h, int $w / $self->{aspect};
343 347
344 # use alignment to adjust x, y 348 # use alignment to adjust x, y
345 349
346 $x += int +($w - $w2) * 0.5; 350 $x += int 0.5 * ($ow - $w);
347 $y += int +($h - $h2) * 0.5; 351 $y += int 0.5 * ($oh - $h);
348
349 ($w, $h) = ($w2, $h2);
350 } 352 }
351 353
352 if ($self->{x} != $x || $self->{y} != $y) { 354 if ($self->{x} ne $x || $self->{y} ne $y) {
353 $self->{x} = $x; 355 $self->{x} = $x;
354 $self->{y} = $y; 356 $self->{y} = $y;
355 $self->update; 357 $self->update;
356 } 358 }
357 359
358 if ($self->{w} != $w || $self->{h} != $h) { 360 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
359 return unless $self->{visible}; 361 return unless $self->{visible};
360 362
363 $self->{alloc_w} = $w;
364 $self->{alloc_h} = $h;
365
361 $self->{root}->{size_alloc}{$self+0} = [$self, $w, $h]; 366 $self->{root}{size_alloc}{$self+0} = $self;
362 } 367 }
363} 368}
364 369
365sub size_allocate { 370sub size_allocate {
366 # nothing to be done 371 # nothing to be done
… …
466 471
467sub set_parent { 472sub set_parent {
468 my ($self, $parent) = @_; 473 my ($self, $parent) = @_;
469 474
470 Scalar::Util::weaken ($self->{parent} = $parent); 475 Scalar::Util::weaken ($self->{parent} = $parent);
471
472 $self->set_visible if $parent->{visible}; 476 $self->set_visible if $parent->{visible};
473} 477}
474 478
475sub connect { 479sub connect {
476 my ($self, $signal, $cb) = @_; 480 my ($self, $signal, $cb) = @_;
… …
497 501
498sub realloc { 502sub realloc {
499 my ($self) = @_; 503 my ($self) = @_;
500 504
501 if ($self->{visible}) { 505 if ($self->{visible}) {
502 return if $self->{root}{realloc}{$self}; 506 return if $self->{root}{realloc}{$self+0};
503 507
504 $self->{root}{realloc}{$self} = $self; 508 $self->{root}{realloc}{$self+0} = $self;
505 $self->{root}->update; 509 $self->{root}->update;
506 } else { 510 } else {
507 delete $self->{req_w}; 511 delete $self->{req_w};
512 delete $self->{req_h};
508 } 513 }
509} 514}
510 515
511sub update { 516sub update {
512 my ($self) = @_; 517 my ($self) = @_;
513 518
514 $self->{parent}->update 519 $self->{parent}->update
515 if $self->{parent}; 520 if $self->{parent};
521}
522
523sub reconfigure {
524 my ($self) = @_;
525
526 $self->realloc;
527 $self->update;
516} 528}
517 529
518sub draw { 530sub draw {
519 my ($self) = @_; 531 my ($self) = @_;
520 532
… …
538 glVertex $x , $y + $self->{h}; 550 glVertex $x , $y + $self->{h};
539 glEnd; 551 glEnd;
540 glDisable GL_BLEND; 552 glDisable GL_BLEND;
541 } 553 }
542 554
543 if ($ENV{PCLIENT_DEBUG}) { 555 if ($ENV{CFPLUS_DEBUG} & 1) {
544 glPushMatrix; 556 glPushMatrix;
545 glColor 1, 1, 0, 1; 557 glColor 1, 1, 0, 1;
546 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 558 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
547 glBegin GL_LINE_LOOP; 559 glBegin GL_LINE_LOOP;
548 glVertex 0 , 0; 560 glVertex 0 , 0;
… …
624 my ($class, %arg) = @_; 636 my ($class, %arg) = @_;
625 $class->SUPER::new (can_events => 0, %arg); 637 $class->SUPER::new (can_events => 0, %arg);
626} 638}
627 639
628sub size_request { 640sub size_request {
629 (0, 0) 641 my ($self) = @_;
642
643 ($self->{w} + 0, $self->{h} + 0)
630} 644}
631 645
632sub draw { } 646sub draw { }
633 647
634############################################################################# 648#############################################################################
… …
755sub size_request { 769sub size_request {
756 $_[0]{children}[0]->size_request 770 $_[0]{children}[0]->size_request
757} 771}
758 772
759sub size_allocate { 773sub size_allocate {
760 my ($self, $w, $h, $changed) = @_; 774 my ($self, $w, $h) = @_;
761 775
762 $self->{children}[0]->configure (0, 0, $w, $h); 776 $self->{children}[0]->configure (0, 0, $w, $h);
763} 777}
764 778
765############################################################################# 779#############################################################################
… …
782 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 796 $ROOT->on_post_alloc ($self => sub { $self->render_child });
783 $self->SUPER::update; 797 $self->SUPER::update;
784} 798}
785 799
786sub size_allocate { 800sub size_allocate {
787 my ($self, $w, $h, $changed) = @_; 801 my ($self, $w, $h) = @_;
788 802
789 $self->SUPER::size_allocate ($w, $h, $changed); 803 $self->SUPER::size_allocate ($w, $h);
790 $self->update 804 $self->update;
791 if $changed;
792} 805}
793 806
794sub _render { 807sub _render {
795 $_[0]{children}[0]->draw; 808 $_[0]{children}[0]->draw;
796} 809}
… …
840} 853}
841 854
842sub size_request { 855sub size_request {
843 my ($self) = @_; 856 my ($self) = @_;
844 857
845 my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 858 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
846 859
847 $w = 10 if $self->{scroll_x}; 860 $w = 10 if $self->{scroll_x};
848 $h = 10 if $self->{scroll_y}; 861 $h = 10 if $self->{scroll_y};
849 862
850 ($w, $h) 863 ($w, $h)
851} 864}
852 865
853sub size_allocate { 866sub size_allocate {
854 my ($self, $w, $h, $changed) = @_; 867 my ($self, $w, $h) = @_;
855 868
869 my $child = $self->child;
870
856 $w = $self->{child_w} if $self->{scroll_x} && $self->{child_w}; 871 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
857 $h = $self->{child_h} if $self->{scroll_y} && $self->{child_h}; 872 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
858 873
859 $self->child->configure (0, 0, $w, $h); 874 $self->child->configure (0, 0, $w, $h);
860 $self->update; 875 $self->update;
861} 876}
862 877
… …
946 my $child = $self->{vp}->child; 961 my $child = $self->{vp}->child;
947 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); 962 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
948} 963}
949 964
950sub size_allocate { 965sub size_allocate {
951 my ($self, $w, $h, $changed) = @_; 966 my ($self, $w, $h) = @_;
952 967
953 $self->SUPER::size_allocate ($w, $h, $changed); 968 $self->SUPER::size_allocate ($w, $h);
954 969
955 my $child = $self->{vp}->child; 970 my $child = $self->{vp}->child;
956 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); 971 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
957} 972}
958 973
… …
1005 1020
1006our @ISA = CFClient::UI::Bin::; 1021our @ISA = CFClient::UI::Bin::;
1007 1022
1008use CFClient::OpenGL; 1023use CFClient::OpenGL;
1009 1024
1010my @tex = 1025my $bg =
1026 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1027 mipmap => 1, wrap => 1;
1028
1029my @border =
1011 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1030 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1012 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1031 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1013 1032
1014sub new { 1033sub new {
1015 my $class = shift; 1034 my $class = shift;
1016 1035
1017 my $self = $class->SUPER::new ( 1036 my $self = $class->SUPER::new (
1018 bg => [1, 1, 1, 1], 1037 bg => [1, 1, 1, 1],
1019 border_bg => [1, 1, 1, 1], 1038 border_bg => [1, 1, 1, 1],
1020 border => 0.6, 1039 border => 0.6,
1021 is_toplevel => 1,
1022 can_events => 1, 1040 can_events => 1,
1041 min_w => 16,
1042 min_h => 16,
1023 @_ 1043 @_
1024 ); 1044 );
1025 1045
1026 $self->{title} &&= new CFClient::UI::Label 1046 $self->{title} &&= new CFClient::UI::Label
1027 align => 0, 1047 align => 0,
… …
1046 $h + $self->border * 2, 1066 $h + $self->border * 2,
1047 ) 1067 )
1048} 1068}
1049 1069
1050sub size_allocate { 1070sub size_allocate {
1051 my ($self, $w, $h, $changed) = @_; 1071 my ($self, $w, $h) = @_;
1052
1053 return unless $changed;
1054 1072
1055 $h -= List::Util::max 0, $self->border * 2; 1073 $h -= List::Util::max 0, $self->border * 2;
1056 $w -= List::Util::max 0, $self->border * 2; 1074 $w -= List::Util::max 0, $self->border * 2;
1057 1075
1058 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2) 1076 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
… …
1082 my ($ev, $x, $y) = @_; 1100 my ($ev, $x, $y) = @_;
1083 1101
1084 my $dx = $ev->{x} - $ox; 1102 my $dx = $ev->{x} - $ox;
1085 my $dy = $ev->{y} - $oy; 1103 my $dy = $ev->{y} - $oy;
1086 1104
1087 $self->{user_x} = $wx + $dx * $mx;
1088 $self->{user_y} = $wy + $dy * $my;
1089 $self->{def_w} = $bw + $dx * ($mx ? -1 : 1); 1105 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1090 $self->{def_h} = $bh + $dy * ($my ? -1 : 1); 1106 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1091 $self->move ($self->{user_x}, $self->{user_y}); 1107
1092 $self->realloc; 1108 $self->realloc;
1109 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1093 }; 1110 };
1094 1111
1095 } elsif ($lr ^ $td) { 1112 } elsif ($lr ^ $td) {
1096 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1113 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1097 my ($bx, $by) = ($self->{x}, $self->{y}); 1114 my ($bx, $by) = ($self->{x}, $self->{y});
… …
1099 $self->{motion} = sub { 1116 $self->{motion} = sub {
1100 my ($ev, $x, $y) = @_; 1117 my ($ev, $x, $y) = @_;
1101 1118
1102 ($x, $y) = ($ev->{x}, $ev->{y}); 1119 ($x, $y) = ($ev->{x}, $ev->{y});
1103 1120
1104 $self->{user_x} = $bx + $x - $ox; 1121 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1105 $self->{user_y} = $by + $y - $oy;
1106
1107 $self->move ($self->{user_x}, $self->{user_y});
1108 $self->realloc;
1109 }; 1122 };
1110 } 1123 }
1111} 1124}
1112 1125
1113sub button_up { 1126sub button_up {
… …
1132 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1145 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1133 1146
1134 my $border = $self->border; 1147 my $border = $self->border;
1135 1148
1136 glColor @{ $self->{border_bg} }; 1149 glColor @{ $self->{border_bg} };
1137 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1150 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1138 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1151 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1139 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1152 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1140 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1153 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1141 1154
1142 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1155 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1143 my $bg = $tex[0]; 1156 glColor @{ $self->{bg} };
1144 1157
1145 # TODO: repeat texture not scale 1158 # TODO: repeat texture not scale
1159 # solve this better(?)
1146 my $rep_x = $cw / $bg->{w}; 1160 $bg->{s} = $cw / $bg->{w};
1147 my $rep_y = $ch / $bg->{h}; 1161 $bg->{t} = $ch / $bg->{h};
1148
1149 glColor @{ $self->{bg} };
1150
1151 $bg->{s} = $rep_x;
1152 $bg->{t} = $rep_y;
1153 $bg->{wrap_mode} = 1;
1154 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1162 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1155 } 1163 }
1156 1164
1157 glDisable GL_TEXTURE_2D; 1165 glDisable GL_TEXTURE_2D;
1158 1166
… …
1240 (sum @$hs), 1248 (sum @$hs),
1241 ) 1249 )
1242} 1250}
1243 1251
1244sub size_allocate { 1252sub size_allocate {
1245 my ($self, $w, $h, $changed) = @_; 1253 my ($self, $w, $h) = @_;
1246 1254
1247 my ($ws, $hs) = $self->get_wh; 1255 my ($ws, $hs) = $self->get_wh;
1248 1256
1249 my $req_w = (sum @$ws) || 1; 1257 my $req_w = (sum @$ws) || 1;
1250 my $req_h = (sum @$hs) || 1; 1258 my $req_h = (sum @$hs) || 1;
… …
1328 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1336 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1329 ) 1337 )
1330} 1338}
1331 1339
1332sub size_allocate { 1340sub size_allocate {
1333 my ($self, $w, $h, $changed) = @_; 1341 my ($self, $w, $h) = @_;
1334 1342
1335 my $space = $self->{vertical} ? $h : $w; 1343 my $space = $self->{vertical} ? $h : $w;
1336 my $children = $self->{children}; 1344 my $children = $self->{children};
1337 1345
1338 my @req; 1346 my @req;
… …
1421 ellipsise => 3, # end 1429 ellipsise => 3, # end
1422 layout => (new CFClient::Layout), 1430 layout => (new CFClient::Layout),
1423 fontsize => 1, 1431 fontsize => 1,
1424 align => -1, 1432 align => -1,
1425 valign => -1, 1433 valign => -1,
1426 padding => 2, 1434 padding_x => 2,
1435 padding_y => 2,
1427 can_events => 0, 1436 can_events => 0,
1428 %arg 1437 %arg
1429 ); 1438 );
1430 1439
1431 if (exists $self->{template}) { 1440 if (exists $self->{template}) {
… …
1507 1516
1508 $w = List::Util::max $w, $w2; 1517 $w = List::Util::max $w, $w2;
1509 $h = List::Util::max $h, $h2; 1518 $h = List::Util::max $h, $h2;
1510 } 1519 }
1511 1520
1512 ( 1521 ($w, $h)
1513 $w + $self->{padding} * 2,
1514 $h + $self->{padding} * 2,
1515 )
1516} 1522}
1517 1523
1518sub size_allocate { 1524sub size_allocate {
1519 my ($self, $w, $h, $changed) = @_; 1525 my ($self, $w, $h) = @_;
1520 1526
1521 delete $self->{texture} 1527 delete $self->{texture};
1522 if $changed;
1523} 1528}
1524 1529
1525sub set_fontsize { 1530sub set_fontsize {
1526 my ($self, $fontsize) = @_; 1531 my ($self, $fontsize) = @_;
1527 1532
… …
1544 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1549 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1545 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1550 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1546 1551
1547 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1552 my $tex = new_from_layout CFClient::Texture $self->{layout};
1548 1553
1549 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1554 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1550 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1555 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1551 : ($self->{w} - $tex->{w}) * 0.5); 1556 : ($self->{w} - $tex->{w}) * 0.5);
1552 1557
1553 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1558 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1554 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1559 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1555 : ($self->{h} - $tex->{h}) * 0.5); 1560 : ($self->{h} - $tex->{h}) * 0.5);
1556 1561
1557 $tex 1562 $tex
1558 }; 1563 };
1559 1564
… …
1798 1803
1799sub new { 1804sub new {
1800 my $class = shift; 1805 my $class = shift;
1801 1806
1802 $class->SUPER::new ( 1807 $class->SUPER::new (
1803 padding => 4, 1808 padding_x => 4,
1809 padding_y => 4,
1804 fg => [1, 1, 1], 1810 fg => [1, 1, 1],
1805 active_fg => [0, 0, 1], 1811 active_fg => [0, 0, 1],
1806 can_hover => 1, 1812 can_hover => 1,
1807 align => 0, 1813 align => 0,
1808 valign => 0, 1814 valign => 0,
… …
1855 1861
1856sub new { 1862sub new {
1857 my $class = shift; 1863 my $class = shift;
1858 1864
1859 $class->SUPER::new ( 1865 $class->SUPER::new (
1860 padding => 2, 1866 padding_x => 2,
1867 padding_y => 2,
1861 fg => [1, 1, 1], 1868 fg => [1, 1, 1],
1862 active_fg => [1, 1, 0], 1869 active_fg => [1, 1, 0],
1863 bg => [0, 0, 0, 0.2], 1870 bg => [0, 0, 0, 0.2],
1864 active_bg => [1, 1, 1, 0.5], 1871 active_bg => [1, 1, 1, 0.5],
1865 state => 0, 1872 state => 0,
… …
1869} 1876}
1870 1877
1871sub size_request { 1878sub size_request {
1872 my ($self) = @_; 1879 my ($self) = @_;
1873 1880
1874 ($self->{padding} * 2 + 6) x 2 1881 (6) x 2
1875} 1882}
1876 1883
1877sub button_down { 1884sub button_down {
1878 my ($self, $ev, $x, $y) = @_; 1885 my ($self, $ev, $x, $y) = @_;
1879 1886
1880 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1887 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1881 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1888 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1882 $self->{state} = !$self->{state}; 1889 $self->{state} = !$self->{state};
1883 $self->_emit (changed => $self->{state}); 1890 $self->_emit (changed => $self->{state});
1884 } 1891 }
1885} 1892}
1886 1893
1887sub _draw { 1894sub _draw {
1888 my ($self) = @_; 1895 my ($self) = @_;
1889 1896
1890 $self->SUPER::_draw; 1897 $self->SUPER::_draw;
1891 1898
1892 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1899 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1893 1900
1894 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1901 my ($w, $h) = @$self{qw(w h)};
1902
1903 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1895 1904
1896 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1905 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1897 1906
1898 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1907 my $tex = $self->{state} ? $tex[1] : $tex[0];
1899 1908
… …
2164 fg => [1, 1, 1], 2173 fg => [1, 1, 1],
2165 active_fg => [0, 0, 0], 2174 active_fg => [0, 0, 0],
2166 bg => [0, 0, 0, 0.2], 2175 bg => [0, 0, 0, 0.2],
2167 active_bg => [1, 1, 1, 0.5], 2176 active_bg => [1, 1, 1, 0.5],
2168 range => [0, 0, 100, 10, 0], 2177 range => [0, 0, 100, 10, 0],
2169 req_w => $::WIDTH / 80, 2178 min_w => $::WIDTH / 80,
2170 req_h => $::WIDTH / 80, 2179 min_h => $::WIDTH / 80,
2171 vertical => 0, 2180 vertical => 0,
2172 can_hover => 1, 2181 can_hover => 1,
2173 inner_pad => 0.02, 2182 inner_pad => 0.02,
2174 @_ 2183 @_
2175 ); 2184 );
… …
2215} 2224}
2216 2225
2217sub size_request { 2226sub size_request {
2218 my ($self) = @_; 2227 my ($self) = @_;
2219 2228
2220 my $w = $self->{req_w}; 2229 ($self->{req_w}, $self->{req_h})
2221 my $h = $self->{req_h};
2222
2223 $self->{vertical} ? ($h, $w) : ($w, $h)
2224} 2230}
2225 2231
2226sub button_down { 2232sub button_down {
2227 my ($self, $ev, $x, $y) = @_; 2233 my ($self, $ev, $x, $y) = @_;
2228 2234
… …
2378 $self->{fontsize} = $fontsize; 2384 $self->{fontsize} = $fontsize;
2379 $self->reflow; 2385 $self->reflow;
2380} 2386}
2381 2387
2382sub size_allocate { 2388sub size_allocate {
2383 my ($self, $w, $h, $changed) = @_; 2389 my ($self, $w, $h) = @_;
2384 2390
2385 $self->SUPER::size_allocate ($w, $h, $changed); 2391 $self->SUPER::size_allocate ($w, $h);
2386
2387 return unless $changed;
2388 2392
2389 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2393 $self->{layout}->set_font ($self->{font}) if $self->{font};
2390 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2394 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2391 $self->{layout}->set_width ($self->{children}[0]{w}); 2395 $self->{layout}->set_width ($self->{children}[0]{w});
2392 2396
… …
2615} 2619}
2616 2620
2617sub set_tooltip_from { 2621sub set_tooltip_from {
2618 my ($self, $widget) = @_; 2622 my ($self, $widget) = @_;
2619 2623
2624 my $tooltip = $widget->{tooltip};
2625
2626 if ($ENV{CFPLUS_DEBUG} & 2) {
2627 $tooltip .= "\n\n" . (ref $widget) . "\n"
2628 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2629 . "req $widget->{req_w} $widget->{req_h}\n"
2630 . "visible $widget->{visible}";
2631 }
2632
2620 $self->add (new CFClient::UI::Label 2633 $self->add (new CFClient::UI::Label
2621 markup => $widget->{tooltip}, 2634 markup => $tooltip,
2622 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2635 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2623 fontsize => 0.8, 2636 fontsize => 0.8,
2624 fg => [0, 0, 0, 1], 2637 fg => [0, 0, 0, 1],
2625 ellipsise => 0, 2638 ellipsise => 0,
2626 font => ($widget->{tooltip_font} || $::FONT_PROP), 2639 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2634 2647
2635 ($w + 4, $h + 4) 2648 ($w + 4, $h + 4)
2636} 2649}
2637 2650
2638sub size_allocate { 2651sub size_allocate {
2639 my ($self, $w, $h, $changed) = @_; 2652 my ($self, $w, $h) = @_;
2640 2653
2641 return unless $changed;
2642
2643 $self->SUPER::size_allocate ($w - 4, $h - 4, $changed); 2654 $self->SUPER::size_allocate ($w - 4, $h - 4);
2655}
2656
2657sub visibility_change {
2658 my ($self, $visible) = @_;
2659
2660 return unless $visible;
2661
2662 $self->{root}->on_post_alloc ("move_$self" => sub {
2663 my $widget = $self->{owner}
2664 or return;
2665
2666 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2667
2668 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2669 if $x + $self->{w} > $::WIDTH;
2670
2671 $self->move_abs ($x, $y);
2672 });
2644} 2673}
2645 2674
2646sub _draw { 2675sub _draw {
2647 my ($self) = @_; 2676 my ($self) = @_;
2648 2677
… …
2840 # maybe save $GRAB? must be careful about events... 2869 # maybe save $GRAB? must be careful about events...
2841 $GRAB = $self; 2870 $GRAB = $self;
2842 $self->{button} = $ev->{button}; 2871 $self->{button} = $ev->{button};
2843 2872
2844 $self->show; 2873 $self->show;
2845 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2874 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2846} 2875}
2847 2876
2848sub mouse_motion { 2877sub mouse_motion {
2849 my ($self, $ev, $x, $y) = @_; 2878 my ($self, $ev, $x, $y) = @_;
2850 2879
… …
2994 Scalar::Util::weaken ($self->{root} = $self); 3023 Scalar::Util::weaken ($self->{root} = $self);
2995 3024
2996 $self 3025 $self
2997} 3026}
2998 3027
2999sub configure {
3000 my ($self, $x, $y, $w, $h) = @_;
3001
3002 $self->{w} = $w;
3003 $self->{h} = $h;
3004}
3005
3006sub reconfigure {
3007 my ($self) = @_;
3008
3009 $self->SUPER::reconfigure;
3010
3011 $self->size_allocate ($self->{w}, $self->{h}, 1)
3012 if $self->{w};
3013}
3014
3015sub size_request { 3028sub size_request {
3016 my ($self) = @_; 3029 my ($self) = @_;
3017 3030
3018 ($self->{w}, $self->{h}) 3031 ($self->{w}, $self->{h})
3019} 3032}
3020 3033
3034sub _to_pixel {
3035 my ($coord, $size, $max) = @_;
3036
3037 $coord =
3038 $coord eq "center" ? ($max - $size) * 0.5
3039 : $coord eq "max" ? $max
3040 : $coord;
3041
3042 $coord = 0 if $coord < 0;
3043 $coord = $max - $size if $coord > $max - $size;
3044
3045 int $coord + 0.5
3046}
3047
3021sub size_allocate { 3048sub size_allocate {
3022 my ($self, $w, $h, $changed) = @_; 3049 my ($self, $w, $h) = @_;
3023 3050
3024 for my $child ($self->children) { 3051 for my $child ($self->children) {
3025 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3052 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3026 3053
3027 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3054 $X = $child->{force_x} if exists $child->{force_x};
3028 if exists $child->{req_x}; 3055 $Y = $child->{force_y} if exists $child->{force_y};
3029 3056
3030 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3057 $X = _to_pixel $X, $W, $self->{w};
3031 if exists $child->{req_y}; 3058 $Y = _to_pixel $Y, $H, $self->{h};
3032
3033 #delete @$child{qw(req_x req_y)};#d# def_x, def_y
3034
3035 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3036 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3037 3059
3038 $child->configure ($X, $Y, $W, $H); 3060 $child->configure ($X, $Y, $W, $H);
3039 } 3061 }
3040} 3062}
3041 3063
… …
3058} 3080}
3059 3081
3060sub add { 3082sub add {
3061 my ($self, @children) = @_; 3083 my ($self, @children) = @_;
3062 3084
3063 for my $child (@children) {
3064 $child->{is_toplevel} = 1; 3085 $_->{is_toplevel} = 1
3065 3086 for @children;
3066 # integerise window positions
3067 $child->{x} = int $child->{x};
3068 $child->{y} = int $child->{y};
3069 }
3070 3087
3071 $self->SUPER::add (@children); 3088 $self->SUPER::add (@children);
3072} 3089}
3073 3090
3074sub remove { 3091sub remove {
3075 my ($self, @children) = @_; 3092 my ($self, @children) = @_;
3076 3093
3077 $self->SUPER::remove (@children); 3094 $self->SUPER::remove (@children);
3095
3096 delete $self->{is_toplevel}
3097 for @children;
3078 3098
3079 while (@children) { 3099 while (@children) {
3080 my $w = pop @children; 3100 my $w = pop @children;
3081 push @children, $w->children; 3101 push @children, $w->children;
3082 $w->set_invisible; 3102 $w->set_invisible;
… …
3108 3128
3109 while () { 3129 while () {
3110 if ($self->{realloc}) { 3130 if ($self->{realloc}) {
3111 #TODO use array-of-depth approach 3131 #TODO use array-of-depth approach
3112 3132
3133 use sort 'stable';
3134
3113 @queue = sort { $a->{visible} <=> $b->{visible} } 3135 @queue = sort { $a->{visible} <=> $b->{visible} }
3114 @queue, values %{delete $self->{realloc}}; 3136 @queue, values %{delete $self->{realloc}};
3115 } 3137 }
3116 3138
3117 my $widget = pop @queue || last; 3139 my $widget = pop @queue || last;
3118 3140
3119 $widget->{visible} or last; # do not resize invisible widgets 3141 $widget->{visible} or last; # do not resize invisible widgets
3120 3142
3121 my ($w, $h) = $widget->{def_w} && $widget->{def_h}
3122 ? @$widget{qw(def_w def_h)}
3123 : $widget->size_request; 3143 my ($w, $h) = $widget->size_request;
3124 3144
3125 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d# 3145 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3146 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3147
3148 $w = $widget->{force_w} if exists $widget->{force_w};
3149 $h = $widget->{force_h} if exists $widget->{force_h};
3150
3151 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3152 || delete $widget->{force_realloc}) {
3153 $widget->{req_w} = $w;
3154 $widget->{req_h} = $h;
3155
3156 $self->{size_alloc}{$widget+0} = $widget;
3157
3158 if (my $parent = $widget->{parent}) {
3159 $self->{realloc}{$parent+0} = $parent;
3160 #unshift @queue, $parent;
3161 $parent->{force_size_alloc} = 1;
3162 $self->{size_alloc}{$parent+0} = $parent;
3126 3163 }
3127 $widget->{req_w} = $w; 3164 }
3128 $widget->{req_h} = $h;
3129 3165
3130 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3166 delete $self->{realloc}{$widget+0};
3131
3132 push @queue, $widget->{parent}
3133 if $widget->{parent};
3134 } 3167 }
3135 } 3168 }
3136 3169
3137 while (my $size_alloc = delete $self->{size_alloc}) { 3170 while (my $size_alloc = delete $self->{size_alloc}) {
3138 my @queue = sort $b->[0]{visible} <=> $a->[0]{visible}, 3171 my @queue = sort { $b->{visible} <=> $a->{visible} }
3139 values %$size_alloc; 3172 values %$size_alloc;
3140 3173
3141 while () { 3174 while () {
3142 my ($widget, $w, $h) = @{ pop @queue or last }; 3175 my $widget = pop @queue || last;
3176
3177 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3143 3178
3144 $w = 0 if $w < 0; 3179 $w = 0 if $w < 0;
3145 $h = 0 if $h < 0; 3180 $h = 0 if $h < 0;
3146 3181
3147 my $changed = $widget->{w} != $w || $widget->{h} != $h; 3182 $w = int $w + 0.5;
3183 $h = int $h + 0.5;
3148 3184
3185 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3149 $widget->{w} = $w; 3186 $widget->{w} = $w;
3150 $widget->{h} = $h; 3187 $widget->{h} = $h;
3151 3188
3152 $widget->emit (size_allocate => $w, $h, $changed); 3189 $widget->emit (size_allocate => $w, $h);
3190 }
3153 } 3191 }
3154 } 3192 }
3155 3193
3156 while ($self->{post_alloc_hook}) { 3194 while ($self->{post_alloc_hook}) {
3157 $_->() 3195 $_->()
3158 for values %{delete $self->{post_alloc_hook}}; 3196 for values %{delete $self->{post_alloc_hook}};
3159 } 3197 }
3198
3160 3199
3161 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3200 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3162 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3201 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3163 glClear GL_COLOR_BUFFER_BIT; 3202 glClear GL_COLOR_BUFFER_BIT;
3164 3203
… …
3171 $self->_draw; 3210 $self->_draw;
3172} 3211}
3173 3212
3174############################################################################# 3213#############################################################################
3175 3214
3215package CFClient::UI::BindEditor;
3216
3217our @ISA = CFClient::UI::FancyFrame::;
3218
3219sub new {
3220 my $class = shift;
3221
3222 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3223
3224 $self->add (my $vb = new CFClient::UI::VBox);
3225
3226
3227 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3228 text => "start recording",
3229 tooltip => "Start/Stops recording of actions."
3230 ."All subsequent actions after the recording started will be captured."
3231 ."The actions are displayed after the record was stopped."
3232 ."To bind the action you have to click on the 'Bind' button",
3233 on_activate => sub {
3234 unless ($self->{recording}) {
3235 $self->start;
3236 } else {
3237 $self->stop;
3238 }
3239 });
3240
3241 $vb->add (new CFClient::UI::Label text => "Actions:");
3242 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3243
3244 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3245 $vb->add (my $hb = new CFClient::UI::HBox);
3246 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3247 $hb->add (new CFClient::UI::Button
3248 text => "bind",
3249 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3250 on_activate => sub {
3251 $self->ask_for_bind;
3252 });
3253
3254 $vb->add (my $hb = new CFClient::UI::HBox);
3255 $hb->add (new CFClient::UI::Button
3256 text => "ok",
3257 expand => 1,
3258 tooltip => "This closes the binding editor and saves the binding",
3259 on_activate => sub {
3260 $self->hide;
3261 $self->commit;
3262 });
3263
3264 $hb->add (new CFClient::UI::Button
3265 text => "cancel",
3266 expand => 1,
3267 tooltip => "This closes the binding editor without saving",
3268 on_activate => sub {
3269 $self->hide;
3270 $self->{binding_cancel}->()
3271 if $self->{binding_cancel};
3272 });
3273
3274 $self->update_binding_widgets;
3275
3276 $self
3277}
3278
3279sub commit {
3280 my ($self) = @_;
3281 my ($mod, $sym, $cmds) = $self->get_binding;
3282 if ($sym != 0 && @$cmds > 0) {
3283 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3284 ."'. Don't forget 'Save Config'!");
3285 $self->{binding_change}->($mod, $sym, $cmds)
3286 if $self->{binding_change};
3287 } else {
3288 $::STATUSBOX->add ("No action bound, no key or action specified!");
3289 $self->{binding_cancel}->()
3290 if $self->{binding_cancel};
3291 }
3292}
3293
3294sub start {
3295 my ($self) = @_;
3296
3297 $self->{rec_btn}->set_text ("stop recording");
3298 $self->{recording} = 1;
3299 $self->clear_command_list;
3300 $::CONN->start_record if $::CONN;
3301}
3302
3303sub stop {
3304 my ($self) = @_;
3305
3306 $self->{rec_btn}->set_text ("start recording");
3307 $self->{recording} = 0;
3308
3309 my $rec;
3310 $rec = $::CONN->stop_record if $::CONN;
3311 return unless ref $rec eq 'ARRAY';
3312 $self->set_command_list ($rec);
3313}
3314
3315sub ask_for_bind {
3316 my ($self, $commit) = @_;
3317
3318 CFClient::Binder::open_binding_dialog (sub {
3319 my ($mod, $sym) = @_;
3320 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3321 $self->update_binding_widgets;
3322 $self->commit if $commit;
3323 });
3324}
3325
3326sub set_binding {
3327 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3328
3329 $self->clear_command_list;
3330 $self->{recording} = 0;
3331 $self->{rec_btn}->set_text ("start recording");
3332
3333 $self->{binding} = [$mod, $sym];
3334 $self->{commands} = $cmds;
3335
3336 $self->{binding_change} = $cb;
3337 $self->{binding_cancel} = $ccb;
3338
3339 $self->update_binding_widgets;
3340}
3341
3342sub update_binding_widgets {
3343 my ($self) = @_;
3344 my ($mod, $sym, $cmds) = $self->get_binding;
3345 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3346 $self->set_command_list ($cmds);
3347}
3348
3349sub get_binding {
3350 my ($self) = @_;
3351 return (
3352 $self->{binding}->[0],
3353 $self->{binding}->[1],
3354 [ grep { defined $_ } @{$self->{commands}} ]
3355 );
3356}
3357
3358sub clear_command_list {
3359 my ($self) = @_;
3360 $self->{cmdbox}->clear ();
3361}
3362
3363sub set_command_list {
3364 my ($self, $cmds) = @_;
3365
3366 $self->{cmdbox}->clear ();
3367 $self->{commands} = $cmds;
3368
3369 my $idx = 0;
3370
3371 for (@$cmds) {
3372 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3373
3374 my $i = $idx;
3375 $hb->add (new CFClient::UI::Button
3376 text => "delete",
3377 tooltip => "Deletes the action from the record",
3378 on_activate => sub {
3379 $self->{cmdbox}->remove ($hb);
3380 $cmds->[$i] = undef;
3381 });
3382
3383 $hb->add (new CFClient::UI::Label text => $_);
3384
3385 $idx++
3386 }
3387}
3388
3389
3390#############################################################################
3391
3176package CFClient::UI; 3392package CFClient::UI;
3177 3393
3178$ROOT = new CFClient::UI::Root; 3394$ROOT = new CFClient::UI::Root;
3179$TOOLTIP = new CFClient::UI::Tooltip z => 900; 3395$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3180 3396

Diff Legend

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