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.242 by elmex, Sat May 27 20:00:40 2006 UTC vs.
Revision 1.266 by root, Thu Jun 1 03:42:58 2006 UTC

… …
17our $BUTTON_STATE; 17our $BUTTON_STATE;
18 18
19our %WIDGET; # all widgets, weak-referenced 19our %WIDGET; # all widgets, weak-referenced
20 20
21sub get_layout { 21sub get_layout {
22 my $layout;
23
22 for (grep { $_->{name} } values %WIDGET) { 24 for (grep { $_->{name} } values %WIDGET) {
23 $LAYOUT->{$_->{name}} = { 25 my $win = $layout->{$_->{name}} = { };
24 x => $_->{x} / $::WIDTH,
25 y => $_->{y} / $::HEIGHT,
26 w => $_->{w} / $::WIDTH,
27 h => $_->{h} / $::HEIGHT
28 }; 26
29 } 27 $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
28 $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
29 $win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
30 $win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
30 31
31 return $LAYOUT; 32 $win->{show} = $_->{visible} && $_->{is_toplevel};
33 }
34
35 $layout
32} 36}
33 37
34sub set_layout { 38sub set_layout {
35 my ($layout) = @_; 39 my ($layout) = @_;
40
36 $LAYOUT = $layout; 41 $LAYOUT = $layout;
37} 42}
38 43
39sub check_tooltip { 44sub check_tooltip {
45 return if $ENV{CFPLUS_DEBUG} & 8;
46
40 if (!$GRAB) { 47 if (!$GRAB) {
41 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 48 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
42 if (length $widget->{tooltip}) { 49 if (length $widget->{tooltip}) {
43
44 if ($TOOLTIP->{owner} != $widget) { 50 if ($TOOLTIP->{owner} != $widget) {
51 $TOOLTIP->hide;
52
45 $TOOLTIP->{owner} = $widget; 53 $TOOLTIP->{owner} = $widget;
46 54
47 my $tip = $widget->{tooltip}; 55 my $tip = $widget->{tooltip};
48 56
49 $tip = $tip->($widget) if CODE:: eq ref $tip; 57 $tip = $tip->($widget) if CODE:: eq ref $tip;
50 58
51 $TOOLTIP->set_tooltip_from ($widget); 59 $TOOLTIP->set_tooltip_from ($widget);
52 $TOOLTIP->show; 60 $TOOLTIP->show;
53
54 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
55
56 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
57 if $x + $TOOLTIP->{w} > $::WIDTH;
58
59 $TOOLTIP->move ($x, $y);
60 $TOOLTIP->check_size;
61 $TOOLTIP->update;
62 } 61 }
63 62
64 return; 63 return;
65 } 64 }
66 } 65 }
… …
172sub rescale_widgets { 171sub rescale_widgets {
173 my ($sx, $sy) = @_; 172 my ($sx, $sy) = @_;
174 173
175 for my $widget (values %WIDGET) { 174 for my $widget (values %WIDGET) {
176 if ($widget->{is_toplevel}) { 175 if ($widget->{is_toplevel}) {
176 $widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
177 $widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
178
177 $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x}; 179 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
178 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 180 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
179 $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w}; 181 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
180 $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
181 $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y}; 182 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
182 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 183 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
183 $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h}; 184 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
184 $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h}; 185
186 $widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
187 $widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
188
185 } 189 }
186 } 190 }
187 191
188 reconfigure_widgets; 192 reconfigure_widgets;
189} 193}
… …
198 202
199sub new { 203sub new {
200 my $class = shift; 204 my $class = shift;
201 205
202 my $self = bless { 206 my $self = bless {
203 x => 0, 207 x => "center",
204 y => 0, 208 y => "center",
205 z => 0, 209 z => 0,
210 w => undef,
211 h => undef,
206 can_events => 1, 212 can_events => 1,
207 @_ 213 @_
208 }, $class; 214 }, $class;
209 215
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
210 for (keys %$self) { 218 for (keys %$self) {
211 if (/^connect_(.*)$/) { 219 if (/^on_(.*)$/) {
212 $self->connect ($1 => delete $self->{$_}); 220 $self->connect ($1 => delete $self->{$_});
213 } 221 }
214 } 222 }
215 223
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
218 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) { 224 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
219 $self->{user_x} = $layout->{x} * $::WIDTH; 225 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
220 $self->{user_y} = $layout->{y} * $::HEIGHT; 226 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
221 $self->{user_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH; 227 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
222 $self->{user_h} = ($layout->{h} != 0 ? $layout->{h} : 1) * $::HEIGHT; 228 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
229
230 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
231 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
232
233 $self->show if $layout->{show};
223 } 234 }
224 235
225 $self 236 $self
226} 237}
227 238
… …
232 %$self = (); 243 %$self = ();
233} 244}
234 245
235sub show { 246sub show {
236 my ($self) = @_; 247 my ($self) = @_;
248
237 return if $self->{parent}; 249 return if $self->{parent};
238 250
239 $CFClient::UI::ROOT->add ($self); 251 $CFClient::UI::ROOT->add ($self);
240} 252}
241 253
242sub show_centered { 254sub set_visible {
243 my ($self) = @_; 255 my ($self) = @_;
256
244 return if $self->{parent}; 257 return if $self->{visible};
245 258
246 $self->show; 259 $self->{root} = $self->{parent}{root};
260 $self->{visible} = $self->{parent}{visible} + 1;
247 261
248 $CFClient::UI::ROOT->on_post_alloc ( 262 $self->emit (visibility_change => 1);
249 "centered $self" => sub { 263
250 $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5); 264 $self->realloc if !exists $self->{req_w};
251 }, 265
252 ); 266 $_->set_visible for $self->children;
253} 267}
254 268
255sub set_invisible { 269sub set_invisible {
256 my ($self) = @_; 270 my ($self) = @_;
257 271
258 # broken show/hide model 272 return unless $self->{visible};
273
274 $_->set_invisible for $self->children;
259 275
260 delete $self->{root}; 276 delete $self->{root};
261 delete $self->{visible}; 277 delete $self->{visible};
262 278
263 undef $GRAB if $GRAB == $self; 279 undef $GRAB if $GRAB == $self;
264 undef $HOVER if $HOVER == $self; 280 undef $HOVER if $HOVER == $self;
265 281
266 CFClient::UI::check_tooltip 282 CFClient::UI::check_tooltip
267 if $CFClient::UI::TOOLTIP->{owner} == $self; 283 if $TOOLTIP->{owner} == $self;
268 284
269 $self->focus_out; 285 $self->focus_out;
286
287 $self->emit (visibility_change => 0);
288}
289
290sub set_visibility {
291 my ($self, $visible) = @_;
292
293 return if $self->{visible} == $visible;
294
295 $visible ? $self->hide
296 : $self->show;
297}
298
299sub toggle_visibility {
300 my ($self) = @_;
301
302 $self->{visible}
303 ? $self->hide
304 : $self->show;
270} 305}
271 306
272sub hide { 307sub hide {
273 my ($self) = @_; 308 my ($self) = @_;
274 309
… …
276 311
277 $self->{parent}->remove ($self) 312 $self->{parent}->remove ($self)
278 if $self->{parent}; 313 if $self->{parent};
279} 314}
280 315
281sub move { 316sub move_abs {
282 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
283 318
284 $self->{x} = int $x; 319 $self->{x} = List::Util::max 0, int $x;
285 $self->{y} = int $y; 320 $self->{y} = List::Util::max 0, int $y;
286 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
287 322
288 $self->update; 323 $self->update;
289} 324}
290 325
291sub set_size { 326sub set_size {
292 my ($self, $w, $h) = @_; 327 my ($self, $w, $h) = @_;
293 328
294 $self->{user_w} = $w; 329 $self->{force_w} = $w;
295 $self->{user_h} = $h; 330 $self->{force_h} = $h;
296 331
297 $self->check_size; 332 $self->realloc;
298} 333}
299 334
300sub size_request { 335sub size_request {
301 require Carp; 336 require Carp;
302 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
… …
304 339
305sub configure { 340sub configure {
306 my ($self, $x, $y, $w, $h) = @_; 341 my ($self, $x, $y, $w, $h) = @_;
307 342
308 if ($self->{aspect}) { 343 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h);
345
309 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 346 $w = List::Util::min $w, int $h * $self->{aspect};
310 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 347 $h = List::Util::min $h, int $w / $self->{aspect};
311 348
312 # use alignment to adjust x, y 349 # use alignment to adjust x, y
313 350
314 $x += int +($w - $w2) * 0.5; 351 $x += int 0.5 * ($ow - $w);
315 $y += int +($h - $h2) * 0.5; 352 $y += int 0.5 * ($oh - $h);
316
317 ($w, $h) = ($w2, $h2);
318 } 353 }
319 354
320 if ($self->{x} != $x || $self->{y} != $y) { 355 if ($self->{x} ne $x || $self->{y} ne $y) {
321 $self->{x} = $x; 356 $self->{x} = $x;
322 $self->{y} = $y; 357 $self->{y} = $y;
323 $self->update; 358 $self->update;
324 } 359 }
325 360
326 if ($self->{w} != $w || $self->{h} != $h) { 361 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
327 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h]; 362 return unless $self->{visible};
363
364 $self->{alloc_w} = $w;
365 $self->{alloc_h} = $h;
366
367 $self->{root}{size_alloc}{$self+0} = $self;
328 } 368 }
329} 369}
330 370
331sub size_allocate { 371sub size_allocate {
332 # nothing to be done 372 # nothing to be done
333}
334
335sub reconfigure {
336 my ($self) = @_;
337
338 $self->check_size (1);
339 $self->update;
340} 373}
341 374
342sub children { 375sub children {
343} 376}
344 377
… …
422sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 455sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
423sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 456sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
424sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 457sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
425sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 458sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
426sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 459sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
460
461sub find_widget {
462 my ($self, $x, $y) = @_;
463
464 return () unless $self->{can_events};
465
466 return $self
467 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
468 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
469
470 ()
471}
472
473sub set_parent {
474 my ($self, $parent) = @_;
475
476 Scalar::Util::weaken ($self->{parent} = $parent);
477 $self->set_visible if $parent->{visible};
478}
479
480sub connect {
481 my ($self, $signal, $cb) = @_;
482
483 push @{ $self->{signal_cb}{$signal} }, $cb;
484}
485
486sub _emit {
487 my ($self, $signal, @args) = @_;
488
489 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
490}
491
492sub emit {
493 my ($self, $signal, @args) = @_;
494
495 $self->_emit ($signal, @args)
496 || $self->$signal (@args);
497}
498
499sub visibility_change {
500 #my ($self, $visible) = @_;
501}
502
503sub realloc {
504 my ($self) = @_;
505
506 if ($self->{visible}) {
507 return if $self->{root}{realloc}{$self+0};
508
509 $self->{root}{realloc}{$self+0} = $self;
510 $self->{root}->update;
511 } else {
512 delete $self->{req_w};
513 delete $self->{req_h};
514 }
515}
516
517sub update {
518 my ($self) = @_;
519
520 $self->{parent}->update
521 if $self->{parent};
522}
523
524sub reconfigure {
525 my ($self) = @_;
526
527 $self->realloc;
528 $self->update;
529}
427 530
428sub draw { 531sub draw {
429 my ($self) = @_; 532 my ($self) = @_;
430 533
431 return unless $self->{h} && $self->{w}; 534 return unless $self->{h} && $self->{w};
… …
448 glVertex $x , $y + $self->{h}; 551 glVertex $x , $y + $self->{h};
449 glEnd; 552 glEnd;
450 glDisable GL_BLEND; 553 glDisable GL_BLEND;
451 } 554 }
452 555
453 if ($ENV{PCLIENT_DEBUG}) { 556 if ($ENV{CFPLUS_DEBUG} & 1) {
454 glPushMatrix; 557 glPushMatrix;
455 glColor 1, 1, 0, 1; 558 glColor 1, 1, 0, 1;
456 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 559 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
457 glBegin GL_LINE_LOOP; 560 glBegin GL_LINE_LOOP;
458 glVertex 0 , 0; 561 glVertex 0 , 0;
… …
469 my ($self) = @_; 572 my ($self) = @_;
470 573
471 warn "no draw defined for $self\n"; 574 warn "no draw defined for $self\n";
472} 575}
473 576
474sub find_widget {
475 my ($self, $x, $y) = @_;
476
477 return () unless $self->{can_events};
478
479 return $self
480 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
481 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
482
483 ()
484}
485
486sub set_parent {
487 my ($self, $parent) = @_;
488
489 Scalar::Util::weaken ($self->{parent} = $parent);
490
491 $self->{root} = $parent->{root};
492 $self->{visible} = $parent->{visible} + 1;
493
494 # TODO: req_w _does_change after ->reconfigure
495 $self->check_size
496 unless exists $self->{req_w};
497
498 $self->show;
499}
500
501sub check_size {
502 my ($self, $forced) = @_;
503
504 $self->{force_alloc} = 1 if $forced;
505 $CFClient::UI::ROOT->{check_size}{$self} = $self;
506}
507
508sub update {
509 my ($self) = @_;
510
511 $self->{parent}->update
512 if $self->{parent};
513}
514
515sub connect {
516 my ($self, $signal, $cb) = @_;
517
518 push @{ $self->{signal_cb}{$signal} }, $cb;
519}
520
521sub _emit {
522 my ($self, $signal, @args) = @_;
523
524 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
525}
526
527sub emit {
528 my ($self, $signal, @args) = @_;
529
530 $self->_emit ($signal, @args)
531 || $self->$signal (@args);
532}
533
534sub DESTROY { 577sub DESTROY {
535 my ($self) = @_; 578 my ($self) = @_;
536 579
537 delete $WIDGET{$self+0}; 580 delete $WIDGET{$self+0};
538 #$self->deactivate; 581 #$self->deactivate;
… …
594 my ($class, %arg) = @_; 637 my ($class, %arg) = @_;
595 $class->SUPER::new (can_events => 0, %arg); 638 $class->SUPER::new (can_events => 0, %arg);
596} 639}
597 640
598sub size_request { 641sub size_request {
599 (0, 0) 642 my ($self) = @_;
643
644 ($self->{w} + 0, $self->{h} + 0)
600} 645}
601 646
602sub draw { } 647sub draw { }
603 648
604############################################################################# 649#############################################################################
… …
633 $self->{children} = [ 678 $self->{children} = [
634 sort { $a->{z} <=> $b->{z} } 679 sort { $a->{z} <=> $b->{z} }
635 @{$self->{children}}, @widgets 680 @{$self->{children}}, @widgets
636 ]; 681 ];
637 682
638 $self->check_size (1); 683 $self->realloc;
639 $self->update;
640} 684}
641 685
642sub children { 686sub children {
643 @{ $_[0]{children} } 687 @{ $_[0]{children} }
644} 688}
… …
649 delete $child->{parent}; 693 delete $child->{parent};
650 $child->hide; 694 $child->hide;
651 695
652 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 696 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
653 697
654 $self->check_size (1); 698 $self->realloc;
655 $self->update;
656} 699}
657 700
658sub clear { 701sub clear {
659 my ($self) = @_; 702 my ($self) = @_;
660 703
… …
664 for (@$children) { 707 for (@$children) {
665 delete $_->{parent}; 708 delete $_->{parent};
666 $_->hide; 709 $_->hide;
667 } 710 }
668 711
669 $self->check_size; 712 $self->realloc;
670 $self->update;
671} 713}
672 714
673sub find_widget { 715sub find_widget {
674 my ($self, $x, $y) = @_; 716 my ($self, $x, $y) = @_;
675 717
… …
812} 854}
813 855
814sub size_request { 856sub size_request {
815 my ($self) = @_; 857 my ($self) = @_;
816 858
817 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 859 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
818 860
819 @$self{qw(child_w child_h)} 861 $w = 10 if $self->{scroll_x};
862 $h = 10 if $self->{scroll_y};
863
864 ($w, $h)
820} 865}
821 866
822sub size_allocate { 867sub size_allocate {
823 my ($self, $w, $h) = @_; 868 my ($self, $w, $h) = @_;
824 869
870 my $child = $self->child;
871
825 $w = $self->{child_w} if $self->{scroll_x} && $self->{child_w}; 872 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
826 $h = $self->{child_h} if $self->{scroll_y} && $self->{child_h}; 873 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
827 874
828 $self->child->configure (0, 0, $w, $h); 875 $self->child->configure (0, 0, $w, $h);
829 $self->update; 876 $self->update;
830} 877}
831 878
… …
884 my $class = shift; 931 my $class = shift;
885 932
886 my $self; 933 my $self;
887 934
888 my $slider = new CFClient::UI::Slider 935 my $slider = new CFClient::UI::Slider
889 vertical => 1, 936 vertical => 1,
890 range => [0, 0, 1, 0.01], # HACK fix 937 range => [0, 0, 1, 0.01], # HACK fix
891 connect_changed => sub { 938 on_changed => sub {
892 $self->{vp}->set_offset (0, $_[1]); 939 $self->{vp}->set_offset (0, $_[1]);
893 }, 940 },
894 ; 941 ;
895 942
896 $self = $class->SUPER::new ( 943 $self = $class->SUPER::new (
… …
974 1021
975our @ISA = CFClient::UI::Bin::; 1022our @ISA = CFClient::UI::Bin::;
976 1023
977use CFClient::OpenGL; 1024use CFClient::OpenGL;
978 1025
979my @tex = 1026my $bg =
1027 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1028 mipmap => 1, wrap => 1;
1029
1030my @border =
980 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1031 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
981 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1032 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
982 1033
983sub new { 1034sub new {
984 my $class = shift; 1035 my $class = shift;
985
986 # TODO: user_x, user_y, overwrite moveto?
987 1036
988 my $self = $class->SUPER::new ( 1037 my $self = $class->SUPER::new (
989 bg => [1, 1, 1, 1], 1038 bg => [1, 1, 1, 1],
990 border_bg => [1, 1, 1, 1], 1039 border_bg => [1, 1, 1, 1],
991 border => 0.6, 1040 border => 0.6,
992 is_toplevel => 1,
993 can_events => 1, 1041 can_events => 1,
1042 min_w => 16,
1043 min_h => 16,
994 @_ 1044 @_
995 ); 1045 );
996 1046
997 $self->{title} &&= new CFClient::UI::Label 1047 $self->{title} &&= new CFClient::UI::Label
998 align => 0, 1048 align => 0,
… …
1051 my ($ev, $x, $y) = @_; 1101 my ($ev, $x, $y) = @_;
1052 1102
1053 my $dx = $ev->{x} - $ox; 1103 my $dx = $ev->{x} - $ox;
1054 my $dy = $ev->{y} - $oy; 1104 my $dy = $ev->{y} - $oy;
1055 1105
1056 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1106 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1057 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1107 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1108
1109 $self->realloc;
1058 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1110 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1059 $self->check_size;
1060 }; 1111 };
1061 1112
1062 } elsif ($lr ^ $td) { 1113 } elsif ($lr ^ $td) {
1063 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1114 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1064 my ($bx, $by) = ($self->{x}, $self->{y}); 1115 my ($bx, $by) = ($self->{x}, $self->{y});
… …
1066 $self->{motion} = sub { 1117 $self->{motion} = sub {
1067 my ($ev, $x, $y) = @_; 1118 my ($ev, $x, $y) = @_;
1068 1119
1069 ($x, $y) = ($ev->{x}, $ev->{y}); 1120 ($x, $y) = ($ev->{x}, $ev->{y});
1070 1121
1071 $self->move ($bx + $x - $ox, $by + $y - $oy); 1122 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1072 $self->update;
1073 }; 1123 };
1074 } 1124 }
1075} 1125}
1076 1126
1077sub button_up { 1127sub button_up {
… …
1096 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1146 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1097 1147
1098 my $border = $self->border; 1148 my $border = $self->border;
1099 1149
1100 glColor @{ $self->{border_bg} }; 1150 glColor @{ $self->{border_bg} };
1101 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1151 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1102 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1152 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1103 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1153 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1104 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1154 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1105 1155
1106 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1156 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1107 my $bg = $tex[0]; 1157 glColor @{ $self->{bg} };
1108 1158
1109 # TODO: repeat texture not scale 1159 # TODO: repeat texture not scale
1160 # solve this better(?)
1110 my $rep_x = $cw / $bg->{w}; 1161 $bg->{s} = $cw / $bg->{w};
1111 my $rep_y = $ch / $bg->{h}; 1162 $bg->{t} = $ch / $bg->{h};
1112
1113 glColor @{ $self->{bg} };
1114
1115 $bg->{s} = $rep_x;
1116 $bg->{t} = $rep_y;
1117 $bg->{wrap_mode} = 1;
1118 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1163 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1119 } 1164 }
1120 1165
1121 glDisable GL_TEXTURE_2D; 1166 glDisable GL_TEXTURE_2D;
1122 1167
… …
1152 my ($self, $x, $y, $child) = @_; 1197 my ($self, $x, $y, $child) = @_;
1153 1198
1154 $child->set_parent ($self); 1199 $child->set_parent ($self);
1155 $self->{children}[$y][$x] = $child; 1200 $self->{children}[$y][$x] = $child;
1156 1201
1157 $self->check_size (1); 1202 $self->realloc;
1158} 1203}
1159 1204
1160# TODO: move to container class maybe? send children a signal on removal? 1205# TODO: move to container class maybe? send children a signal on removal?
1161sub clear { 1206sub clear {
1162 my ($self) = @_; 1207 my ($self) = @_;
… …
1167 for (@children) { 1212 for (@children) {
1168 delete $_->{parent}; 1213 delete $_->{parent};
1169 $_->hide; 1214 $_->hide;
1170 } 1215 }
1171 1216
1172 $self->check_size (1); 1217 $self->realloc;
1173 $self->update;
1174} 1218}
1175 1219
1176sub get_wh { 1220sub get_wh {
1177 my ($self) = @_; 1221 my ($self) = @_;
1178 1222
… …
1274 } 1318 }
1275} 1319}
1276 1320
1277############################################################################# 1321#############################################################################
1278 1322
1279package CFClient::UI::HBox; 1323package CFClient::UI::Box;
1280
1281# TODO: wrap into common Box base class
1282 1324
1283our @ISA = CFClient::UI::Container::; 1325our @ISA = CFClient::UI::Container::;
1284 1326
1285sub size_request { 1327sub size_request {
1286 my ($self) = @_; 1328 my ($self) = @_;
1287 1329
1288 my @alloc = map [$_->size_request], @{$self->{children}}; 1330 $self->{vertical}
1289 1331 ? (
1290 ( 1332 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1291 (List::Util::sum map $_->[0], @alloc), 1333 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1292 (List::Util::max map $_->[1], @alloc), 1334 )
1293 ) 1335 : (
1336 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1337 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1338 )
1294} 1339}
1295 1340
1296sub size_allocate { 1341sub size_allocate {
1297 my ($self, $w, $h) = @_; 1342 my ($self, $w, $h) = @_;
1298 1343
1299 ($h, $w) = ($w, $h); 1344 my $space = $self->{vertical} ? $h : $w;
1300
1301 my $children = $self->{children}; 1345 my $children = $self->{children};
1302 1346
1303 my @h = map $_->{req_w}, @$children; 1347 my @req;
1304 1348
1305 my $req_h = List::Util::sum @h; 1349 if ($self->{homogeneous}) {
1306 1350 @req = ($space / (@$children || 1)) x @$children;
1307 if ($req_h > $h) {
1308 # ah well, not enough space
1309 $_ *= $h / $req_h for @h;
1310 } else { 1351 } else {
1352 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1353 my $req = List::Util::sum @req;
1354
1355 if ($req > $space) {
1356 # ah well, not enough space
1357 $_ *= $space / $req for @req;
1358 } else {
1311 my $exp = List::Util::sum map $_->{expand}, @$children; 1359 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1312 $exp ||= 1;
1313 1360
1361 $space = ($space - $req) / $expand; # remaining space to give away
1362
1363 $req[$_] += $space * $children->[$_]{expand}
1314 for (0 .. $#$children) { 1364 for 0 .. $#$children;
1315 my $child = $children->[$_];
1316
1317 my $alloc_h = $h[$_];
1318 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1319 $h[$_] = $alloc_h;
1320 } 1365 }
1321 } 1366 }
1322 1367
1323 CFClient::UI::harmonize \@h; 1368 CFClient::UI::harmonize \@req;
1324 1369
1325 my $y = 0; 1370 my $pos = 0;
1326 for (0 .. $#$children) { 1371 for (0 .. $#$children) {
1327 my $child = $children->[$_];
1328 my $h = $h[$_]; 1372 my $alloc = $req[$_];
1329 $child->configure ($y, 0, $h, $w); 1373 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1330 1374
1331 $y += $h; 1375 $pos += $alloc;
1332 } 1376 }
1333 1377
1334 1 1378 1
1335} 1379}
1336 1380
1337############################################################################# 1381#############################################################################
1338 1382
1383package CFClient::UI::HBox;
1384
1385our @ISA = CFClient::UI::Box::;
1386
1387sub new {
1388 my $class = shift;
1389
1390 $class->SUPER::new (
1391 vertical => 0,
1392 @_,
1393 )
1394}
1395
1396#############################################################################
1397
1339package CFClient::UI::VBox; 1398package CFClient::UI::VBox;
1340 1399
1341# TODO: wrap into common Box base class
1342
1343our @ISA = CFClient::UI::Container::; 1400our @ISA = CFClient::UI::Box::;
1344 1401
1345sub size_request { 1402sub new {
1346 my ($self) = @_; 1403 my $class = shift;
1347 1404
1348 my @alloc = map [$_->size_request], @{$self->{children}}; 1405 $class->SUPER::new (
1349 1406 vertical => 1,
1350 ( 1407 @_,
1351 (List::Util::max map $_->[0], @alloc),
1352 (List::Util::sum map $_->[1], @alloc),
1353 ) 1408 )
1354}
1355
1356sub size_allocate {
1357 my ($self, $w, $h) = @_;
1358
1359 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1360
1361 my $children = $self->{children};
1362
1363 my @h = map $_->{req_h}, @$children;
1364
1365 my $req_h = List::Util::sum @h;
1366
1367 if ($req_h > $h) {
1368 # ah well, not enough space
1369 $_ *= $h / $req_h for @h;
1370 } else {
1371 my $exp = List::Util::sum map $_->{expand}, @$children;
1372 $exp ||= 1;
1373
1374 for (0 .. $#$children) {
1375 my $child = $children->[$_];
1376
1377 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1378 }
1379 }
1380
1381 CFClient::UI::harmonize \@h;
1382
1383 my $y = 0;
1384 for (0 .. $#$children) {
1385 my $child = $children->[$_];
1386 my $h = $h[$_];
1387 $child->configure (0, $y, $w, $h);
1388
1389 $y += $h;
1390 }
1391
1392 1
1393} 1409}
1394 1410
1395############################################################################# 1411#############################################################################
1396 1412
1397package CFClient::UI::Label; 1413package CFClient::UI::Label;
… …
1414 ellipsise => 3, # end 1430 ellipsise => 3, # end
1415 layout => (new CFClient::Layout), 1431 layout => (new CFClient::Layout),
1416 fontsize => 1, 1432 fontsize => 1,
1417 align => -1, 1433 align => -1,
1418 valign => -1, 1434 valign => -1,
1419 padding => 2, 1435 padding_x => 2,
1436 padding_y => 2,
1420 can_events => 0, 1437 can_events => 0,
1421 %arg 1438 %arg
1422 ); 1439 );
1423 1440
1424 if (exists $self->{template}) { 1441 if (exists $self->{template}) {
… …
1460 $self->{text} = "T$text"; 1477 $self->{text} = "T$text";
1461 1478
1462 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1479 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1463 $self->{layout}->set_text ($text); 1480 $self->{layout}->set_text ($text);
1464 1481
1482 $self->realloc;
1465 $self->update; 1483 $self->update;
1466 $self->check_size;
1467} 1484}
1468 1485
1469sub set_markup { 1486sub set_markup {
1470 my ($self, $markup) = @_; 1487 my ($self, $markup) = @_;
1471 1488
… …
1475 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1492 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1476 1493
1477 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1494 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1478 $self->{layout}->set_markup ($markup); 1495 $self->{layout}->set_markup ($markup);
1479 1496
1497 $self->realloc;
1480 $self->update; 1498 $self->update;
1481 $self->check_size;
1482} 1499}
1483 1500
1484sub size_request { 1501sub size_request {
1485 my ($self) = @_; 1502 my ($self) = @_;
1486 1503
… …
1500 1517
1501 $w = List::Util::max $w, $w2; 1518 $w = List::Util::max $w, $w2;
1502 $h = List::Util::max $h, $h2; 1519 $h = List::Util::max $h, $h2;
1503 } 1520 }
1504 1521
1505 ( 1522 ($w, $h)
1506 $w + $self->{padding} * 2,
1507 $h + $self->{padding} * 2,
1508 )
1509} 1523}
1510 1524
1511sub size_allocate { 1525sub size_allocate {
1512 my ($self, $w, $h) = @_; 1526 my ($self, $w, $h) = @_;
1513 1527
1514 delete $self->{texture}; 1528 delete $self->{texture}
1529 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1515} 1530}
1516 1531
1517sub set_fontsize { 1532sub set_fontsize {
1518 my ($self, $fontsize) = @_; 1533 my ($self, $fontsize) = @_;
1519 1534
1520 $self->{fontsize} = $fontsize; 1535 $self->{fontsize} = $fontsize;
1521 delete $self->{texture}; 1536 delete $self->{texture};
1522 1537
1523 $self->update; 1538 $self->realloc;
1524 $self->check_size;
1525} 1539}
1526 1540
1527sub _draw { 1541sub _draw {
1528 my ($self) = @_; 1542 my ($self) = @_;
1529 1543
… …
1537 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1551 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1538 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1552 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1539 1553
1540 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1554 my $tex = new_from_layout CFClient::Texture $self->{layout};
1541 1555
1542 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1556 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1543 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1557 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1544 : ($self->{w} - $tex->{w}) * 0.5); 1558 : ($self->{w} - $tex->{w}) * 0.5);
1545 1559
1546 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1560 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1547 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1561 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1548 : ($self->{h} - $tex->{h}) * 0.5); 1562 : ($self->{h} - $tex->{h}) * 0.5);
1549 1563
1550 $tex 1564 $tex
1551 }; 1565 };
1552 1566
… …
1609sub set_text { 1623sub set_text {
1610 my ($self, $text) = @_; 1624 my ($self, $text) = @_;
1611 1625
1612 $self->{cursor} = length $text; 1626 $self->{cursor} = length $text;
1613 $self->_set_text ($text); 1627 $self->_set_text ($text);
1614 $self->update; 1628
1615 $self->check_size; 1629 $self->realloc;
1616} 1630}
1617 1631
1618sub get_text { 1632sub get_text {
1619 $_[0]{text} 1633 $_[0]{text}
1620} 1634}
… …
1653 } elsif ($uni) { 1667 } elsif ($uni) {
1654 substr $text, $self->{cursor}++, 0, chr $uni; 1668 substr $text, $self->{cursor}++, 0, chr $uni;
1655 } 1669 }
1656 1670
1657 $self->_set_text ($text); 1671 $self->_set_text ($text);
1658 $self->update; 1672
1659 $self->check_size; 1673 $self->realloc;
1660} 1674}
1661 1675
1662sub focus_in { 1676sub focus_in {
1663 my ($self) = @_; 1677 my ($self) = @_;
1664 1678
… …
1791 1805
1792sub new { 1806sub new {
1793 my $class = shift; 1807 my $class = shift;
1794 1808
1795 $class->SUPER::new ( 1809 $class->SUPER::new (
1796 padding => 4, 1810 padding_x => 4,
1811 padding_y => 4,
1797 fg => [1, 1, 1], 1812 fg => [1, 1, 1],
1798 active_fg => [0, 0, 1], 1813 active_fg => [0, 0, 1],
1799 can_hover => 1, 1814 can_hover => 1,
1800 align => 0, 1815 align => 0,
1801 valign => 0, 1816 valign => 0,
… …
1848 1863
1849sub new { 1864sub new {
1850 my $class = shift; 1865 my $class = shift;
1851 1866
1852 $class->SUPER::new ( 1867 $class->SUPER::new (
1853 padding => 2, 1868 padding_x => 2,
1869 padding_y => 2,
1854 fg => [1, 1, 1], 1870 fg => [1, 1, 1],
1855 active_fg => [1, 1, 0], 1871 active_fg => [1, 1, 0],
1856 bg => [0, 0, 0, 0.2], 1872 bg => [0, 0, 0, 0.2],
1857 active_bg => [1, 1, 1, 0.5], 1873 active_bg => [1, 1, 1, 0.5],
1858 state => 0, 1874 state => 0,
… …
1862} 1878}
1863 1879
1864sub size_request { 1880sub size_request {
1865 my ($self) = @_; 1881 my ($self) = @_;
1866 1882
1867 ($self->{padding} * 2 + 6) x 2 1883 (6) x 2
1868} 1884}
1869 1885
1870sub button_down { 1886sub button_down {
1871 my ($self, $ev, $x, $y) = @_; 1887 my ($self, $ev, $x, $y) = @_;
1872 1888
1873 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1889 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1874 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1890 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1875 $self->{state} = !$self->{state}; 1891 $self->{state} = !$self->{state};
1876 $self->_emit (changed => $self->{state}); 1892 $self->_emit (changed => $self->{state});
1877 } 1893 }
1878} 1894}
1879 1895
1880sub _draw { 1896sub _draw {
1881 my ($self) = @_; 1897 my ($self) = @_;
1882 1898
1883 $self->SUPER::_draw; 1899 $self->SUPER::_draw;
1884 1900
1885 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1901 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1886 1902
1887 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1903 my ($w, $h) = @$self{qw(w h)};
1904
1905 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1888 1906
1889 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1907 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1890 1908
1891 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1909 my $tex = $self->{state} ? $tex[1] : $tex[0];
1892 1910
… …
2157 fg => [1, 1, 1], 2175 fg => [1, 1, 1],
2158 active_fg => [0, 0, 0], 2176 active_fg => [0, 0, 0],
2159 bg => [0, 0, 0, 0.2], 2177 bg => [0, 0, 0, 0.2],
2160 active_bg => [1, 1, 1, 0.5], 2178 active_bg => [1, 1, 1, 0.5],
2161 range => [0, 0, 100, 10, 0], 2179 range => [0, 0, 100, 10, 0],
2162 req_w => $::WIDTH / 80, 2180 min_w => $::WIDTH / 80,
2163 req_h => $::WIDTH / 80, 2181 min_h => $::WIDTH / 80,
2164 vertical => 0, 2182 vertical => 0,
2165 can_hover => 1, 2183 can_hover => 1,
2166 inner_pad => 0.02, 2184 inner_pad => 0.02,
2167 @_ 2185 @_
2168 ); 2186 );
… …
2171 $self->update; 2189 $self->update;
2172 2190
2173 $self 2191 $self
2174} 2192}
2175 2193
2194sub changed { }
2195
2176sub set_range { 2196sub set_range {
2177 my ($self, $range) = @_; 2197 my ($self, $range) = @_;
2178 2198
2179 ($range, $self->{range}) = ($self->{range}, $range); 2199 ($range, $self->{range}) = ($self->{range}, $range);
2180 2200
… …
2206} 2226}
2207 2227
2208sub size_request { 2228sub size_request {
2209 my ($self) = @_; 2229 my ($self) = @_;
2210 2230
2211 my $w = $self->{req_w}; 2231 ($self->{req_w}, $self->{req_h})
2212 my $h = $self->{req_h};
2213
2214 $self->{vertical} ? ($h, $w) : ($w, $h)
2215} 2232}
2216 2233
2217sub button_down { 2234sub button_down {
2218 my ($self, $ev, $x, $y) = @_; 2235 my ($self, $ev, $x, $y) = @_;
2219 2236
… …
2570 2587
2571sub new { 2588sub new {
2572 my $class = shift; 2589 my $class = shift;
2573 2590
2574 my $self = $class->SUPER::new ( 2591 my $self = $class->SUPER::new (
2575 state => 0, 2592 state => 0,
2576 connect_activate => \&toggle_flopper, 2593 on_activate => \&toggle_flopper,
2577 @_ 2594 @_
2578 ); 2595 );
2579 2596
2580 if ($self->{state}) {
2581 $self->{state} = 0;
2582 $self->toggle_flopper;
2583 }
2584
2585 $self 2597 $self
2586} 2598}
2587 2599
2588sub toggle_flopper { 2600sub toggle_flopper {
2589 my ($self) = @_; 2601 my ($self) = @_;
2590 2602
2591 # TODO: use animation 2603 $self->{other}->toggle_visibility;
2592 if ($self->{state} = !$self->{state}) {
2593 $CFClient::UI::ROOT->add ($self->{other});
2594 $self->{other}->move ($self->coord2global (0, $self->{h}));
2595 $self->_emit ("open");
2596 } else {
2597 $CFClient::UI::ROOT->remove ($self->{other});
2598 $self->_emit ("close");
2599 }
2600
2601 $self->_emit (changed => $self->{state});
2602} 2604}
2603 2605
2604############################################################################# 2606#############################################################################
2605 2607
2606package CFClient::UI::Tooltip; 2608package CFClient::UI::Tooltip;
… …
2619} 2621}
2620 2622
2621sub set_tooltip_from { 2623sub set_tooltip_from {
2622 my ($self, $widget) = @_; 2624 my ($self, $widget) = @_;
2623 2625
2626 my $tooltip = $widget->{tooltip};
2627
2628 if ($ENV{CFPLUS_DEBUG} & 2) {
2629 $tooltip .= "\n\n" . (ref $widget) . "\n"
2630 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2631 . "req $widget->{req_w} $widget->{req_h}\n"
2632 . "visible $widget->{visible}";
2633 }
2634
2624 $self->add (new CFClient::UI::Label 2635 $self->add (new CFClient::UI::Label
2625 markup => $widget->{tooltip}, 2636 markup => $tooltip,
2626 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2637 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2627 fontsize => 0.8, 2638 fontsize => 0.8,
2628 fg => [0, 0, 0, 1], 2639 fg => [0, 0, 0, 1],
2629 ellipsise => 0, 2640 ellipsise => 0,
2630 font => ($widget->{tooltip_font} || $::FONT_PROP), 2641 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2641 2652
2642sub size_allocate { 2653sub size_allocate {
2643 my ($self, $w, $h) = @_; 2654 my ($self, $w, $h) = @_;
2644 2655
2645 $self->SUPER::size_allocate ($w - 4, $h - 4); 2656 $self->SUPER::size_allocate ($w - 4, $h - 4);
2657}
2658
2659sub visibility_change {
2660 my ($self, $visible) = @_;
2661
2662 return unless $visible;
2663
2664 $self->{root}->on_post_alloc ("move_$self" => sub {
2665 my $widget = $self->{owner}
2666 or return;
2667
2668 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2669
2670 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2671 if $x + $self->{w} > $::WIDTH;
2672
2673 $self->move_abs ($x, $y);
2674 });
2646} 2675}
2647 2676
2648sub _draw { 2677sub _draw {
2649 my ($self) = @_; 2678 my ($self) = @_;
2650 2679
… …
2667 glVertex $w, $h; 2696 glVertex $w, $h;
2668 glVertex $w, 0; 2697 glVertex $w, 0;
2669 glEnd; 2698 glEnd;
2670 2699
2671 glTranslate 2 - 0.375, 2 - 0.375; 2700 glTranslate 2 - 0.375, 2 - 0.375;
2701
2672 $self->SUPER::_draw; 2702 $self->SUPER::_draw;
2673} 2703}
2674 2704
2675############################################################################# 2705#############################################################################
2676 2706
… …
2752 $self->SUPER::DESTROY; 2782 $self->SUPER::DESTROY;
2753} 2783}
2754 2784
2755############################################################################# 2785#############################################################################
2756 2786
2757package CFClient::UI::Inventory;
2758
2759our @ISA = CFClient::UI::ScrolledWindow::;
2760
2761sub new {
2762 my $class = shift;
2763
2764 my $self = $class->SUPER::new (
2765 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2766 @_,
2767 );
2768
2769 $self
2770}
2771
2772sub set_items {
2773 my ($self, $items) = @_;
2774
2775 $self->{scrolled}->clear;
2776 return unless $items;
2777
2778 my @items = sort {
2779 ($a->{type} <=> $b->{type})
2780 or ($a->{name} cmp $b->{name})
2781 } @$items;
2782
2783 $self->{real_items} = \@items;
2784
2785 my $row = 0;
2786 for my $item (@items) {
2787 CFClient::Item::update_widgets $item;
2788
2789 $self->{scrolled}->add (0, $row, $item->{face_widget});
2790 $self->{scrolled}->add (1, $row, $item->{desc_widget});
2791 $self->{scrolled}->add (2, $row, $item->{weight_widget});
2792
2793 $row++;
2794 }
2795}
2796
2797sub size_request {
2798 my ($self) = @_;
2799 ($self->{req_w}, $self->{req_h});
2800}
2801
2802#############################################################################
2803
2804package CFClient::UI::Menu; 2787package CFClient::UI::Menu;
2805 2788
2806our @ISA = CFClient::UI::FancyFrame::; 2789our @ISA = CFClient::UI::FancyFrame::;
2807 2790
2808use CFClient::OpenGL; 2791use CFClient::OpenGL;
… …
2846 # maybe save $GRAB? must be careful about events... 2829 # maybe save $GRAB? must be careful about events...
2847 $GRAB = $self; 2830 $GRAB = $self;
2848 $self->{button} = $ev->{button}; 2831 $self->{button} = $ev->{button};
2849 2832
2850 $self->show; 2833 $self->show;
2851 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2834 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2852} 2835}
2853 2836
2854sub mouse_motion { 2837sub mouse_motion {
2855 my ($self, $ev, $x, $y) = @_; 2838 my ($self, $ev, $x, $y) = @_;
2856 2839
… …
2981 $self->SUPER::reconfigure; 2964 $self->SUPER::reconfigure;
2982} 2965}
2983 2966
2984############################################################################# 2967#############################################################################
2985 2968
2986package CFClient::UI::Root; 2969package CFClient::UI::Inventory;
2987 2970
2988our @ISA = CFClient::UI::Container::; 2971our @ISA = CFClient::UI::ScrolledWindow::;
2989
2990use CFClient::OpenGL;
2991 2972
2992sub new { 2973sub new {
2993 my $class = shift; 2974 my $class = shift;
2994 2975
2995 $class->SUPER::new ( 2976 my $self = $class->SUPER::new (
2977 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2978 @_,
2979 );
2980
2981 $self
2982}
2983
2984sub set_items {
2985 my ($self, $items) = @_;
2986
2987 $self->{scrolled}->clear;
2988 return unless $items;
2989
2990 my @items = sort {
2991 ($a->{type} <=> $b->{type})
2992 or ($a->{name} cmp $b->{name})
2993 } @$items;
2994
2995 $self->{real_items} = \@items;
2996
2997 my $row = 0;
2998 for my $item (@items) {
2999 CFClient::Item::update_widgets $item;
3000
3001 $self->{scrolled}->add (0, $row, $item->{face_widget});
3002 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3003 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3004
3005 $row++;
3006 }
3007}
3008
3009#############################################################################
3010
3011package CFClient::UI::BindEditor;
3012
3013our @ISA = CFClient::UI::FancyFrame::;
3014
3015sub new {
3016 my $class = shift;
3017
3018 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3019
3020 $self->add (my $vb = new CFClient::UI::VBox);
3021
3022
3023 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3024 text => "start recording",
3025 tooltip => "Start/Stops recording of actions."
3026 ."All subsequent actions after the recording started will be captured."
3027 ."The actions are displayed after the record was stopped."
3028 ."To bind the action you have to click on the 'Bind' button",
3029 on_activate => sub {
3030 unless ($self->{recording}) {
3031 $self->start;
3032 } else {
3033 $self->stop;
3034 }
3035 });
3036
3037 $vb->add (new CFClient::UI::Label text => "Actions:");
3038 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3039
3040 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3041 $vb->add (my $hb = new CFClient::UI::HBox);
3042 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3043 $hb->add (new CFClient::UI::Button
3044 text => "bind",
3045 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3046 on_activate => sub {
3047 $self->ask_for_bind;
3048 });
3049
3050 $vb->add (my $hb = new CFClient::UI::HBox);
3051 $hb->add (new CFClient::UI::Button
3052 text => "ok",
3053 expand => 1,
3054 tooltip => "This closes the binding editor and saves the binding",
3055 on_activate => sub {
3056 $self->hide;
3057 $self->commit;
3058 });
3059
3060 $hb->add (new CFClient::UI::Button
3061 text => "cancel",
3062 expand => 1,
3063 tooltip => "This closes the binding editor without saving",
3064 on_activate => sub {
3065 $self->hide;
3066 $self->{binding_cancel}->()
3067 if $self->{binding_cancel};
3068 });
3069
3070 $self->update_binding_widgets;
3071
3072 $self
3073}
3074
3075sub commit {
3076 my ($self) = @_;
3077 my ($mod, $sym, $cmds) = $self->get_binding;
3078 if ($sym != 0 && @$cmds > 0) {
3079 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3080 ."'. Don't forget 'Save Config'!");
3081 $self->{binding_change}->($mod, $sym, $cmds)
3082 if $self->{binding_change};
3083 } else {
3084 $::STATUSBOX->add ("No action bound, no key or action specified!");
3085 $self->{binding_cancel}->()
3086 if $self->{binding_cancel};
3087 }
3088}
3089
3090sub start {
3091 my ($self) = @_;
3092
3093 $self->{rec_btn}->set_text ("stop recording");
3094 $self->{recording} = 1;
3095 $self->clear_command_list;
3096 $::CONN->start_record if $::CONN;
3097}
3098
3099sub stop {
3100 my ($self) = @_;
3101
3102 $self->{rec_btn}->set_text ("start recording");
3103 $self->{recording} = 0;
3104
3105 my $rec;
3106 $rec = $::CONN->stop_record if $::CONN;
3107 return unless ref $rec eq 'ARRAY';
3108 $self->set_command_list ($rec);
3109}
3110
3111# if $commit is true, the binding will be set after the user entered a key combo
3112sub ask_for_bind {
3113 my ($self, $commit) = @_;
3114
3115 CFClient::Binder::open_binding_dialog (sub {
3116 my ($mod, $sym) = @_;
3117 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3118 $self->update_binding_widgets;
3119 $self->commit if $commit;
3120 });
3121}
3122
3123# $mod and $sym are the modifiers and key symbol
3124# $cmds is a array ref of strings (the commands)
3125# $cb is the callback that is executed on OK
3126# $ccb is the callback that is executed on CANCEL and
3127# when the binding was unsuccessful on OK
3128sub set_binding {
3129 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3130
3131 $self->clear_command_list;
3132 $self->{recording} = 0;
3133 $self->{rec_btn}->set_text ("start recording");
3134
3135 $self->{binding} = [$mod, $sym];
3136 $self->{commands} = $cmds;
3137
3138 $self->{binding_change} = $cb;
3139 $self->{binding_cancel} = $ccb;
3140
3141 $self->update_binding_widgets;
3142}
3143
3144# this is a shortcut method that asks for a binding
3145# and then just binds it.
3146sub do_quick_binding {
3147 my ($self, $cmds) = @_;
3148 $self->set_binding (undef, undef, $cmds, sub {
3149 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3150 });
3151 $self->ask_for_bind (1);
3152}
3153
3154sub update_binding_widgets {
3155 my ($self) = @_;
3156 my ($mod, $sym, $cmds) = $self->get_binding;
3157 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3158 $self->set_command_list ($cmds);
3159}
3160
3161sub get_binding {
3162 my ($self) = @_;
3163 return (
3164 $self->{binding}->[0],
3165 $self->{binding}->[1],
3166 [ grep { defined $_ } @{$self->{commands}} ]
3167 );
3168}
3169
3170sub clear_command_list {
3171 my ($self) = @_;
3172 $self->{cmdbox}->clear ();
3173}
3174
3175sub set_command_list {
3176 my ($self, $cmds) = @_;
3177
3178 $self->{cmdbox}->clear ();
3179 $self->{commands} = $cmds;
3180
3181 my $idx = 0;
3182
3183 for (@$cmds) {
3184 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3185
3186 my $i = $idx;
3187 $hb->add (new CFClient::UI::Label text => $_);
3188 $hb->add (new CFClient::UI::Button
3189 text => "delete",
3190 tooltip => "Deletes the action from the record",
3191 on_activate => sub {
3192 $self->{cmdbox}->remove ($hb);
3193 $cmds->[$i] = undef;
3194 });
3195
3196
3197 $idx++
3198 }
3199}
3200
3201#############################################################################
3202
3203package CFClient::UI::SpellList;
3204
3205our @ISA = CFClient::UI::FancyFrame::;
3206
3207sub new {
3208 my $class = shift;
3209
3210 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3211
3212 $self->add (new CFClient::UI::ScrolledWindow
3213 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3214
3215 $self;
3216}
3217
3218# XXX: Do sorting? Argl...
3219sub add_spell {
3220 my ($self, $spell) = @_;
3221 $self->{spells}->{$spell->{name}} = $spell;
3222
3223 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3224 face => $spell->{face},
3225 can_hover => 1,
3226 can_events => 1,
3227 tooltip => $spell->{message});
3228
3229 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3230 text => $spell->{name},
3231 can_hover => 1,
3232 can_events => 1,
3233 tooltip => $spell->{message},
3234 expand => 1);
3235
3236 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3237 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3238 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3239 expand => 1);
3240
3241 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3242 text => "bind to key",
3243 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3244}
3245
3246sub rebuild_spell_list {
3247 my ($self) = @_;
3248 $self->{tbl_idx} = 0;
3249 $self->add_spell ($_) for values %{$self->{spells}};
3250}
3251
3252sub remove_spell {
3253 my ($self, $spell) = @_;
3254 delete $self->{spells}->{$spell->{name}};
3255 $self->rebuild_spell_list;
3256}
3257
3258#############################################################################
3259
3260package CFClient::UI::Root;
3261
3262our @ISA = CFClient::UI::Container::;
3263
3264use CFClient::OpenGL;
3265
3266sub new {
3267 my $class = shift;
3268
3269 my $self = $class->SUPER::new (
2996 visible => 1, 3270 visible => 1,
2997 @_, 3271 @_,
2998 ) 3272 );
2999}
3000 3273
3001sub configure { 3274 Scalar::Util::weaken ($self->{root} = $self);
3002 my ($self, $x, $y, $w, $h) = @_;
3003 3275
3004 $self->{w} = $w; 3276 $self
3005 $self->{h} = $h;
3006}
3007
3008sub check_size {
3009 my ($self) = @_;
3010
3011 $self->size_allocate ($self->{w}, $self->{h})
3012 if $self->{w};
3013} 3277}
3014 3278
3015sub size_request { 3279sub size_request {
3016 my ($self) = @_; 3280 my ($self) = @_;
3017 3281
3018 ($self->{w}, $self->{h}) 3282 ($self->{w}, $self->{h})
3283}
3284
3285sub _to_pixel {
3286 my ($coord, $size, $max) = @_;
3287
3288 $coord =
3289 $coord eq "center" ? ($max - $size) * 0.5
3290 : $coord eq "max" ? $max
3291 : $coord;
3292
3293 $coord = 0 if $coord < 0;
3294 $coord = $max - $size if $coord > $max - $size;
3295
3296 int $coord + 0.5
3019} 3297}
3020 3298
3021sub size_allocate { 3299sub size_allocate {
3022 my ($self, $w, $h) = @_; 3300 my ($self, $w, $h) = @_;
3023 3301
3024 for my $child ($self->children) { 3302 for my $child ($self->children) {
3025 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3303 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3026 3304
3027 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3305 $X = $child->{force_x} if exists $child->{force_x};
3028 if exists $child->{req_x}; 3306 $Y = $child->{force_y} if exists $child->{force_y};
3029 3307
3030 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3308 $X = _to_pixel $X, $W, $self->{w};
3031 if exists $child->{req_y}; 3309 $Y = _to_pixel $Y, $H, $self->{h};
3032
3033 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3034 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3035 3310
3036 $child->configure ($X, $Y, $W, $H); 3311 $child->configure ($X, $Y, $W, $H);
3037 } 3312 }
3038} 3313}
3039 3314
… …
3050} 3325}
3051 3326
3052sub update { 3327sub update {
3053 my ($self) = @_; 3328 my ($self) = @_;
3054 3329
3055 $self->check_size;
3056 $::WANT_REFRESH++; 3330 $::WANT_REFRESH++;
3057} 3331}
3058 3332
3059sub add { 3333sub add {
3060 my ($self, @children) = @_; 3334 my ($self, @children) = @_;
3061 3335
3062 for (my @widgets = @children; my $w = pop @widgets; ) {
3063 push @widgets, $w->children;
3064 $w->{root} = $self;
3065 $w->{visible} = $self->{visible} + 1;
3066 }
3067
3068 for my $child (@children) {
3069 $child->{is_toplevel} = 1; 3336 $_->{is_toplevel} = 1
3070 3337 for @children;
3071 # integerise window positions
3072 $child->{x} = int $child->{x};
3073 $child->{y} = int $child->{y};
3074 }
3075 3338
3076 $self->SUPER::add (@children); 3339 $self->SUPER::add (@children);
3077} 3340}
3078 3341
3079sub remove { 3342sub remove {
3080 my ($self, @children) = @_; 3343 my ($self, @children) = @_;
3081 3344
3082 $self->SUPER::remove (@children); 3345 $self->SUPER::remove (@children);
3346
3347 delete $self->{is_toplevel}
3348 for @children;
3083 3349
3084 while (@children) { 3350 while (@children) {
3085 my $w = pop @children; 3351 my $w = pop @children;
3086 push @children, $w->children; 3352 push @children, $w->children;
3087 $w->set_invisible; 3353 $w->set_invisible;
… …
3106 while ($self->{refresh_hook}) { 3372 while ($self->{refresh_hook}) {
3107 $_->() 3373 $_->()
3108 for values %{delete $self->{refresh_hook}}; 3374 for values %{delete $self->{refresh_hook}};
3109 } 3375 }
3110 3376
3111 if ($self->{check_size}) { 3377 if ($self->{realloc}) {
3112 my @queue = ([], []); 3378 my %queue;
3379 my @queue;
3380 my $widget;
3113 3381
3114 for (;;) { 3382 outer:
3115 if ($self->{check_size}) { 3383 while () {
3116 # heuristic: check containers last 3384 if (my $realloc = delete $self->{realloc}) {
3117 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3385 for $widget (values %$realloc) {
3118 for values %{delete $self->{check_size}} 3386 $widget->{visible} or next; # do not resize invisible widgets
3387
3388 $queue{$widget+0}++ and next; # duplicates are common
3389
3390 push @{ $queue[$widget->{visible}] }, $widget;
3391 }
3119 } 3392 }
3120 3393
3121 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3394 while () {
3395 @queue or last outer;
3122 3396
3123 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3397 $widget = pop @{ $queue[-1] || [] }
3124 ? @$widget{qw(user_w user_h)} 3398 and last;
3125 : $widget->size_request;
3126
3127 if (delete $widget->{force_alloc}
3128 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3129 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3130 3399
3400 pop @queue;
3401 }
3402
3403 delete $queue{$widget+0};
3404
3405 my ($w, $h) = $widget->size_request;
3406
3407 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3408 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3409
3410 $w = $widget->{force_w} if exists $widget->{force_w};
3411 $h = $widget->{force_h} if exists $widget->{force_h};
3412
3413 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3414 || delete $widget->{force_realloc}) {
3131 $widget->{req_w} = $w; 3415 $widget->{req_w} = $w;
3132 $widget->{req_h} = $h; 3416 $widget->{req_h} = $h;
3133 3417
3134 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3418 $self->{size_alloc}{$widget+0} = $widget;
3135 3419
3136 $widget->{parent}->check_size
3137 if $widget->{parent}; 3420 if (my $parent = $widget->{parent}) {
3421 $self->{realloc}{$parent+0} = $parent
3422 unless $queue{$parent+0};
3423
3424 $parent->{force_size_alloc} = 1;
3425 $self->{size_alloc}{$parent+0} = $parent;
3426 }
3138 } 3427 }
3428
3429 delete $self->{realloc}{$widget+0};
3139 } 3430 }
3140 } 3431 }
3141 3432
3142 while ($self->{size_alloc}) { 3433 while (my $size_alloc = delete $self->{size_alloc}) {
3143 for (values %{delete $self->{size_alloc}}) { 3434 my @queue = sort { $b->{visible} <=> $a->{visible} }
3144 my ($widget, $w, $h) = @$_; 3435 values %$size_alloc;
3436
3437 while () {
3438 my $widget = pop @queue || last;
3439
3440 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3145 3441
3146 $w = 0 if $w < 0; 3442 $w = 0 if $w < 0;
3147 $h = 0 if $h < 0; 3443 $h = 0 if $h < 0;
3148 3444
3445 $w = int $w + 0.5;
3446 $h = int $h + 0.5;
3447
3448 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3449 $widget->{old_w} = $widget->{w};
3450 $widget->{old_h} = $widget->{h};
3451
3149 $widget->{w} = $w; 3452 $widget->{w} = $w;
3150 $widget->{h} = $h; 3453 $widget->{h} = $h;
3454
3151 $widget->emit (size_allocate => $w, $h); 3455 $widget->emit (size_allocate => $w, $h);
3456 }
3152 } 3457 }
3153 } 3458 }
3154 3459
3155 while ($self->{post_alloc_hook}) { 3460 while ($self->{post_alloc_hook}) {
3156 $_->() 3461 $_->()
3157 for values %{delete $self->{post_alloc_hook}}; 3462 for values %{delete $self->{post_alloc_hook}};
3158 } 3463 }
3464
3159 3465
3160 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3466 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3161 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3467 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3162 glClear GL_COLOR_BUFFER_BIT; 3468 glClear GL_COLOR_BUFFER_BIT;
3163 3469

Diff Legend

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