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

Diff Legend

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