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.264 by root, Thu Jun 1 02:58:30 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
1487 delete $self->{texture}; 1527 delete $self->{texture}
1528 ;#d#
1488} 1529}
1489 1530
1490sub set_fontsize { 1531sub set_fontsize {
1491 my ($self, $fontsize) = @_; 1532 my ($self, $fontsize) = @_;
1492 1533
1493 $self->{fontsize} = $fontsize; 1534 $self->{fontsize} = $fontsize;
1494 delete $self->{texture}; 1535 delete $self->{texture};
1495 1536
1496 $self->update; 1537 $self->realloc;
1497 $self->check_size;
1498} 1538}
1499 1539
1500sub _draw { 1540sub _draw {
1501 my ($self) = @_; 1541 my ($self) = @_;
1502 1542
… …
1510 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1550 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1511 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1551 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1512 1552
1513 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1553 my $tex = new_from_layout CFClient::Texture $self->{layout};
1514 1554
1515 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1555 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1516 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1556 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1517 : ($self->{w} - $tex->{w}) * 0.5); 1557 : ($self->{w} - $tex->{w}) * 0.5);
1518 1558
1519 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1559 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1520 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1560 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1521 : ($self->{h} - $tex->{h}) * 0.5); 1561 : ($self->{h} - $tex->{h}) * 0.5);
1522 1562
1523 $tex 1563 $tex
1524 }; 1564 };
1525 1565
… …
1582sub set_text { 1622sub set_text {
1583 my ($self, $text) = @_; 1623 my ($self, $text) = @_;
1584 1624
1585 $self->{cursor} = length $text; 1625 $self->{cursor} = length $text;
1586 $self->_set_text ($text); 1626 $self->_set_text ($text);
1587 $self->update; 1627
1588 $self->check_size; 1628 $self->realloc;
1589} 1629}
1590 1630
1591sub get_text { 1631sub get_text {
1592 $_[0]{text} 1632 $_[0]{text}
1593} 1633}
… …
1626 } elsif ($uni) { 1666 } elsif ($uni) {
1627 substr $text, $self->{cursor}++, 0, chr $uni; 1667 substr $text, $self->{cursor}++, 0, chr $uni;
1628 } 1668 }
1629 1669
1630 $self->_set_text ($text); 1670 $self->_set_text ($text);
1631 $self->update; 1671
1632 $self->check_size; 1672 $self->realloc;
1633} 1673}
1634 1674
1635sub focus_in { 1675sub focus_in {
1636 my ($self) = @_; 1676 my ($self) = @_;
1637 1677
… …
1764 1804
1765sub new { 1805sub new {
1766 my $class = shift; 1806 my $class = shift;
1767 1807
1768 $class->SUPER::new ( 1808 $class->SUPER::new (
1769 padding => 4, 1809 padding_x => 4,
1810 padding_y => 4,
1770 fg => [1, 1, 1], 1811 fg => [1, 1, 1],
1771 active_fg => [0, 0, 1], 1812 active_fg => [0, 0, 1],
1772 can_hover => 1, 1813 can_hover => 1,
1773 align => 0, 1814 align => 0,
1774 valign => 0, 1815 valign => 0,
… …
1821 1862
1822sub new { 1863sub new {
1823 my $class = shift; 1864 my $class = shift;
1824 1865
1825 $class->SUPER::new ( 1866 $class->SUPER::new (
1826 padding => 2, 1867 padding_x => 2,
1868 padding_y => 2,
1827 fg => [1, 1, 1], 1869 fg => [1, 1, 1],
1828 active_fg => [1, 1, 0], 1870 active_fg => [1, 1, 0],
1829 bg => [0, 0, 0, 0.2], 1871 bg => [0, 0, 0, 0.2],
1830 active_bg => [1, 1, 1, 0.5], 1872 active_bg => [1, 1, 1, 0.5],
1831 state => 0, 1873 state => 0,
… …
1835} 1877}
1836 1878
1837sub size_request { 1879sub size_request {
1838 my ($self) = @_; 1880 my ($self) = @_;
1839 1881
1840 ($self->{padding} * 2 + 6) x 2 1882 (6) x 2
1841} 1883}
1842 1884
1843sub button_down { 1885sub button_down {
1844 my ($self, $ev, $x, $y) = @_; 1886 my ($self, $ev, $x, $y) = @_;
1845 1887
1846 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1888 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1847 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1889 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1848 $self->{state} = !$self->{state}; 1890 $self->{state} = !$self->{state};
1849 $self->_emit (changed => $self->{state}); 1891 $self->_emit (changed => $self->{state});
1850 } 1892 }
1851} 1893}
1852 1894
1853sub _draw { 1895sub _draw {
1854 my ($self) = @_; 1896 my ($self) = @_;
1855 1897
1856 $self->SUPER::_draw; 1898 $self->SUPER::_draw;
1857 1899
1858 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1900 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1859 1901
1860 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1902 my ($w, $h) = @$self{qw(w h)};
1903
1904 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1861 1905
1862 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1906 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1863 1907
1864 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1908 my $tex = $self->{state} ? $tex[1] : $tex[0];
1865 1909
… …
2130 fg => [1, 1, 1], 2174 fg => [1, 1, 1],
2131 active_fg => [0, 0, 0], 2175 active_fg => [0, 0, 0],
2132 bg => [0, 0, 0, 0.2], 2176 bg => [0, 0, 0, 0.2],
2133 active_bg => [1, 1, 1, 0.5], 2177 active_bg => [1, 1, 1, 0.5],
2134 range => [0, 0, 100, 10, 0], 2178 range => [0, 0, 100, 10, 0],
2135 req_w => $::WIDTH / 80, 2179 min_w => $::WIDTH / 80,
2136 req_h => $::WIDTH / 80, 2180 min_h => $::WIDTH / 80,
2137 vertical => 0, 2181 vertical => 0,
2138 can_hover => 1, 2182 can_hover => 1,
2139 inner_pad => 0.02, 2183 inner_pad => 0.02,
2140 @_ 2184 @_
2141 ); 2185 );
… …
2144 $self->update; 2188 $self->update;
2145 2189
2146 $self 2190 $self
2147} 2191}
2148 2192
2193sub changed { }
2194
2149sub set_range { 2195sub set_range {
2150 my ($self, $range) = @_; 2196 my ($self, $range) = @_;
2151 2197
2152 ($range, $self->{range}) = ($self->{range}, $range); 2198 ($range, $self->{range}) = ($self->{range}, $range);
2153 2199
… …
2179} 2225}
2180 2226
2181sub size_request { 2227sub size_request {
2182 my ($self) = @_; 2228 my ($self) = @_;
2183 2229
2184 my $w = $self->{req_w}; 2230 ($self->{req_w}, $self->{req_h})
2185 my $h = $self->{req_h};
2186
2187 $self->{vertical} ? ($h, $w) : ($w, $h)
2188} 2231}
2189 2232
2190sub button_down { 2233sub button_down {
2191 my ($self, $ev, $x, $y) = @_; 2234 my ($self, $ev, $x, $y) = @_;
2192 2235
… …
2543 2586
2544sub new { 2587sub new {
2545 my $class = shift; 2588 my $class = shift;
2546 2589
2547 my $self = $class->SUPER::new ( 2590 my $self = $class->SUPER::new (
2548 state => 0, 2591 state => 0,
2549 connect_activate => \&toggle_flopper, 2592 on_activate => \&toggle_flopper,
2550 @_ 2593 @_
2551 ); 2594 );
2552 2595
2553 if ($self->{state}) {
2554 $self->{state} = 0;
2555 $self->toggle_flopper;
2556 }
2557
2558 $self 2596 $self
2559} 2597}
2560 2598
2561sub toggle_flopper { 2599sub toggle_flopper {
2562 my ($self) = @_; 2600 my ($self) = @_;
2563 2601
2564 # TODO: use animation 2602 $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} 2603}
2576 2604
2577############################################################################# 2605#############################################################################
2578 2606
2579package CFClient::UI::Tooltip; 2607package CFClient::UI::Tooltip;
… …
2592} 2620}
2593 2621
2594sub set_tooltip_from { 2622sub set_tooltip_from {
2595 my ($self, $widget) = @_; 2623 my ($self, $widget) = @_;
2596 2624
2625 my $tooltip = $widget->{tooltip};
2626
2627 if ($ENV{CFPLUS_DEBUG} & 2) {
2628 $tooltip .= "\n\n" . (ref $widget) . "\n"
2629 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2630 . "req $widget->{req_w} $widget->{req_h}\n"
2631 . "visible $widget->{visible}";
2632 }
2633
2597 $self->add (new CFClient::UI::Label 2634 $self->add (new CFClient::UI::Label
2598 markup => $widget->{tooltip}, 2635 markup => $tooltip,
2599 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2636 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2600 fontsize => 0.8, 2637 fontsize => 0.8,
2601 fg => [0, 0, 0, 1], 2638 fg => [0, 0, 0, 1],
2602 ellipsise => 0, 2639 ellipsise => 0,
2603 font => ($widget->{tooltip_font} || $::FONT_PROP), 2640 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2614 2651
2615sub size_allocate { 2652sub size_allocate {
2616 my ($self, $w, $h) = @_; 2653 my ($self, $w, $h) = @_;
2617 2654
2618 $self->SUPER::size_allocate ($w - 4, $h - 4); 2655 $self->SUPER::size_allocate ($w - 4, $h - 4);
2656}
2657
2658sub visibility_change {
2659 my ($self, $visible) = @_;
2660
2661 return unless $visible;
2662
2663 $self->{root}->on_post_alloc ("move_$self" => sub {
2664 my $widget = $self->{owner}
2665 or return;
2666
2667 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2668
2669 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2670 if $x + $self->{w} > $::WIDTH;
2671
2672 $self->move_abs ($x, $y);
2673 });
2619} 2674}
2620 2675
2621sub _draw { 2676sub _draw {
2622 my ($self) = @_; 2677 my ($self) = @_;
2623 2678
… …
2640 glVertex $w, $h; 2695 glVertex $w, $h;
2641 glVertex $w, 0; 2696 glVertex $w, 0;
2642 glEnd; 2697 glEnd;
2643 2698
2644 glTranslate 2 - 0.375, 2 - 0.375; 2699 glTranslate 2 - 0.375, 2 - 0.375;
2700
2645 $self->SUPER::_draw; 2701 $self->SUPER::_draw;
2646} 2702}
2647 2703
2648############################################################################# 2704#############################################################################
2649 2705
… …
2765 2821
2766 $row++; 2822 $row++;
2767 } 2823 }
2768} 2824}
2769 2825
2770sub size_request {
2771 my ($self) = @_;
2772 ($self->{req_w}, $self->{req_h});
2773}
2774
2775############################################################################# 2826#############################################################################
2776 2827
2777package CFClient::UI::Menu; 2828package CFClient::UI::Menu;
2778 2829
2779our @ISA = CFClient::UI::FancyFrame::; 2830our @ISA = CFClient::UI::FancyFrame::;
… …
2819 # maybe save $GRAB? must be careful about events... 2870 # maybe save $GRAB? must be careful about events...
2820 $GRAB = $self; 2871 $GRAB = $self;
2821 $self->{button} = $ev->{button}; 2872 $self->{button} = $ev->{button};
2822 2873
2823 $self->show; 2874 $self->show;
2824 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2875 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2825} 2876}
2826 2877
2827sub mouse_motion { 2878sub mouse_motion {
2828 my ($self, $ev, $x, $y) = @_; 2879 my ($self, $ev, $x, $y) = @_;
2829 2880
… …
2963use CFClient::OpenGL; 3014use CFClient::OpenGL;
2964 3015
2965sub new { 3016sub new {
2966 my $class = shift; 3017 my $class = shift;
2967 3018
2968 $class->SUPER::new ( 3019 my $self = $class->SUPER::new (
3020 visible => 1,
2969 @_, 3021 @_,
2970 ) 3022 );
2971}
2972 3023
2973sub configure { 3024 Scalar::Util::weaken ($self->{root} = $self);
2974 my ($self, $x, $y, $w, $h) = @_;
2975 3025
2976 $self->{w} = $w; 3026 $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} 3027}
2986 3028
2987sub size_request { 3029sub size_request {
2988 my ($self) = @_; 3030 my ($self) = @_;
2989 3031
2990 ($self->{w}, $self->{h}) 3032 ($self->{w}, $self->{h})
3033}
3034
3035sub _to_pixel {
3036 my ($coord, $size, $max) = @_;
3037
3038 $coord =
3039 $coord eq "center" ? ($max - $size) * 0.5
3040 : $coord eq "max" ? $max
3041 : $coord;
3042
3043 $coord = 0 if $coord < 0;
3044 $coord = $max - $size if $coord > $max - $size;
3045
3046 int $coord + 0.5
2991} 3047}
2992 3048
2993sub size_allocate { 3049sub size_allocate {
2994 my ($self, $w, $h) = @_; 3050 my ($self, $w, $h) = @_;
2995 3051
2996 for my $child ($self->children) { 3052 for my $child ($self->children) {
2997 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3053 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2998 3054
2999 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3055 $X = $child->{force_x} if exists $child->{force_x};
3000 if exists $child->{req_x}; 3056 $Y = $child->{force_y} if exists $child->{force_y};
3001 3057
3002 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3058 $X = _to_pixel $X, $W, $self->{w};
3003 if exists $child->{req_y}; 3059 $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 3060
3008 $child->configure ($X, $Y, $W, $H); 3061 $child->configure ($X, $Y, $W, $H);
3009 } 3062 }
3010} 3063}
3011 3064
… …
3022} 3075}
3023 3076
3024sub update { 3077sub update {
3025 my ($self) = @_; 3078 my ($self) = @_;
3026 3079
3027 $self->check_size;
3028 $::WANT_REFRESH++; 3080 $::WANT_REFRESH++;
3029} 3081}
3030 3082
3031sub add { 3083sub add {
3032 my ($self, @children) = @_; 3084 my ($self, @children) = @_;
3033 3085
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; 3086 $_->{is_toplevel} = 1
3042 3087 for @children;
3043 # integerise window positions
3044 $child->{x} = int $child->{x};
3045 $child->{y} = int $child->{y};
3046 }
3047 3088
3048 $self->SUPER::add (@children); 3089 $self->SUPER::add (@children);
3049} 3090}
3050 3091
3051sub remove { 3092sub remove {
3052 my ($self, @children) = @_; 3093 my ($self, @children) = @_;
3053 3094
3054 $self->SUPER::remove (@children); 3095 $self->SUPER::remove (@children);
3096
3097 delete $self->{is_toplevel}
3098 for @children;
3055 3099
3056 while (@children) { 3100 while (@children) {
3057 my $w = pop @children; 3101 my $w = pop @children;
3058 push @children, $w->children; 3102 push @children, $w->children;
3059 $w->set_invisible; 3103 $w->set_invisible;
… …
3078 while ($self->{refresh_hook}) { 3122 while ($self->{refresh_hook}) {
3079 $_->() 3123 $_->()
3080 for values %{delete $self->{refresh_hook}}; 3124 for values %{delete $self->{refresh_hook}};
3081 } 3125 }
3082 3126
3083 if ($self->{check_size}) { 3127 if ($self->{realloc}) {
3084 my @queue = ([], []); 3128 my @queue;
3085 3129
3086 for (;;) { 3130 while () {
3087 if ($self->{check_size}) { 3131 if ($self->{realloc}) {
3088 # heuristic: check containers last 3132 #TODO use array-of-depth approach
3089 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3133
3090 for values %{delete $self->{check_size}} 3134 use sort 'stable';
3135
3136 @queue = sort { $a->{visible} <=> $b->{visible} }
3137 @queue, values %{delete $self->{realloc}};
3091 } 3138 }
3092 3139
3093 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3140 my $widget = pop @queue || last;
3094 3141
3095 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3142 $widget->{visible} or last; # do not resize invisible widgets
3096 ? @$widget{qw(user_w user_h)} 3143
3097 : $widget->size_request; 3144 my ($w, $h) = $widget->size_request;
3098 3145
3146 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3147 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3148
3149 $w = $widget->{force_w} if exists $widget->{force_w};
3150 $h = $widget->{force_h} if exists $widget->{force_h};
3151
3152 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3099 if (delete $widget->{force_alloc} 3153 || 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; 3154 $widget->{req_w} = $w;
3104 $widget->{req_h} = $h; 3155 $widget->{req_h} = $h;
3105 3156
3106 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3157 $self->{size_alloc}{$widget+0} = $widget;
3107 3158
3108 $widget->{parent}->check_size
3109 if $widget->{parent}; 3159 if (my $parent = $widget->{parent}) {
3160 $self->{realloc}{$parent+0} = $parent;
3161 #unshift @queue, $parent;
3162 $parent->{force_size_alloc} = 1;
3163 $self->{size_alloc}{$parent+0} = $parent;
3164 }
3110 } 3165 }
3166
3167 delete $self->{realloc}{$widget+0};
3111 } 3168 }
3112 } 3169 }
3113 3170
3114 while ($self->{size_alloc}) { 3171 while (my $size_alloc = delete $self->{size_alloc}) {
3115 for (values %{delete $self->{size_alloc}}) { 3172 my @queue = sort { $b->{visible} <=> $a->{visible} }
3116 my ($widget, $w, $h) = @$_; 3173 values %$size_alloc;
3174
3175 while () {
3176 my $widget = pop @queue || last;
3177
3178 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3117 3179
3118 $w = 0 if $w < 0; 3180 $w = 0 if $w < 0;
3119 $h = 0 if $h < 0; 3181 $h = 0 if $h < 0;
3120 3182
3183 $w = int $w + 0.5;
3184 $h = int $h + 0.5;
3185
3186 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3121 $widget->{w} = $w; 3187 $widget->{w} = $w;
3122 $widget->{h} = $h; 3188 $widget->{h} = $h;
3189
3123 $widget->emit (size_allocate => $w, $h); 3190 $widget->emit (size_allocate => $w, $h);
3191 }
3124 } 3192 }
3125 } 3193 }
3126 3194
3127 while ($self->{post_alloc_hook}) { 3195 while ($self->{post_alloc_hook}) {
3128 $_->() 3196 $_->()
3129 for values %{delete $self->{post_alloc_hook}}; 3197 for values %{delete $self->{post_alloc_hook}};
3130 } 3198 }
3199
3131 3200
3132 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3201 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3133 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3202 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3134 glClear GL_COLOR_BUFFER_BIT; 3203 glClear GL_COLOR_BUFFER_BIT;
3135 3204
… …
3142 $self->_draw; 3211 $self->_draw;
3143} 3212}
3144 3213
3145############################################################################# 3214#############################################################################
3146 3215
3216package CFClient::UI::SpellList;
3217
3218our @ISA = CFClient::UI::FancyFrame::;
3219
3220sub new {
3221 my $class = shift;
3222
3223 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3224
3225 $self->add (new CFClient::UI::ScrolledWindow
3226 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3227
3228 $self;
3229}
3230
3231# XXX: Do sorting? Argl...
3232sub add_spell {
3233 my ($self, $spell) = @_;
3234 $self->{spells}->{$spell->{name}} = $spell;
3235
3236 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3237 face => $spell->{face},
3238 can_hover => 1,
3239 can_events => 1,
3240 tooltip => $spell->{message});
3241
3242 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3243 text => $spell->{name},
3244 can_hover => 1,
3245 can_events => 1,
3246 tooltip => $spell->{message},
3247 expand => 1);
3248
3249 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3250 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3251 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3252 expand => 1);
3253
3254 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3255 text => "bind to key",
3256 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3257}
3258
3259sub rebuild_spell_list {
3260 my ($self) = @_;
3261 $self->{tbl_idx} = 0;
3262 $self->add_spell ($_) for values %{$self->{spells}};
3263}
3264
3265sub remove_spell {
3266 my ($self, $spell) = @_;
3267 delete $self->{spells}->{$spell->{name}};
3268 $self->rebuild_spell_list;
3269}
3270
3271#############################################################################
3272
3273package CFClient::UI::BindEditor;
3274
3275our @ISA = CFClient::UI::FancyFrame::;
3276
3277sub new {
3278 my $class = shift;
3279
3280 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3281
3282 $self->add (my $vb = new CFClient::UI::VBox);
3283
3284
3285 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3286 text => "start recording",
3287 tooltip => "Start/Stops recording of actions."
3288 ."All subsequent actions after the recording started will be captured."
3289 ."The actions are displayed after the record was stopped."
3290 ."To bind the action you have to click on the 'Bind' button",
3291 on_activate => sub {
3292 unless ($self->{recording}) {
3293 $self->start;
3294 } else {
3295 $self->stop;
3296 }
3297 });
3298
3299 $vb->add (new CFClient::UI::Label text => "Actions:");
3300 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3301
3302 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3303 $vb->add (my $hb = new CFClient::UI::HBox);
3304 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3305 $hb->add (new CFClient::UI::Button
3306 text => "bind",
3307 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3308 on_activate => sub {
3309 $self->ask_for_bind;
3310 });
3311
3312 $vb->add (my $hb = new CFClient::UI::HBox);
3313 $hb->add (new CFClient::UI::Button
3314 text => "ok",
3315 expand => 1,
3316 tooltip => "This closes the binding editor and saves the binding",
3317 on_activate => sub {
3318 $self->hide;
3319 $self->commit;
3320 });
3321
3322 $hb->add (new CFClient::UI::Button
3323 text => "cancel",
3324 expand => 1,
3325 tooltip => "This closes the binding editor without saving",
3326 on_activate => sub {
3327 $self->hide;
3328 $self->{binding_cancel}->()
3329 if $self->{binding_cancel};
3330 });
3331
3332 $self->update_binding_widgets;
3333
3334 $self
3335}
3336
3337sub commit {
3338 my ($self) = @_;
3339 my ($mod, $sym, $cmds) = $self->get_binding;
3340 if ($sym != 0 && @$cmds > 0) {
3341 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3342 ."'. Don't forget 'Save Config'!");
3343 $self->{binding_change}->($mod, $sym, $cmds)
3344 if $self->{binding_change};
3345 } else {
3346 $::STATUSBOX->add ("No action bound, no key or action specified!");
3347 $self->{binding_cancel}->()
3348 if $self->{binding_cancel};
3349 }
3350}
3351
3352sub start {
3353 my ($self) = @_;
3354
3355 $self->{rec_btn}->set_text ("stop recording");
3356 $self->{recording} = 1;
3357 $self->clear_command_list;
3358 $::CONN->start_record if $::CONN;
3359}
3360
3361sub stop {
3362 my ($self) = @_;
3363
3364 $self->{rec_btn}->set_text ("start recording");
3365 $self->{recording} = 0;
3366
3367 my $rec;
3368 $rec = $::CONN->stop_record if $::CONN;
3369 return unless ref $rec eq 'ARRAY';
3370 $self->set_command_list ($rec);
3371}
3372
3373# if $commit is true, the binding will be set after the user entered a key combo
3374sub ask_for_bind {
3375 my ($self, $commit) = @_;
3376
3377 CFClient::Binder::open_binding_dialog (sub {
3378 my ($mod, $sym) = @_;
3379 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3380 $self->update_binding_widgets;
3381 $self->commit if $commit;
3382 });
3383}
3384
3385# $mod and $sym are the modifiers and key symbol
3386# $cmds is a array ref of strings (the commands)
3387# $cb is the callback that is executed on OK
3388# $ccb is the callback that is executed on CANCEL and
3389# when the binding was unsuccessful on OK
3390sub set_binding {
3391 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3392
3393 $self->clear_command_list;
3394 $self->{recording} = 0;
3395 $self->{rec_btn}->set_text ("start recording");
3396
3397 $self->{binding} = [$mod, $sym];
3398 $self->{commands} = $cmds;
3399
3400 $self->{binding_change} = $cb;
3401 $self->{binding_cancel} = $ccb;
3402
3403 $self->update_binding_widgets;
3404}
3405
3406# this is a shortcut method that asks for a binding
3407# and then just binds it.
3408sub do_quick_binding {
3409 my ($self, $cmds) = @_;
3410 $self->set_binding (undef, undef, $cmds, sub {
3411 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3412 });
3413 $self->ask_for_bind (1);
3414}
3415
3416sub update_binding_widgets {
3417 my ($self) = @_;
3418 my ($mod, $sym, $cmds) = $self->get_binding;
3419 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3420 $self->set_command_list ($cmds);
3421}
3422
3423sub get_binding {
3424 my ($self) = @_;
3425 return (
3426 $self->{binding}->[0],
3427 $self->{binding}->[1],
3428 [ grep { defined $_ } @{$self->{commands}} ]
3429 );
3430}
3431
3432sub clear_command_list {
3433 my ($self) = @_;
3434 $self->{cmdbox}->clear ();
3435}
3436
3437sub set_command_list {
3438 my ($self, $cmds) = @_;
3439
3440 $self->{cmdbox}->clear ();
3441 $self->{commands} = $cmds;
3442
3443 my $idx = 0;
3444
3445 for (@$cmds) {
3446 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3447
3448 my $i = $idx;
3449 $hb->add (new CFClient::UI::Label text => $_);
3450 $hb->add (new CFClient::UI::Button
3451 text => "delete",
3452 tooltip => "Deletes the action from the record",
3453 on_activate => sub {
3454 $self->{cmdbox}->remove ($hb);
3455 $cmds->[$i] = undef;
3456 });
3457
3458
3459 $idx++
3460 }
3461}
3462
3463#############################################################################
3464
3147package CFClient::UI; 3465package CFClient::UI;
3148 3466
3149$ROOT = new CFClient::UI::Root; 3467$ROOT = new CFClient::UI::Root;
3150$TOOLTIP = new CFClient::UI::Tooltip z => 900; 3468$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3151 3469

Diff Legend

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