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.240 by root, Fri May 26 18:28:23 2006 UTC vs.
Revision 1.262 by elmex, Wed May 31 13:44:26 2006 UTC

… …
9use CFClient; 9use CFClient;
10use CFClient::Texture; 10use CFClient::Texture;
11 11
12our ($FOCUS, $HOVER, $GRAB); # various widgets 12our ($FOCUS, $HOVER, $GRAB); # various widgets
13 13
14our $LAYOUT;
14our $ROOT; 15our $ROOT;
15our $TOOLTIP; 16our $TOOLTIP;
16our $BUTTON_STATE; 17our $BUTTON_STATE;
17 18
18our %WIDGET; # all widgets, weak-referenced 19our %WIDGET; # all widgets, weak-referenced
20
21sub get_layout {
22 my $layout;
23
24 for (grep { $_->{name} } values %WIDGET) {
25 my $win = $layout->{$_->{name}} = { };
26
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};
31
32 $win->{show} = $_->{visible} && $_->{is_toplevel};
33 }
34
35 $layout
36}
37
38sub set_layout {
39 my ($layout) = @_;
40
41 $LAYOUT = $layout;
42}
19 43
20sub check_tooltip { 44sub check_tooltip {
21 if (!$GRAB) { 45 if (!$GRAB) {
22 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 46 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
23 if (length $widget->{tooltip}) { 47 if (length $widget->{tooltip}) {
24 48
25 if ($TOOLTIP->{owner} != $widget) { 49 if ($TOOLTIP->{owner} != $widget) {
50 $TOOLTIP->hide;
51
26 $TOOLTIP->{owner} = $widget; 52 $TOOLTIP->{owner} = $widget;
27 53
28 my $tip = $widget->{tooltip}; 54 my $tip = $widget->{tooltip};
29 55
30 $tip = $tip->($widget) if CODE:: eq ref $tip; 56 $tip = $tip->($widget) if CODE:: eq ref $tip;
31 57
32 $TOOLTIP->set_tooltip_from ($widget); 58 $TOOLTIP->set_tooltip_from ($widget);
33 $TOOLTIP->show; 59 $TOOLTIP->show;
34
35 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
36
37 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
38 if $x + $TOOLTIP->{w} > $::WIDTH;
39
40 $TOOLTIP->move ($x, $y);
41 $TOOLTIP->check_size;
42 $TOOLTIP->update;
43 } 60 }
44 61
45 return; 62 return;
46 } 63 }
47 } 64 }
… …
153sub rescale_widgets { 170sub rescale_widgets {
154 my ($sx, $sy) = @_; 171 my ($sx, $sy) = @_;
155 172
156 for my $widget (values %WIDGET) { 173 for my $widget (values %WIDGET) {
157 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
158 $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.]+$/;
159 $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};
160 $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};
161 $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
162 $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.]+$/;
163 $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};
164 $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};
165 $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_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
166 } 188 }
167 } 189 }
168 190
169 reconfigure_widgets; 191 reconfigure_widgets;
170} 192}
… …
179 201
180sub new { 202sub new {
181 my $class = shift; 203 my $class = shift;
182 204
183 my $self = bless { 205 my $self = bless {
184 x => 0, 206 x => "center",
185 y => 0, 207 y => "center",
186 z => 0, 208 z => 0,
209 w => undef,
210 h => undef,
187 can_events => 1, 211 can_events => 1,
188 @_ 212 @_
189 }, $class; 213 }, $class;
190 214
215 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
216
191 for (keys %$self) { 217 for (keys %$self) {
192 if (/^connect_(.*)$/) { 218 if (/^on_(.*)$/) {
193 $self->connect ($1 => delete $self->{$_}); 219 $self->connect ($1 => delete $self->{$_});
194 } 220 }
195 } 221 }
196 222
197 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 223 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
224 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
225 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
226 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
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};
233 }
198 234
199 $self 235 $self
200} 236}
201 237
202sub destroy { 238sub destroy {
… …
206 %$self = (); 242 %$self = ();
207} 243}
208 244
209sub show { 245sub show {
210 my ($self) = @_; 246 my ($self) = @_;
247
211 return if $self->{parent}; 248 return if $self->{parent};
212 249
213 $CFClient::UI::ROOT->add ($self); 250 $CFClient::UI::ROOT->add ($self);
214} 251}
215 252
216sub show_centered { 253sub set_visible {
217 my ($self) = @_; 254 my ($self) = @_;
255
218 return if $self->{parent}; 256 return if $self->{visible};
219 257
220 $self->show; 258 $self->{root} = $self->{parent}{root};
259 $self->{visible} = $self->{parent}{visible} + 1;
221 260
222 $CFClient::UI::ROOT->on_post_alloc ( 261 $self->emit (visibility_change => 1);
223 "centered $self" => sub { 262
224 $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5); 263 $self->realloc if !exists $self->{req_w};
225 }, 264
226 ); 265 $_->set_visible for $self->children;
227} 266}
228 267
229sub set_invisible { 268sub set_invisible {
230 my ($self) = @_; 269 my ($self) = @_;
231 270
232 # broken show/hide model 271 return unless $self->{visible};
233 272
273 $_->set_invisible for $self->children;
274
275 delete $self->{root};
234 delete $self->{visible}; 276 delete $self->{visible};
235 277
236 undef $GRAB if $GRAB == $self; 278 undef $GRAB if $GRAB == $self;
237 undef $HOVER if $HOVER == $self; 279 undef $HOVER if $HOVER == $self;
238 280
239 CFClient::UI::check_tooltip 281 CFClient::UI::check_tooltip
240 if $CFClient::UI::TOOLTIP->{owner} == $self; 282 if $TOOLTIP->{owner} == $self;
241 283
242 $self->focus_out; 284 $self->focus_out;
285
286 $self->emit (visibility_change => 0);
287}
288
289sub set_visibility {
290 my ($self, $visible) = @_;
291
292 return if $self->{visible} == $visible;
293
294 $visible ? $self->hide
295 : $self->show;
296}
297
298sub toggle_visibility {
299 my ($self) = @_;
300
301 $self->{visible}
302 ? $self->hide
303 : $self->show;
243} 304}
244 305
245sub hide { 306sub hide {
246 my ($self) = @_; 307 my ($self) = @_;
247 308
… …
249 310
250 $self->{parent}->remove ($self) 311 $self->{parent}->remove ($self)
251 if $self->{parent}; 312 if $self->{parent};
252} 313}
253 314
254sub move { 315sub move_abs {
255 my ($self, $x, $y, $z) = @_; 316 my ($self, $x, $y, $z) = @_;
256 317
257 $self->{x} = int $x; 318 $self->{x} = List::Util::max 0, int $x;
258 $self->{y} = int $y; 319 $self->{y} = List::Util::max 0, int $y;
259 $self->{z} = $z if defined $z; 320 $self->{z} = $z if defined $z;
260 321
261 $self->update; 322 $self->update;
262} 323}
263 324
264sub set_size { 325sub set_size {
265 my ($self, $w, $h) = @_; 326 my ($self, $w, $h) = @_;
266 327
267 $self->{user_w} = $w; 328 $self->{force_w} = $w;
268 $self->{user_h} = $h; 329 $self->{force_h} = $h;
269 330
270 $self->check_size; 331 $self->realloc;
271} 332}
272 333
273sub size_request { 334sub size_request {
274 require Carp; 335 require Carp;
275 Carp::confess "size_request is abstract"; 336 Carp::confess "size_request is abstract";
… …
277 338
278sub configure { 339sub configure {
279 my ($self, $x, $y, $w, $h) = @_; 340 my ($self, $x, $y, $w, $h) = @_;
280 341
281 if ($self->{aspect}) { 342 if ($self->{aspect}) {
343 my ($ow, $oh) = ($w, $h);
344
282 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 345 $w = List::Util::min $w, int $h * $self->{aspect};
283 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 346 $h = List::Util::min $h, int $w / $self->{aspect};
284 347
285 # use alignment to adjust x, y 348 # use alignment to adjust x, y
286 349
287 $x += int +($w - $w2) * 0.5; 350 $x += int 0.5 * ($ow - $w);
288 $y += int +($h - $h2) * 0.5; 351 $y += int 0.5 * ($oh - $h);
289
290 ($w, $h) = ($w2, $h2);
291 } 352 }
292 353
293 if ($self->{x} != $x || $self->{y} != $y) { 354 if ($self->{x} ne $x || $self->{y} ne $y) {
294 $self->{x} = $x; 355 $self->{x} = $x;
295 $self->{y} = $y; 356 $self->{y} = $y;
296 $self->update; 357 $self->update;
297 } 358 }
298 359
299 if ($self->{w} != $w || $self->{h} != $h) { 360 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
300 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h]; 361 return unless $self->{visible};
362
363 $self->{alloc_w} = $w;
364 $self->{alloc_h} = $h;
365
366 $self->{root}{size_alloc}{$self+0} = $self;
301 } 367 }
302} 368}
303 369
304sub size_allocate { 370sub size_allocate {
305 # nothing to be done 371 # nothing to be done
306}
307
308sub reconfigure {
309 my ($self) = @_;
310
311 $self->check_size (1);
312 $self->update;
313} 372}
314 373
315sub children { 374sub children {
316} 375}
317 376
… …
395sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 454sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
396sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 455sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
397sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 456sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
398sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 457sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
399sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 458sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
459
460sub find_widget {
461 my ($self, $x, $y) = @_;
462
463 return () unless $self->{can_events};
464
465 return $self
466 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
467 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
468
469 ()
470}
471
472sub set_parent {
473 my ($self, $parent) = @_;
474
475 Scalar::Util::weaken ($self->{parent} = $parent);
476 $self->set_visible if $parent->{visible};
477}
478
479sub connect {
480 my ($self, $signal, $cb) = @_;
481
482 push @{ $self->{signal_cb}{$signal} }, $cb;
483}
484
485sub _emit {
486 my ($self, $signal, @args) = @_;
487
488 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
489}
490
491sub emit {
492 my ($self, $signal, @args) = @_;
493
494 $self->_emit ($signal, @args)
495 || $self->$signal (@args);
496}
497
498sub visibility_change {
499 #my ($self, $visible) = @_;
500}
501
502sub realloc {
503 my ($self) = @_;
504
505 if ($self->{visible}) {
506 return if $self->{root}{realloc}{$self+0};
507
508 $self->{root}{realloc}{$self+0} = $self;
509 $self->{root}->update;
510 } else {
511 delete $self->{req_w};
512 delete $self->{req_h};
513 }
514}
515
516sub update {
517 my ($self) = @_;
518
519 $self->{parent}->update
520 if $self->{parent};
521}
522
523sub reconfigure {
524 my ($self) = @_;
525
526 $self->realloc;
527 $self->update;
528}
400 529
401sub draw { 530sub draw {
402 my ($self) = @_; 531 my ($self) = @_;
403 532
404 return unless $self->{h} && $self->{w}; 533 return unless $self->{h} && $self->{w};
… …
421 glVertex $x , $y + $self->{h}; 550 glVertex $x , $y + $self->{h};
422 glEnd; 551 glEnd;
423 glDisable GL_BLEND; 552 glDisable GL_BLEND;
424 } 553 }
425 554
426 if ($ENV{PCLIENT_DEBUG}) { 555 if ($ENV{CFPLUS_DEBUG} & 1) {
427 glPushMatrix; 556 glPushMatrix;
428 glColor 1, 1, 0, 1; 557 glColor 1, 1, 0, 1;
429 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 558 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
430 glBegin GL_LINE_LOOP; 559 glBegin GL_LINE_LOOP;
431 glVertex 0 , 0; 560 glVertex 0 , 0;
… …
442 my ($self) = @_; 571 my ($self) = @_;
443 572
444 warn "no draw defined for $self\n"; 573 warn "no draw defined for $self\n";
445} 574}
446 575
447sub find_widget {
448 my ($self, $x, $y) = @_;
449
450 return () unless $self->{can_events};
451
452 return $self
453 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
454 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
455
456 ()
457}
458
459sub set_parent {
460 my ($self, $parent) = @_;
461
462 Scalar::Util::weaken ($self->{parent} = $parent);
463
464 $self->{root} = $parent->{root};
465 $self->{visible} = $parent->{visible};
466
467 # TODO: req_w _does_change after ->reconfigure
468 $self->check_size
469 unless exists $self->{req_w};
470
471 $self->show;
472}
473
474sub check_size {
475 my ($self, $forced) = @_;
476
477 $self->{force_alloc} = 1 if $forced;
478 $CFClient::UI::ROOT->{check_size}{$self} = $self;
479}
480
481sub update {
482 my ($self) = @_;
483
484 $self->{parent}->update
485 if $self->{parent};
486}
487
488sub connect {
489 my ($self, $signal, $cb) = @_;
490
491 push @{ $self->{signal_cb}{$signal} }, $cb;
492}
493
494sub _emit {
495 my ($self, $signal, @args) = @_;
496
497 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
498}
499
500sub emit {
501 my ($self, $signal, @args) = @_;
502
503 $self->_emit ($signal, @args)
504 || $self->$signal (@args);
505}
506
507sub DESTROY { 576sub DESTROY {
508 my ($self) = @_; 577 my ($self) = @_;
509 578
510 delete $WIDGET{$self+0}; 579 delete $WIDGET{$self+0};
511 #$self->deactivate; 580 #$self->deactivate;
… …
567 my ($class, %arg) = @_; 636 my ($class, %arg) = @_;
568 $class->SUPER::new (can_events => 0, %arg); 637 $class->SUPER::new (can_events => 0, %arg);
569} 638}
570 639
571sub size_request { 640sub size_request {
572 (0, 0) 641 my ($self) = @_;
642
643 ($self->{w} + 0, $self->{h} + 0)
573} 644}
574 645
575sub draw { } 646sub draw { }
576 647
577############################################################################# 648#############################################################################
… …
606 $self->{children} = [ 677 $self->{children} = [
607 sort { $a->{z} <=> $b->{z} } 678 sort { $a->{z} <=> $b->{z} }
608 @{$self->{children}}, @widgets 679 @{$self->{children}}, @widgets
609 ]; 680 ];
610 681
611 $self->check_size (1); 682 $self->realloc;
612 $self->update;
613} 683}
614 684
615sub children { 685sub children {
616 @{ $_[0]{children} } 686 @{ $_[0]{children} }
617} 687}
… …
622 delete $child->{parent}; 692 delete $child->{parent};
623 $child->hide; 693 $child->hide;
624 694
625 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 695 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
626 696
627 $self->check_size (1); 697 $self->realloc;
628 $self->update;
629} 698}
630 699
631sub clear { 700sub clear {
632 my ($self) = @_; 701 my ($self) = @_;
633 702
… …
637 for (@$children) { 706 for (@$children) {
638 delete $_->{parent}; 707 delete $_->{parent};
639 $_->hide; 708 $_->hide;
640 } 709 }
641 710
642 $self->check_size; 711 $self->realloc;
643 $self->update;
644} 712}
645 713
646sub find_widget { 714sub find_widget {
647 my ($self, $x, $y) = @_; 715 my ($self, $x, $y) = @_;
648 716
… …
785} 853}
786 854
787sub size_request { 855sub size_request {
788 my ($self) = @_; 856 my ($self) = @_;
789 857
790 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 858 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
791 859
792 @$self{qw(child_w child_h)} 860 $w = 10 if $self->{scroll_x};
861 $h = 10 if $self->{scroll_y};
862
863 ($w, $h)
793} 864}
794 865
795sub size_allocate { 866sub size_allocate {
796 my ($self, $w, $h) = @_; 867 my ($self, $w, $h) = @_;
797 868
869 my $child = $self->child;
870
798 $w = $self->{child_w} if $self->{scroll_x} && $self->{child_w}; 871 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
799 $h = $self->{child_h} if $self->{scroll_y} && $self->{child_h}; 872 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
800 873
801 $self->child->configure (0, 0, $w, $h); 874 $self->child->configure (0, 0, $w, $h);
802 $self->update; 875 $self->update;
803} 876}
804 877
… …
857 my $class = shift; 930 my $class = shift;
858 931
859 my $self; 932 my $self;
860 933
861 my $slider = new CFClient::UI::Slider 934 my $slider = new CFClient::UI::Slider
862 vertical => 1, 935 vertical => 1,
863 range => [0, 0, 1, 0.01], # HACK fix 936 range => [0, 0, 1, 0.01], # HACK fix
864 connect_changed => sub { 937 on_changed => sub {
865 $self->{vp}->set_offset (0, $_[1]); 938 $self->{vp}->set_offset (0, $_[1]);
866 }, 939 },
867 ; 940 ;
868 941
869 $self = $class->SUPER::new ( 942 $self = $class->SUPER::new (
… …
947 1020
948our @ISA = CFClient::UI::Bin::; 1021our @ISA = CFClient::UI::Bin::;
949 1022
950use CFClient::OpenGL; 1023use CFClient::OpenGL;
951 1024
952my @tex = 1025my $bg =
1026 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1027 mipmap => 1, wrap => 1;
1028
1029my @border =
953 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1030 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
954 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);
955 1032
956sub new { 1033sub new {
957 my $class = shift; 1034 my $class = shift;
958
959 # TODO: user_x, user_y, overwrite moveto?
960 1035
961 my $self = $class->SUPER::new ( 1036 my $self = $class->SUPER::new (
962 bg => [1, 1, 1, 1], 1037 bg => [1, 1, 1, 1],
963 border_bg => [1, 1, 1, 1], 1038 border_bg => [1, 1, 1, 1],
964 border => 0.6, 1039 border => 0.6,
965 is_toplevel => 1,
966 can_events => 1, 1040 can_events => 1,
1041 min_w => 16,
1042 min_h => 16,
967 @_ 1043 @_
968 ); 1044 );
969 1045
970 $self->{title} &&= new CFClient::UI::Label 1046 $self->{title} &&= new CFClient::UI::Label
971 align => 0, 1047 align => 0,
… …
1024 my ($ev, $x, $y) = @_; 1100 my ($ev, $x, $y) = @_;
1025 1101
1026 my $dx = $ev->{x} - $ox; 1102 my $dx = $ev->{x} - $ox;
1027 my $dy = $ev->{y} - $oy; 1103 my $dy = $ev->{y} - $oy;
1028 1104
1029 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1105 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1030 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1106 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1107
1108 $self->realloc;
1031 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1109 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1032 $self->check_size;
1033 }; 1110 };
1034 1111
1035 } elsif ($lr ^ $td) { 1112 } elsif ($lr ^ $td) {
1036 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1113 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1037 my ($bx, $by) = ($self->{x}, $self->{y}); 1114 my ($bx, $by) = ($self->{x}, $self->{y});
… …
1039 $self->{motion} = sub { 1116 $self->{motion} = sub {
1040 my ($ev, $x, $y) = @_; 1117 my ($ev, $x, $y) = @_;
1041 1118
1042 ($x, $y) = ($ev->{x}, $ev->{y}); 1119 ($x, $y) = ($ev->{x}, $ev->{y});
1043 1120
1044 $self->move ($bx + $x - $ox, $by + $y - $oy); 1121 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1045 $self->update;
1046 }; 1122 };
1047 } 1123 }
1048} 1124}
1049 1125
1050sub button_up { 1126sub button_up {
… …
1069 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1145 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1070 1146
1071 my $border = $self->border; 1147 my $border = $self->border;
1072 1148
1073 glColor @{ $self->{border_bg} }; 1149 glColor @{ $self->{border_bg} };
1074 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1150 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1075 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1151 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1076 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1152 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1077 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1153 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1078 1154
1079 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1155 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1080 my $bg = $tex[0]; 1156 glColor @{ $self->{bg} };
1081 1157
1082 # TODO: repeat texture not scale 1158 # TODO: repeat texture not scale
1159 # solve this better(?)
1083 my $rep_x = $cw / $bg->{w}; 1160 $bg->{s} = $cw / $bg->{w};
1084 my $rep_y = $ch / $bg->{h}; 1161 $bg->{t} = $ch / $bg->{h};
1085
1086 glColor @{ $self->{bg} };
1087
1088 $bg->{s} = $rep_x;
1089 $bg->{t} = $rep_y;
1090 $bg->{wrap_mode} = 1;
1091 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1162 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1092 } 1163 }
1093 1164
1094 glDisable GL_TEXTURE_2D; 1165 glDisable GL_TEXTURE_2D;
1095 1166
… …
1125 my ($self, $x, $y, $child) = @_; 1196 my ($self, $x, $y, $child) = @_;
1126 1197
1127 $child->set_parent ($self); 1198 $child->set_parent ($self);
1128 $self->{children}[$y][$x] = $child; 1199 $self->{children}[$y][$x] = $child;
1129 1200
1130 $self->check_size (1); 1201 $self->realloc;
1131} 1202}
1132 1203
1133# TODO: move to container class maybe? send children a signal on removal? 1204# TODO: move to container class maybe? send children a signal on removal?
1134sub clear { 1205sub clear {
1135 my ($self) = @_; 1206 my ($self) = @_;
… …
1140 for (@children) { 1211 for (@children) {
1141 delete $_->{parent}; 1212 delete $_->{parent};
1142 $_->hide; 1213 $_->hide;
1143 } 1214 }
1144 1215
1145 $self->check_size (1); 1216 $self->realloc;
1146 $self->update;
1147} 1217}
1148 1218
1149sub get_wh { 1219sub get_wh {
1150 my ($self) = @_; 1220 my ($self) = @_;
1151 1221
… …
1247 } 1317 }
1248} 1318}
1249 1319
1250############################################################################# 1320#############################################################################
1251 1321
1252package CFClient::UI::HBox; 1322package CFClient::UI::Box;
1253
1254# TODO: wrap into common Box base class
1255 1323
1256our @ISA = CFClient::UI::Container::; 1324our @ISA = CFClient::UI::Container::;
1257 1325
1258sub size_request { 1326sub size_request {
1259 my ($self) = @_; 1327 my ($self) = @_;
1260 1328
1261 my @alloc = map [$_->size_request], @{$self->{children}}; 1329 $self->{vertical}
1262 1330 ? (
1263 ( 1331 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1264 (List::Util::sum map $_->[0], @alloc), 1332 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1265 (List::Util::max map $_->[1], @alloc), 1333 )
1266 ) 1334 : (
1335 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1336 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1337 )
1267} 1338}
1268 1339
1269sub size_allocate { 1340sub size_allocate {
1270 my ($self, $w, $h) = @_; 1341 my ($self, $w, $h) = @_;
1271 1342
1272 ($h, $w) = ($w, $h); 1343 my $space = $self->{vertical} ? $h : $w;
1273
1274 my $children = $self->{children}; 1344 my $children = $self->{children};
1275 1345
1276 my @h = map $_->{req_w}, @$children; 1346 my @req;
1277 1347
1278 my $req_h = List::Util::sum @h; 1348 if ($self->{homogeneous}) {
1279 1349 @req = ($space / (@$children || 1)) x @$children;
1280 if ($req_h > $h) {
1281 # ah well, not enough space
1282 $_ *= $h / $req_h for @h;
1283 } else { 1350 } else {
1351 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1352 my $req = List::Util::sum @req;
1353
1354 if ($req > $space) {
1355 # ah well, not enough space
1356 $_ *= $space / $req for @req;
1357 } else {
1284 my $exp = List::Util::sum map $_->{expand}, @$children; 1358 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1285 $exp ||= 1;
1286 1359
1360 $space = ($space - $req) / $expand; # remaining space to give away
1361
1362 $req[$_] += $space * $children->[$_]{expand}
1287 for (0 .. $#$children) { 1363 for 0 .. $#$children;
1288 my $child = $children->[$_];
1289
1290 my $alloc_h = $h[$_];
1291 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1292 $h[$_] = $alloc_h;
1293 } 1364 }
1294 } 1365 }
1295 1366
1296 CFClient::UI::harmonize \@h; 1367 CFClient::UI::harmonize \@req;
1297 1368
1298 my $y = 0; 1369 my $pos = 0;
1299 for (0 .. $#$children) { 1370 for (0 .. $#$children) {
1300 my $child = $children->[$_];
1301 my $h = $h[$_]; 1371 my $alloc = $req[$_];
1302 $child->configure ($y, 0, $h, $w); 1372 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1303 1373
1304 $y += $h; 1374 $pos += $alloc;
1305 } 1375 }
1306 1376
1307 1 1377 1
1308} 1378}
1309 1379
1310############################################################################# 1380#############################################################################
1311 1381
1382package CFClient::UI::HBox;
1383
1384our @ISA = CFClient::UI::Box::;
1385
1386sub new {
1387 my $class = shift;
1388
1389 $class->SUPER::new (
1390 vertical => 0,
1391 @_,
1392 )
1393}
1394
1395#############################################################################
1396
1312package CFClient::UI::VBox; 1397package CFClient::UI::VBox;
1313 1398
1314# TODO: wrap into common Box base class
1315
1316our @ISA = CFClient::UI::Container::; 1399our @ISA = CFClient::UI::Box::;
1317 1400
1318sub size_request { 1401sub new {
1319 my ($self) = @_; 1402 my $class = shift;
1320 1403
1321 my @alloc = map [$_->size_request], @{$self->{children}}; 1404 $class->SUPER::new (
1322 1405 vertical => 1,
1323 ( 1406 @_,
1324 (List::Util::max map $_->[0], @alloc),
1325 (List::Util::sum map $_->[1], @alloc),
1326 ) 1407 )
1327}
1328
1329sub size_allocate {
1330 my ($self, $w, $h) = @_;
1331
1332 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1333
1334 my $children = $self->{children};
1335
1336 my @h = map $_->{req_h}, @$children;
1337
1338 my $req_h = List::Util::sum @h;
1339
1340 if ($req_h > $h) {
1341 # ah well, not enough space
1342 $_ *= $h / $req_h for @h;
1343 } else {
1344 my $exp = List::Util::sum map $_->{expand}, @$children;
1345 $exp ||= 1;
1346
1347 for (0 .. $#$children) {
1348 my $child = $children->[$_];
1349
1350 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1351 }
1352 }
1353
1354 CFClient::UI::harmonize \@h;
1355
1356 my $y = 0;
1357 for (0 .. $#$children) {
1358 my $child = $children->[$_];
1359 my $h = $h[$_];
1360 $child->configure (0, $y, $w, $h);
1361
1362 $y += $h;
1363 }
1364
1365 1
1366} 1408}
1367 1409
1368############################################################################# 1410#############################################################################
1369 1411
1370package CFClient::UI::Label; 1412package CFClient::UI::Label;
… …
1387 ellipsise => 3, # end 1429 ellipsise => 3, # end
1388 layout => (new CFClient::Layout), 1430 layout => (new CFClient::Layout),
1389 fontsize => 1, 1431 fontsize => 1,
1390 align => -1, 1432 align => -1,
1391 valign => -1, 1433 valign => -1,
1392 padding => 2, 1434 padding_x => 2,
1435 padding_y => 2,
1393 can_events => 0, 1436 can_events => 0,
1394 %arg 1437 %arg
1395 ); 1438 );
1396 1439
1397 if (exists $self->{template}) { 1440 if (exists $self->{template}) {
… …
1433 $self->{text} = "T$text"; 1476 $self->{text} = "T$text";
1434 1477
1435 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1478 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1436 $self->{layout}->set_text ($text); 1479 $self->{layout}->set_text ($text);
1437 1480
1481 $self->realloc;
1438 $self->update; 1482 $self->update;
1439 $self->check_size;
1440} 1483}
1441 1484
1442sub set_markup { 1485sub set_markup {
1443 my ($self, $markup) = @_; 1486 my ($self, $markup) = @_;
1444 1487
… …
1448 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1491 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1449 1492
1450 $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;
1451 $self->{layout}->set_markup ($markup); 1494 $self->{layout}->set_markup ($markup);
1452 1495
1496 $self->realloc;
1453 $self->update; 1497 $self->update;
1454 $self->check_size;
1455} 1498}
1456 1499
1457sub size_request { 1500sub size_request {
1458 my ($self) = @_; 1501 my ($self) = @_;
1459 1502
… …
1473 1516
1474 $w = List::Util::max $w, $w2; 1517 $w = List::Util::max $w, $w2;
1475 $h = List::Util::max $h, $h2; 1518 $h = List::Util::max $h, $h2;
1476 } 1519 }
1477 1520
1478 ( 1521 ($w, $h)
1479 $w + $self->{padding} * 2,
1480 $h + $self->{padding} * 2,
1481 )
1482} 1522}
1483 1523
1484sub size_allocate { 1524sub size_allocate {
1485 my ($self, $w, $h) = @_; 1525 my ($self, $w, $h) = @_;
1486 1526
… …
1491 my ($self, $fontsize) = @_; 1531 my ($self, $fontsize) = @_;
1492 1532
1493 $self->{fontsize} = $fontsize; 1533 $self->{fontsize} = $fontsize;
1494 delete $self->{texture}; 1534 delete $self->{texture};
1495 1535
1496 $self->update; 1536 $self->realloc;
1497 $self->check_size;
1498} 1537}
1499 1538
1500sub _draw { 1539sub _draw {
1501 my ($self) = @_; 1540 my ($self) = @_;
1502 1541
… …
1510 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1549 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1511 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1550 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1512 1551
1513 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1552 my $tex = new_from_layout CFClient::Texture $self->{layout};
1514 1553
1515 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1554 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1516 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1555 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1517 : ($self->{w} - $tex->{w}) * 0.5); 1556 : ($self->{w} - $tex->{w}) * 0.5);
1518 1557
1519 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1558 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1520 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1559 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1521 : ($self->{h} - $tex->{h}) * 0.5); 1560 : ($self->{h} - $tex->{h}) * 0.5);
1522 1561
1523 $tex 1562 $tex
1524 }; 1563 };
1525 1564
… …
1582sub set_text { 1621sub set_text {
1583 my ($self, $text) = @_; 1622 my ($self, $text) = @_;
1584 1623
1585 $self->{cursor} = length $text; 1624 $self->{cursor} = length $text;
1586 $self->_set_text ($text); 1625 $self->_set_text ($text);
1587 $self->update; 1626
1588 $self->check_size; 1627 $self->realloc;
1589} 1628}
1590 1629
1591sub get_text { 1630sub get_text {
1592 $_[0]{text} 1631 $_[0]{text}
1593} 1632}
… …
1626 } elsif ($uni) { 1665 } elsif ($uni) {
1627 substr $text, $self->{cursor}++, 0, chr $uni; 1666 substr $text, $self->{cursor}++, 0, chr $uni;
1628 } 1667 }
1629 1668
1630 $self->_set_text ($text); 1669 $self->_set_text ($text);
1631 $self->update; 1670
1632 $self->check_size; 1671 $self->realloc;
1633} 1672}
1634 1673
1635sub focus_in { 1674sub focus_in {
1636 my ($self) = @_; 1675 my ($self) = @_;
1637 1676
… …
1764 1803
1765sub new { 1804sub new {
1766 my $class = shift; 1805 my $class = shift;
1767 1806
1768 $class->SUPER::new ( 1807 $class->SUPER::new (
1769 padding => 4, 1808 padding_x => 4,
1809 padding_y => 4,
1770 fg => [1, 1, 1], 1810 fg => [1, 1, 1],
1771 active_fg => [0, 0, 1], 1811 active_fg => [0, 0, 1],
1772 can_hover => 1, 1812 can_hover => 1,
1773 align => 0, 1813 align => 0,
1774 valign => 0, 1814 valign => 0,
… …
1821 1861
1822sub new { 1862sub new {
1823 my $class = shift; 1863 my $class = shift;
1824 1864
1825 $class->SUPER::new ( 1865 $class->SUPER::new (
1826 padding => 2, 1866 padding_x => 2,
1867 padding_y => 2,
1827 fg => [1, 1, 1], 1868 fg => [1, 1, 1],
1828 active_fg => [1, 1, 0], 1869 active_fg => [1, 1, 0],
1829 bg => [0, 0, 0, 0.2], 1870 bg => [0, 0, 0, 0.2],
1830 active_bg => [1, 1, 1, 0.5], 1871 active_bg => [1, 1, 1, 0.5],
1831 state => 0, 1872 state => 0,
… …
1835} 1876}
1836 1877
1837sub size_request { 1878sub size_request {
1838 my ($self) = @_; 1879 my ($self) = @_;
1839 1880
1840 ($self->{padding} * 2 + 6) x 2 1881 (6) x 2
1841} 1882}
1842 1883
1843sub button_down { 1884sub button_down {
1844 my ($self, $ev, $x, $y) = @_; 1885 my ($self, $ev, $x, $y) = @_;
1845 1886
1846 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1887 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1847 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1888 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1848 $self->{state} = !$self->{state}; 1889 $self->{state} = !$self->{state};
1849 $self->_emit (changed => $self->{state}); 1890 $self->_emit (changed => $self->{state});
1850 } 1891 }
1851} 1892}
1852 1893
1853sub _draw { 1894sub _draw {
1854 my ($self) = @_; 1895 my ($self) = @_;
1855 1896
1856 $self->SUPER::_draw; 1897 $self->SUPER::_draw;
1857 1898
1858 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1899 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1859 1900
1860 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;
1861 1904
1862 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1905 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1863 1906
1864 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1907 my $tex = $self->{state} ? $tex[1] : $tex[0];
1865 1908
… …
2130 fg => [1, 1, 1], 2173 fg => [1, 1, 1],
2131 active_fg => [0, 0, 0], 2174 active_fg => [0, 0, 0],
2132 bg => [0, 0, 0, 0.2], 2175 bg => [0, 0, 0, 0.2],
2133 active_bg => [1, 1, 1, 0.5], 2176 active_bg => [1, 1, 1, 0.5],
2134 range => [0, 0, 100, 10, 0], 2177 range => [0, 0, 100, 10, 0],
2135 req_w => $::WIDTH / 80, 2178 min_w => $::WIDTH / 80,
2136 req_h => $::WIDTH / 80, 2179 min_h => $::WIDTH / 80,
2137 vertical => 0, 2180 vertical => 0,
2138 can_hover => 1, 2181 can_hover => 1,
2139 inner_pad => 0.02, 2182 inner_pad => 0.02,
2140 @_ 2183 @_
2141 ); 2184 );
… …
2144 $self->update; 2187 $self->update;
2145 2188
2146 $self 2189 $self
2147} 2190}
2148 2191
2192sub changed { }
2193
2149sub set_range { 2194sub set_range {
2150 my ($self, $range) = @_; 2195 my ($self, $range) = @_;
2151 2196
2152 ($range, $self->{range}) = ($self->{range}, $range); 2197 ($range, $self->{range}) = ($self->{range}, $range);
2153 2198
… …
2179} 2224}
2180 2225
2181sub size_request { 2226sub size_request {
2182 my ($self) = @_; 2227 my ($self) = @_;
2183 2228
2184 my $w = $self->{req_w}; 2229 ($self->{req_w}, $self->{req_h})
2185 my $h = $self->{req_h};
2186
2187 $self->{vertical} ? ($h, $w) : ($w, $h)
2188} 2230}
2189 2231
2190sub button_down { 2232sub button_down {
2191 my ($self, $ev, $x, $y) = @_; 2233 my ($self, $ev, $x, $y) = @_;
2192 2234
… …
2543 2585
2544sub new { 2586sub new {
2545 my $class = shift; 2587 my $class = shift;
2546 2588
2547 my $self = $class->SUPER::new ( 2589 my $self = $class->SUPER::new (
2548 state => 0, 2590 state => 0,
2549 connect_activate => \&toggle_flopper, 2591 on_activate => \&toggle_flopper,
2550 @_ 2592 @_
2551 ); 2593 );
2552 2594
2553 if ($self->{state}) {
2554 $self->{state} = 0;
2555 $self->toggle_flopper;
2556 }
2557
2558 $self 2595 $self
2559} 2596}
2560 2597
2561sub toggle_flopper { 2598sub toggle_flopper {
2562 my ($self) = @_; 2599 my ($self) = @_;
2563 2600
2564 # TODO: use animation 2601 $self->{other}->toggle_visibility;
2565 if ($self->{state} = !$self->{state}) {
2566 $CFClient::UI::ROOT->add ($self->{other});
2567 $self->{other}->move ($self->coord2global (0, $self->{h}));
2568 $self->_emit ("open");
2569 } else {
2570 $CFClient::UI::ROOT->remove ($self->{other});
2571 $self->_emit ("close");
2572 }
2573
2574 $self->_emit (changed => $self->{state});
2575} 2602}
2576 2603
2577############################################################################# 2604#############################################################################
2578 2605
2579package CFClient::UI::Tooltip; 2606package CFClient::UI::Tooltip;
… …
2592} 2619}
2593 2620
2594sub set_tooltip_from { 2621sub set_tooltip_from {
2595 my ($self, $widget) = @_; 2622 my ($self, $widget) = @_;
2596 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
2597 $self->add (new CFClient::UI::Label 2633 $self->add (new CFClient::UI::Label
2598 markup => $widget->{tooltip}, 2634 markup => $tooltip,
2599 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2635 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2600 fontsize => 0.8, 2636 fontsize => 0.8,
2601 fg => [0, 0, 0, 1], 2637 fg => [0, 0, 0, 1],
2602 ellipsise => 0, 2638 ellipsise => 0,
2603 font => ($widget->{tooltip_font} || $::FONT_PROP), 2639 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2614 2650
2615sub size_allocate { 2651sub size_allocate {
2616 my ($self, $w, $h) = @_; 2652 my ($self, $w, $h) = @_;
2617 2653
2618 $self->SUPER::size_allocate ($w - 4, $h - 4); 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 });
2619} 2673}
2620 2674
2621sub _draw { 2675sub _draw {
2622 my ($self) = @_; 2676 my ($self) = @_;
2623 2677
… …
2640 glVertex $w, $h; 2694 glVertex $w, $h;
2641 glVertex $w, 0; 2695 glVertex $w, 0;
2642 glEnd; 2696 glEnd;
2643 2697
2644 glTranslate 2 - 0.375, 2 - 0.375; 2698 glTranslate 2 - 0.375, 2 - 0.375;
2699
2645 $self->SUPER::_draw; 2700 $self->SUPER::_draw;
2646} 2701}
2647 2702
2648############################################################################# 2703#############################################################################
2649 2704
… …
2765 2820
2766 $row++; 2821 $row++;
2767 } 2822 }
2768} 2823}
2769 2824
2770sub size_request {
2771 my ($self) = @_;
2772 ($self->{req_w}, $self->{req_h});
2773}
2774
2775############################################################################# 2825#############################################################################
2776 2826
2777package CFClient::UI::Menu; 2827package CFClient::UI::Menu;
2778 2828
2779our @ISA = CFClient::UI::FancyFrame::; 2829our @ISA = CFClient::UI::FancyFrame::;
… …
2819 # maybe save $GRAB? must be careful about events... 2869 # maybe save $GRAB? must be careful about events...
2820 $GRAB = $self; 2870 $GRAB = $self;
2821 $self->{button} = $ev->{button}; 2871 $self->{button} = $ev->{button};
2822 2872
2823 $self->show; 2873 $self->show;
2824 $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);
2825} 2875}
2826 2876
2827sub mouse_motion { 2877sub mouse_motion {
2828 my ($self, $ev, $x, $y) = @_; 2878 my ($self, $ev, $x, $y) = @_;
2829 2879
… …
2963use CFClient::OpenGL; 3013use CFClient::OpenGL;
2964 3014
2965sub new { 3015sub new {
2966 my $class = shift; 3016 my $class = shift;
2967 3017
2968 $class->SUPER::new ( 3018 my $self = $class->SUPER::new (
3019 visible => 1,
2969 @_, 3020 @_,
2970 ) 3021 );
2971}
2972 3022
2973sub configure { 3023 Scalar::Util::weaken ($self->{root} = $self);
2974 my ($self, $x, $y, $w, $h) = @_;
2975 3024
2976 $self->{w} = $w; 3025 $self
2977 $self->{h} = $h;
2978}
2979
2980sub check_size {
2981 my ($self) = @_;
2982
2983 $self->size_allocate ($self->{w}, $self->{h})
2984 if $self->{w};
2985} 3026}
2986 3027
2987sub size_request { 3028sub size_request {
2988 my ($self) = @_; 3029 my ($self) = @_;
2989 3030
2990 ($self->{w}, $self->{h}) 3031 ($self->{w}, $self->{h})
3032}
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
2991} 3046}
2992 3047
2993sub size_allocate { 3048sub size_allocate {
2994 my ($self, $w, $h) = @_; 3049 my ($self, $w, $h) = @_;
2995 3050
2996 for my $child ($self->children) { 3051 for my $child ($self->children) {
2997 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)};
2998 3053
2999 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3054 $X = $child->{force_x} if exists $child->{force_x};
3000 if exists $child->{req_x}; 3055 $Y = $child->{force_y} if exists $child->{force_y};
3001 3056
3002 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3057 $X = _to_pixel $X, $W, $self->{w};
3003 if exists $child->{req_y}; 3058 $Y = _to_pixel $Y, $H, $self->{h};
3004
3005 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3006 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3007 3059
3008 $child->configure ($X, $Y, $W, $H); 3060 $child->configure ($X, $Y, $W, $H);
3009 } 3061 }
3010} 3062}
3011 3063
… …
3022} 3074}
3023 3075
3024sub update { 3076sub update {
3025 my ($self) = @_; 3077 my ($self) = @_;
3026 3078
3027 $self->check_size;
3028 $::WANT_REFRESH++; 3079 $::WANT_REFRESH++;
3029} 3080}
3030 3081
3031sub add { 3082sub add {
3032 my ($self, @children) = @_; 3083 my ($self, @children) = @_;
3033 3084
3034 for (my @widgets = @children; my $w = pop @widgets; ) {
3035 push @widgets, $w->children;
3036 $w->{root} = $self;
3037 $w->{visible} = 1;
3038 }
3039
3040 for my $child (@children) {
3041 $child->{is_toplevel} = 1; 3085 $_->{is_toplevel} = 1
3042 3086 for @children;
3043 # integerise window positions
3044 $child->{x} = int $child->{x};
3045 $child->{y} = int $child->{y};
3046 }
3047 3087
3048 $self->SUPER::add (@children); 3088 $self->SUPER::add (@children);
3049} 3089}
3050 3090
3051sub remove { 3091sub remove {
3052 my ($self, @children) = @_; 3092 my ($self, @children) = @_;
3053 3093
3054 $self->SUPER::remove (@children); 3094 $self->SUPER::remove (@children);
3095
3096 delete $self->{is_toplevel}
3097 for @children;
3055 3098
3056 while (@children) { 3099 while (@children) {
3057 my $w = pop @children; 3100 my $w = pop @children;
3058 push @children, $w->children; 3101 push @children, $w->children;
3059 $w->set_invisible; 3102 $w->set_invisible;
… …
3078 while ($self->{refresh_hook}) { 3121 while ($self->{refresh_hook}) {
3079 $_->() 3122 $_->()
3080 for values %{delete $self->{refresh_hook}}; 3123 for values %{delete $self->{refresh_hook}};
3081 } 3124 }
3082 3125
3083 if ($self->{check_size}) { 3126 if ($self->{realloc}) {
3084 my @queue = ([], []); 3127 my @queue;
3085 3128
3086 for (;;) { 3129 while () {
3087 if ($self->{check_size}) { 3130 if ($self->{realloc}) {
3088 # heuristic: check containers last 3131 #TODO use array-of-depth approach
3089 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3132
3090 for values %{delete $self->{check_size}} 3133 use sort 'stable';
3134
3135 @queue = sort { $a->{visible} <=> $b->{visible} }
3136 @queue, values %{delete $self->{realloc}};
3091 } 3137 }
3092 3138
3093 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3139 my $widget = pop @queue || last;
3094 3140
3095 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3141 $widget->{visible} or last; # do not resize invisible widgets
3096 ? @$widget{qw(user_w user_h)} 3142
3097 : $widget->size_request; 3143 my ($w, $h) = $widget->size_request;
3098 3144
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
3099 if (delete $widget->{force_alloc} 3152 || delete $widget->{force_realloc}) {
3100 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3101 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3102
3103 $widget->{req_w} = $w; 3153 $widget->{req_w} = $w;
3104 $widget->{req_h} = $h; 3154 $widget->{req_h} = $h;
3105 3155
3106 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3156 $self->{size_alloc}{$widget+0} = $widget;
3107 3157
3108 $widget->{parent}->check_size
3109 if $widget->{parent}; 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;
3163 }
3110 } 3164 }
3165
3166 delete $self->{realloc}{$widget+0};
3111 } 3167 }
3112 } 3168 }
3113 3169
3114 while ($self->{size_alloc}) { 3170 while (my $size_alloc = delete $self->{size_alloc}) {
3115 for (values %{delete $self->{size_alloc}}) { 3171 my @queue = sort { $b->{visible} <=> $a->{visible} }
3116 my ($widget, $w, $h) = @$_; 3172 values %$size_alloc;
3173
3174 while () {
3175 my $widget = pop @queue || last;
3176
3177 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3117 3178
3118 $w = 0 if $w < 0; 3179 $w = 0 if $w < 0;
3119 $h = 0 if $h < 0; 3180 $h = 0 if $h < 0;
3120 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}) {
3121 $widget->{w} = $w; 3186 $widget->{w} = $w;
3122 $widget->{h} = $h; 3187 $widget->{h} = $h;
3188
3123 $widget->emit (size_allocate => $w, $h); 3189 $widget->emit (size_allocate => $w, $h);
3190 }
3124 } 3191 }
3125 } 3192 }
3126 3193
3127 while ($self->{post_alloc_hook}) { 3194 while ($self->{post_alloc_hook}) {
3128 $_->() 3195 $_->()
3129 for values %{delete $self->{post_alloc_hook}}; 3196 for values %{delete $self->{post_alloc_hook}};
3130 } 3197 }
3198
3131 3199
3132 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3200 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3133 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3201 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3134 glClear GL_COLOR_BUFFER_BIT; 3202 glClear GL_COLOR_BUFFER_BIT;
3135 3203
… …
3142 $self->_draw; 3210 $self->_draw;
3143} 3211}
3144 3212
3145############################################################################# 3213#############################################################################
3146 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
3315# if $commit is true, the binding will be set after the user entered a key combo
3316sub ask_for_bind {
3317 my ($self, $commit) = @_;
3318
3319 CFClient::Binder::open_binding_dialog (sub {
3320 my ($mod, $sym) = @_;
3321 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3322 $self->update_binding_widgets;
3323 $self->commit if $commit;
3324 });
3325}
3326
3327# $mod and $sym are the modifiers and key symbol
3328# $cmds is a array ref of strings (the commands)
3329# $cb is the callback that is executed on OK
3330# $ccb is the callback that is executed on CANCEL and
3331# when the binding was unsuccessful on OK
3332sub set_binding {
3333 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3334
3335 $self->clear_command_list;
3336 $self->{recording} = 0;
3337 $self->{rec_btn}->set_text ("start recording");
3338
3339 $self->{binding} = [$mod, $sym];
3340 $self->{commands} = $cmds;
3341
3342 $self->{binding_change} = $cb;
3343 $self->{binding_cancel} = $ccb;
3344
3345 $self->update_binding_widgets;
3346}
3347
3348# this is a shortcut method that asks for a binding
3349# and then just binds it.
3350sub do_quick_binding {
3351 my ($self, $cmds) = @_;
3352 $self->set_binding (undef, undef, $cmds, sub {
3353 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3354 });
3355 $self->ask_for_bind (1);
3356}
3357
3358sub update_binding_widgets {
3359 my ($self) = @_;
3360 my ($mod, $sym, $cmds) = $self->get_binding;
3361 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3362 $self->set_command_list ($cmds);
3363}
3364
3365sub get_binding {
3366 my ($self) = @_;
3367 return (
3368 $self->{binding}->[0],
3369 $self->{binding}->[1],
3370 [ grep { defined $_ } @{$self->{commands}} ]
3371 );
3372}
3373
3374sub clear_command_list {
3375 my ($self) = @_;
3376 $self->{cmdbox}->clear ();
3377}
3378
3379sub set_command_list {
3380 my ($self, $cmds) = @_;
3381
3382 $self->{cmdbox}->clear ();
3383 $self->{commands} = $cmds;
3384
3385 my $idx = 0;
3386
3387 for (@$cmds) {
3388 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3389
3390 my $i = $idx;
3391 $hb->add (new CFClient::UI::Button
3392 text => "delete",
3393 tooltip => "Deletes the action from the record",
3394 on_activate => sub {
3395 $self->{cmdbox}->remove ($hb);
3396 $cmds->[$i] = undef;
3397 });
3398
3399 $hb->add (new CFClient::UI::Label text => $_);
3400
3401 $idx++
3402 }
3403}
3404
3405
3406#############################################################################
3407
3408package CFClient::UI::SpellList;
3409
3410our @ISA = CFClient::UI::FancyFrame::;
3411
3412sub new {
3413 my $class = shift;
3414
3415 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3416
3417 $self->add (new CFClient::UI::ScrolledWindow
3418 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3419
3420 $self;
3421}
3422
3423# XXX: Do sorting? Argl...
3424sub add_spell {
3425 my ($self, $spell) = @_;
3426 $self->{spells}->{$spell->{name}} = $spell;
3427
3428 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3429 face => $spell->{face},
3430 can_hover => 1,
3431 can_events => 1,
3432 tooltip => $spell->{message});
3433
3434 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3435 text => $spell->{name},
3436 can_hover => 1,
3437 can_events => 1,
3438 tooltip => $spell->{message},
3439 expand => 1);
3440 $self->{spellbox}->add (2, $self->{tbl_idx}++, new CFClient::UI::Button
3441 text => "bind to key",
3442 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3443}
3444
3445sub rebuild_spell_list {
3446 my ($self) = @_;
3447 $self->{tbl_idx} = 0;
3448 $self->add_spell ($_) for values %{$self->{spells}};
3449}
3450
3451sub remove_spell {
3452 my ($self, $spell) = @_;
3453 delete $self->{spells}->{$spell->{name}};
3454 $self->rebuild_spell_list;
3455}
3456
3457#############################################################################
3458
3147package CFClient::UI; 3459package CFClient::UI;
3148 3460
3149$ROOT = new CFClient::UI::Root; 3461$ROOT = new CFClient::UI::Root;
3150$TOOLTIP = new CFClient::UI::Tooltip z => 900; 3462$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3151 3463

Diff Legend

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