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.245 by elmex, Sat May 27 21:15:57 2006 UTC vs.
Revision 1.262 by elmex, Wed May 31 13:44:26 2006 UTC

… …
17our $BUTTON_STATE; 17our $BUTTON_STATE;
18 18
19our %WIDGET; # all widgets, weak-referenced 19our %WIDGET; # all widgets, weak-referenced
20 20
21sub get_layout { 21sub get_layout {
22 my $layout;
23
22 for (grep { $_->{name} } values %WIDGET) { 24 for (grep { $_->{name} } values %WIDGET) {
23 $LAYOUT->{$_->{name}} = { 25 my $win = $layout->{$_->{name}} = { };
24 x => $_->{x} / $::WIDTH,
25 y => $_->{y} / $::HEIGHT,
26 w => $_->{w} / $::WIDTH,
27 h => $_->{h} / $::HEIGHT
28 }; 26
29 } 27 $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
28 $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
29 $win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
30 $win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
30 31
31 return $LAYOUT; 32 $win->{show} = $_->{visible} && $_->{is_toplevel};
33 }
34
35 $layout
32} 36}
33 37
34sub set_layout { 38sub set_layout {
35 my ($layout) = @_; 39 my ($layout) = @_;
40
36 $LAYOUT = $layout; 41 $LAYOUT = $layout;
37} 42}
38 43
39sub check_tooltip { 44sub check_tooltip {
40 if (!$GRAB) { 45 if (!$GRAB) {
41 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 46 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
42 if (length $widget->{tooltip}) { 47 if (length $widget->{tooltip}) {
43 48
44 if ($TOOLTIP->{owner} != $widget) { 49 if ($TOOLTIP->{owner} != $widget) {
50 $TOOLTIP->hide;
51
45 $TOOLTIP->{owner} = $widget; 52 $TOOLTIP->{owner} = $widget;
46 53
47 my $tip = $widget->{tooltip}; 54 my $tip = $widget->{tooltip};
48 55
49 $tip = $tip->($widget) if CODE:: eq ref $tip; 56 $tip = $tip->($widget) if CODE:: eq ref $tip;
50 57
51 $TOOLTIP->set_tooltip_from ($widget); 58 $TOOLTIP->set_tooltip_from ($widget);
52 $TOOLTIP->show; 59 $TOOLTIP->show;
53
54 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
55
56 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
57 if $x + $TOOLTIP->{w} > $::WIDTH;
58
59 $TOOLTIP->move ($x, $y);
60 $TOOLTIP->check_size;
61 $TOOLTIP->update;
62 } 60 }
63 61
64 return; 62 return;
65 } 63 }
66 } 64 }
… …
172sub rescale_widgets { 170sub rescale_widgets {
173 my ($sx, $sy) = @_; 171 my ($sx, $sy) = @_;
174 172
175 for my $widget (values %WIDGET) { 173 for my $widget (values %WIDGET) {
176 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
177 $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.]+$/;
178 $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};
179 $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};
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}; 181 $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}; 182 $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}; 183 $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}; 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
185 } 188 }
186 } 189 }
187 190
188 reconfigure_widgets; 191 reconfigure_widgets;
189} 192}
… …
198 201
199sub new { 202sub new {
200 my $class = shift; 203 my $class = shift;
201 204
202 my $self = bless { 205 my $self = bless {
203 x => 0, 206 x => "center",
204 y => 0, 207 y => "center",
205 z => 0, 208 z => 0,
209 w => undef,
210 h => undef,
206 can_events => 1, 211 can_events => 1,
207 @_ 212 @_
208 }, $class; 213 }, $class;
214
215 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
209 216
210 for (keys %$self) { 217 for (keys %$self) {
211 if (/^on_(.*)$/) { 218 if (/^on_(.*)$/) {
212 $self->connect ($1 => delete $self->{$_}); 219 $self->connect ($1 => delete $self->{$_});
213 } 220 }
214 } 221 }
215 222
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
218 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) { 223 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
219 $self->{user_x} = $layout->{x} * $::WIDTH; 224 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
220 $self->{user_y} = $layout->{y} * $::HEIGHT; 225 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
221 $self->{user_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH; 226 $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; 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};
223 } 233 }
224 234
225 $self 235 $self
226}
227
228sub toggle_visibility {
229 my ($self) = @_;
230
231 if ($self->{visible}) {
232 $self->hide;
233 } else {
234 $self->show;
235 }
236} 236}
237 237
238sub destroy { 238sub destroy {
239 my ($self) = @_; 239 my ($self) = @_;
240 240
… …
242 %$self = (); 242 %$self = ();
243} 243}
244 244
245sub show { 245sub show {
246 my ($self) = @_; 246 my ($self) = @_;
247
247 return if $self->{parent}; 248 return if $self->{parent};
248 249
249 $CFClient::UI::ROOT->add ($self); 250 $CFClient::UI::ROOT->add ($self);
250} 251}
251 252
252sub show_centered { 253sub set_visible {
253 my ($self) = @_; 254 my ($self) = @_;
255
254 return if $self->{parent}; 256 return if $self->{visible};
255 257
256 $self->show; 258 $self->{root} = $self->{parent}{root};
259 $self->{visible} = $self->{parent}{visible} + 1;
257 260
258 $CFClient::UI::ROOT->on_post_alloc ( 261 $self->emit (visibility_change => 1);
259 "centered $self" => sub { 262
260 $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5); 263 $self->realloc if !exists $self->{req_w};
261 }, 264
262 ); 265 $_->set_visible for $self->children;
263} 266}
264 267
265sub set_invisible { 268sub set_invisible {
266 my ($self) = @_; 269 my ($self) = @_;
267 270
268 return unless $self->{visible}; 271 return unless $self->{visible};
269 272
270 # broken show/hide model 273 $_->set_invisible for $self->children;
271 274
272 delete $self->{root}; 275 delete $self->{root};
273 delete $self->{visible}; 276 delete $self->{visible};
274 277
275 undef $GRAB if $GRAB == $self; 278 undef $GRAB if $GRAB == $self;
276 undef $HOVER if $HOVER == $self; 279 undef $HOVER if $HOVER == $self;
277 280
278 CFClient::UI::check_tooltip 281 CFClient::UI::check_tooltip
279 if $CFClient::UI::TOOLTIP->{owner} == $self; 282 if $TOOLTIP->{owner} == $self;
280 283
281 $self->focus_out; 284 $self->focus_out;
282 285
283 $self->emit (visibility_change => 0); 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;
284} 304}
285 305
286sub hide { 306sub hide {
287 my ($self) = @_; 307 my ($self) = @_;
288 308
… …
290 310
291 $self->{parent}->remove ($self) 311 $self->{parent}->remove ($self)
292 if $self->{parent}; 312 if $self->{parent};
293} 313}
294 314
295sub move { 315sub move_abs {
296 my ($self, $x, $y, $z) = @_; 316 my ($self, $x, $y, $z) = @_;
297 317
298 $self->{x} = int $x; 318 $self->{x} = List::Util::max 0, int $x;
299 $self->{y} = int $y; 319 $self->{y} = List::Util::max 0, int $y;
300 $self->{z} = $z if defined $z; 320 $self->{z} = $z if defined $z;
301 321
302 $self->update; 322 $self->update;
303} 323}
304 324
305sub set_size { 325sub set_size {
306 my ($self, $w, $h) = @_; 326 my ($self, $w, $h) = @_;
307 327
308 $self->{user_w} = $w; 328 $self->{force_w} = $w;
309 $self->{user_h} = $h; 329 $self->{force_h} = $h;
310 330
311 $self->check_size; 331 $self->realloc;
312} 332}
313 333
314sub size_request { 334sub size_request {
315 require Carp; 335 require Carp;
316 Carp::confess "size_request is abstract"; 336 Carp::confess "size_request is abstract";
… …
318 338
319sub configure { 339sub configure {
320 my ($self, $x, $y, $w, $h) = @_; 340 my ($self, $x, $y, $w, $h) = @_;
321 341
322 if ($self->{aspect}) { 342 if ($self->{aspect}) {
343 my ($ow, $oh) = ($w, $h);
344
323 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 345 $w = List::Util::min $w, int $h * $self->{aspect};
324 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 346 $h = List::Util::min $h, int $w / $self->{aspect};
325 347
326 # use alignment to adjust x, y 348 # use alignment to adjust x, y
327 349
328 $x += int +($w - $w2) * 0.5; 350 $x += int 0.5 * ($ow - $w);
329 $y += int +($h - $h2) * 0.5; 351 $y += int 0.5 * ($oh - $h);
330
331 ($w, $h) = ($w2, $h2);
332 } 352 }
333 353
334 if ($self->{x} != $x || $self->{y} != $y) { 354 if ($self->{x} ne $x || $self->{y} ne $y) {
335 $self->{x} = $x; 355 $self->{x} = $x;
336 $self->{y} = $y; 356 $self->{y} = $y;
337 $self->update; 357 $self->update;
338 } 358 }
339 359
340 if ($self->{w} != $w || $self->{h} != $h) { 360 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
341 $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;
342 } 367 }
343} 368}
344 369
345sub size_allocate { 370sub size_allocate {
346 # nothing to be done 371 # nothing to be done
347}
348
349sub reconfigure {
350 my ($self) = @_;
351
352 $self->check_size (1);
353 $self->update;
354} 372}
355 373
356sub children { 374sub children {
357} 375}
358 376
… …
436sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 454sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
437sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 455sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
438sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 456sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
439sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 457sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
440sub 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}
441 529
442sub draw { 530sub draw {
443 my ($self) = @_; 531 my ($self) = @_;
444 532
445 return unless $self->{h} && $self->{w}; 533 return unless $self->{h} && $self->{w};
… …
462 glVertex $x , $y + $self->{h}; 550 glVertex $x , $y + $self->{h};
463 glEnd; 551 glEnd;
464 glDisable GL_BLEND; 552 glDisable GL_BLEND;
465 } 553 }
466 554
467 if ($ENV{PCLIENT_DEBUG}) { 555 if ($ENV{CFPLUS_DEBUG} & 1) {
468 glPushMatrix; 556 glPushMatrix;
469 glColor 1, 1, 0, 1; 557 glColor 1, 1, 0, 1;
470 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 558 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
471 glBegin GL_LINE_LOOP; 559 glBegin GL_LINE_LOOP;
472 glVertex 0 , 0; 560 glVertex 0 , 0;
… …
483 my ($self) = @_; 571 my ($self) = @_;
484 572
485 warn "no draw defined for $self\n"; 573 warn "no draw defined for $self\n";
486} 574}
487 575
488sub find_widget {
489 my ($self, $x, $y) = @_;
490
491 return () unless $self->{can_events};
492
493 return $self
494 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
495 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
496
497 ()
498}
499
500sub set_parent {
501 my ($self, $parent) = @_;
502
503 Scalar::Util::weaken ($self->{parent} = $parent);
504
505 if ($parent->{visible} || 1) {
506 $self->{root} = $parent->{root};
507 $self->{visible} = $parent->{visible} + 1;
508
509 $self->emit (visibility_change => 1)
510 unless $self->{parent}{visible};
511 }
512
513 # TODO: req_w _does_change after ->reconfigure
514 $self->check_size
515 unless exists $self->{req_w};
516
517 $self->show;
518}
519
520sub check_size {
521 my ($self, $forced) = @_;
522
523 $self->{force_alloc} = 1 if $forced;
524 $CFClient::UI::ROOT->{check_size}{$self} = $self;
525}
526
527sub update {
528 my ($self) = @_;
529
530 $self->{parent}->update
531 if $self->{parent};
532}
533
534sub connect {
535 my ($self, $signal, $cb) = @_;
536
537 push @{ $self->{signal_cb}{$signal} }, $cb;
538}
539
540sub _emit {
541 my ($self, $signal, @args) = @_;
542
543 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
544}
545
546sub emit {
547 my ($self, $signal, @args) = @_;
548
549 $self->_emit ($signal, @args)
550 || $self->$signal (@args);
551}
552
553sub visibility_change {
554 #my ($self, $visible) = @_;
555}
556
557sub DESTROY { 576sub DESTROY {
558 my ($self) = @_; 577 my ($self) = @_;
559 578
560 delete $WIDGET{$self+0}; 579 delete $WIDGET{$self+0};
561 #$self->deactivate; 580 #$self->deactivate;
… …
617 my ($class, %arg) = @_; 636 my ($class, %arg) = @_;
618 $class->SUPER::new (can_events => 0, %arg); 637 $class->SUPER::new (can_events => 0, %arg);
619} 638}
620 639
621sub size_request { 640sub size_request {
622 (0, 0) 641 my ($self) = @_;
642
643 ($self->{w} + 0, $self->{h} + 0)
623} 644}
624 645
625sub draw { } 646sub draw { }
626 647
627############################################################################# 648#############################################################################
… …
656 $self->{children} = [ 677 $self->{children} = [
657 sort { $a->{z} <=> $b->{z} } 678 sort { $a->{z} <=> $b->{z} }
658 @{$self->{children}}, @widgets 679 @{$self->{children}}, @widgets
659 ]; 680 ];
660 681
661 $self->check_size (1); 682 $self->realloc;
662 $self->update;
663} 683}
664 684
665sub children { 685sub children {
666 @{ $_[0]{children} } 686 @{ $_[0]{children} }
667} 687}
… …
672 delete $child->{parent}; 692 delete $child->{parent};
673 $child->hide; 693 $child->hide;
674 694
675 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 695 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
676 696
677 $self->check_size (1); 697 $self->realloc;
678 $self->update;
679} 698}
680 699
681sub clear { 700sub clear {
682 my ($self) = @_; 701 my ($self) = @_;
683 702
… …
687 for (@$children) { 706 for (@$children) {
688 delete $_->{parent}; 707 delete $_->{parent};
689 $_->hide; 708 $_->hide;
690 } 709 }
691 710
692 $self->check_size; 711 $self->realloc;
693 $self->update;
694} 712}
695 713
696sub find_widget { 714sub find_widget {
697 my ($self, $x, $y) = @_; 715 my ($self, $x, $y) = @_;
698 716
… …
835} 853}
836 854
837sub size_request { 855sub size_request {
838 my ($self) = @_; 856 my ($self) = @_;
839 857
840 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 858 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
841 859
842 @$self{qw(child_w child_h)} 860 $w = 10 if $self->{scroll_x};
861 $h = 10 if $self->{scroll_y};
862
863 ($w, $h)
843} 864}
844 865
845sub size_allocate { 866sub size_allocate {
846 my ($self, $w, $h) = @_; 867 my ($self, $w, $h) = @_;
847 868
869 my $child = $self->child;
870
848 $w = $self->{child_w} if $self->{scroll_x} && $self->{child_w}; 871 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
849 $h = $self->{child_h} if $self->{scroll_y} && $self->{child_h}; 872 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
850 873
851 $self->child->configure (0, 0, $w, $h); 874 $self->child->configure (0, 0, $w, $h);
852 $self->update; 875 $self->update;
853} 876}
854 877
… …
997 1020
998our @ISA = CFClient::UI::Bin::; 1021our @ISA = CFClient::UI::Bin::;
999 1022
1000use CFClient::OpenGL; 1023use CFClient::OpenGL;
1001 1024
1002my @tex = 1025my $bg =
1026 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1027 mipmap => 1, wrap => 1;
1028
1029my @border =
1003 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1030 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1004 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);
1005 1032
1006sub new { 1033sub new {
1007 my $class = shift; 1034 my $class = shift;
1008
1009 # TODO: user_x, user_y, overwrite moveto?
1010 1035
1011 my $self = $class->SUPER::new ( 1036 my $self = $class->SUPER::new (
1012 bg => [1, 1, 1, 1], 1037 bg => [1, 1, 1, 1],
1013 border_bg => [1, 1, 1, 1], 1038 border_bg => [1, 1, 1, 1],
1014 border => 0.6, 1039 border => 0.6,
1015 is_toplevel => 1,
1016 can_events => 1, 1040 can_events => 1,
1041 min_w => 16,
1042 min_h => 16,
1017 @_ 1043 @_
1018 ); 1044 );
1019 1045
1020 $self->{title} &&= new CFClient::UI::Label 1046 $self->{title} &&= new CFClient::UI::Label
1021 align => 0, 1047 align => 0,
… …
1074 my ($ev, $x, $y) = @_; 1100 my ($ev, $x, $y) = @_;
1075 1101
1076 my $dx = $ev->{x} - $ox; 1102 my $dx = $ev->{x} - $ox;
1077 my $dy = $ev->{y} - $oy; 1103 my $dy = $ev->{y} - $oy;
1078 1104
1079 $self->{user_x} = $wx + $dx * $mx;
1080 $self->{user_y} = $wy + $dy * $my;
1081 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1105 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1082 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1106 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1083 $self->move ($self->{user_x}, $self->{user_y}); 1107
1084 $self->check_size; 1108 $self->realloc;
1109 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1085 }; 1110 };
1086 1111
1087 } elsif ($lr ^ $td) { 1112 } elsif ($lr ^ $td) {
1088 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1113 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1089 my ($bx, $by) = ($self->{x}, $self->{y}); 1114 my ($bx, $by) = ($self->{x}, $self->{y});
… …
1091 $self->{motion} = sub { 1116 $self->{motion} = sub {
1092 my ($ev, $x, $y) = @_; 1117 my ($ev, $x, $y) = @_;
1093 1118
1094 ($x, $y) = ($ev->{x}, $ev->{y}); 1119 ($x, $y) = ($ev->{x}, $ev->{y});
1095 1120
1096 $self->{user_x} = $bx + $x - $ox; 1121 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1097 $self->{user_y} = $by + $y - $oy;
1098 $self->move ($self->{user_x}, $self->{user_y});
1099 $self->update;
1100 }; 1122 };
1101 } 1123 }
1102} 1124}
1103 1125
1104sub button_up { 1126sub button_up {
… …
1123 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1145 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1124 1146
1125 my $border = $self->border; 1147 my $border = $self->border;
1126 1148
1127 glColor @{ $self->{border_bg} }; 1149 glColor @{ $self->{border_bg} };
1128 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1150 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1129 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1151 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1130 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1152 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1131 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1153 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1132 1154
1133 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1155 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1134 my $bg = $tex[0]; 1156 glColor @{ $self->{bg} };
1135 1157
1136 # TODO: repeat texture not scale 1158 # TODO: repeat texture not scale
1159 # solve this better(?)
1137 my $rep_x = $cw / $bg->{w}; 1160 $bg->{s} = $cw / $bg->{w};
1138 my $rep_y = $ch / $bg->{h}; 1161 $bg->{t} = $ch / $bg->{h};
1139
1140 glColor @{ $self->{bg} };
1141
1142 $bg->{s} = $rep_x;
1143 $bg->{t} = $rep_y;
1144 $bg->{wrap_mode} = 1;
1145 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1162 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1146 } 1163 }
1147 1164
1148 glDisable GL_TEXTURE_2D; 1165 glDisable GL_TEXTURE_2D;
1149 1166
… …
1179 my ($self, $x, $y, $child) = @_; 1196 my ($self, $x, $y, $child) = @_;
1180 1197
1181 $child->set_parent ($self); 1198 $child->set_parent ($self);
1182 $self->{children}[$y][$x] = $child; 1199 $self->{children}[$y][$x] = $child;
1183 1200
1184 $self->check_size (1); 1201 $self->realloc;
1185} 1202}
1186 1203
1187# 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?
1188sub clear { 1205sub clear {
1189 my ($self) = @_; 1206 my ($self) = @_;
… …
1194 for (@children) { 1211 for (@children) {
1195 delete $_->{parent}; 1212 delete $_->{parent};
1196 $_->hide; 1213 $_->hide;
1197 } 1214 }
1198 1215
1199 $self->check_size (1); 1216 $self->realloc;
1200 $self->update;
1201} 1217}
1202 1218
1203sub get_wh { 1219sub get_wh {
1204 my ($self) = @_; 1220 my ($self) = @_;
1205 1221
… …
1301 } 1317 }
1302} 1318}
1303 1319
1304############################################################################# 1320#############################################################################
1305 1321
1306package CFClient::UI::HBox; 1322package CFClient::UI::Box;
1307
1308# TODO: wrap into common Box base class
1309 1323
1310our @ISA = CFClient::UI::Container::; 1324our @ISA = CFClient::UI::Container::;
1311 1325
1312sub size_request { 1326sub size_request {
1313 my ($self) = @_; 1327 my ($self) = @_;
1314 1328
1315 my @alloc = map [$_->size_request], @{$self->{children}}; 1329 $self->{vertical}
1316 1330 ? (
1317 ( 1331 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1318 (List::Util::sum map $_->[0], @alloc), 1332 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1319 (List::Util::max map $_->[1], @alloc), 1333 )
1320 ) 1334 : (
1335 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1336 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1337 )
1321} 1338}
1322 1339
1323sub size_allocate { 1340sub size_allocate {
1324 my ($self, $w, $h) = @_; 1341 my ($self, $w, $h) = @_;
1325 1342
1326 ($h, $w) = ($w, $h); 1343 my $space = $self->{vertical} ? $h : $w;
1327
1328 my $children = $self->{children}; 1344 my $children = $self->{children};
1329 1345
1330 my @h = map $_->{req_w}, @$children; 1346 my @req;
1331 1347
1332 my $req_h = List::Util::sum @h; 1348 if ($self->{homogeneous}) {
1333 1349 @req = ($space / (@$children || 1)) x @$children;
1334 if ($req_h > $h) {
1335 # ah well, not enough space
1336 $_ *= $h / $req_h for @h;
1337 } 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 {
1338 my $exp = List::Util::sum map $_->{expand}, @$children; 1358 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1339 $exp ||= 1;
1340 1359
1360 $space = ($space - $req) / $expand; # remaining space to give away
1361
1362 $req[$_] += $space * $children->[$_]{expand}
1341 for (0 .. $#$children) { 1363 for 0 .. $#$children;
1342 my $child = $children->[$_];
1343
1344 my $alloc_h = $h[$_];
1345 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1346 $h[$_] = $alloc_h;
1347 } 1364 }
1348 } 1365 }
1349 1366
1350 CFClient::UI::harmonize \@h; 1367 CFClient::UI::harmonize \@req;
1351 1368
1352 my $y = 0; 1369 my $pos = 0;
1353 for (0 .. $#$children) { 1370 for (0 .. $#$children) {
1354 my $child = $children->[$_];
1355 my $h = $h[$_]; 1371 my $alloc = $req[$_];
1356 $child->configure ($y, 0, $h, $w); 1372 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1357 1373
1358 $y += $h; 1374 $pos += $alloc;
1359 } 1375 }
1360 1376
1361 1 1377 1
1362} 1378}
1363 1379
1364############################################################################# 1380#############################################################################
1365 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
1366package CFClient::UI::VBox; 1397package CFClient::UI::VBox;
1367 1398
1368# TODO: wrap into common Box base class
1369
1370our @ISA = CFClient::UI::Container::; 1399our @ISA = CFClient::UI::Box::;
1371 1400
1372sub size_request { 1401sub new {
1373 my ($self) = @_; 1402 my $class = shift;
1374 1403
1375 my @alloc = map [$_->size_request], @{$self->{children}}; 1404 $class->SUPER::new (
1376 1405 vertical => 1,
1377 ( 1406 @_,
1378 (List::Util::max map $_->[0], @alloc),
1379 (List::Util::sum map $_->[1], @alloc),
1380 ) 1407 )
1381}
1382
1383sub size_allocate {
1384 my ($self, $w, $h) = @_;
1385
1386 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1387
1388 my $children = $self->{children};
1389
1390 my @h = map $_->{req_h}, @$children;
1391
1392 my $req_h = List::Util::sum @h;
1393
1394 if ($req_h > $h) {
1395 # ah well, not enough space
1396 $_ *= $h / $req_h for @h;
1397 } else {
1398 my $exp = List::Util::sum map $_->{expand}, @$children;
1399 $exp ||= 1;
1400
1401 for (0 .. $#$children) {
1402 my $child = $children->[$_];
1403
1404 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1405 }
1406 }
1407
1408 CFClient::UI::harmonize \@h;
1409
1410 my $y = 0;
1411 for (0 .. $#$children) {
1412 my $child = $children->[$_];
1413 my $h = $h[$_];
1414 $child->configure (0, $y, $w, $h);
1415
1416 $y += $h;
1417 }
1418
1419 1
1420} 1408}
1421 1409
1422############################################################################# 1410#############################################################################
1423 1411
1424package CFClient::UI::Label; 1412package CFClient::UI::Label;
… …
1441 ellipsise => 3, # end 1429 ellipsise => 3, # end
1442 layout => (new CFClient::Layout), 1430 layout => (new CFClient::Layout),
1443 fontsize => 1, 1431 fontsize => 1,
1444 align => -1, 1432 align => -1,
1445 valign => -1, 1433 valign => -1,
1446 padding => 2, 1434 padding_x => 2,
1435 padding_y => 2,
1447 can_events => 0, 1436 can_events => 0,
1448 %arg 1437 %arg
1449 ); 1438 );
1450 1439
1451 if (exists $self->{template}) { 1440 if (exists $self->{template}) {
… …
1487 $self->{text} = "T$text"; 1476 $self->{text} = "T$text";
1488 1477
1489 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1478 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1490 $self->{layout}->set_text ($text); 1479 $self->{layout}->set_text ($text);
1491 1480
1481 $self->realloc;
1492 $self->update; 1482 $self->update;
1493 $self->check_size;
1494} 1483}
1495 1484
1496sub set_markup { 1485sub set_markup {
1497 my ($self, $markup) = @_; 1486 my ($self, $markup) = @_;
1498 1487
… …
1502 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1491 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1503 1492
1504 $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;
1505 $self->{layout}->set_markup ($markup); 1494 $self->{layout}->set_markup ($markup);
1506 1495
1496 $self->realloc;
1507 $self->update; 1497 $self->update;
1508 $self->check_size;
1509} 1498}
1510 1499
1511sub size_request { 1500sub size_request {
1512 my ($self) = @_; 1501 my ($self) = @_;
1513 1502
… …
1527 1516
1528 $w = List::Util::max $w, $w2; 1517 $w = List::Util::max $w, $w2;
1529 $h = List::Util::max $h, $h2; 1518 $h = List::Util::max $h, $h2;
1530 } 1519 }
1531 1520
1532 ( 1521 ($w, $h)
1533 $w + $self->{padding} * 2,
1534 $h + $self->{padding} * 2,
1535 )
1536} 1522}
1537 1523
1538sub size_allocate { 1524sub size_allocate {
1539 my ($self, $w, $h) = @_; 1525 my ($self, $w, $h) = @_;
1540 1526
… …
1545 my ($self, $fontsize) = @_; 1531 my ($self, $fontsize) = @_;
1546 1532
1547 $self->{fontsize} = $fontsize; 1533 $self->{fontsize} = $fontsize;
1548 delete $self->{texture}; 1534 delete $self->{texture};
1549 1535
1550 $self->update; 1536 $self->realloc;
1551 $self->check_size;
1552} 1537}
1553 1538
1554sub _draw { 1539sub _draw {
1555 my ($self) = @_; 1540 my ($self) = @_;
1556 1541
… …
1564 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1549 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1565 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1550 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1566 1551
1567 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1552 my $tex = new_from_layout CFClient::Texture $self->{layout};
1568 1553
1569 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1554 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1570 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1555 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1571 : ($self->{w} - $tex->{w}) * 0.5); 1556 : ($self->{w} - $tex->{w}) * 0.5);
1572 1557
1573 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1558 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1574 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1559 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1575 : ($self->{h} - $tex->{h}) * 0.5); 1560 : ($self->{h} - $tex->{h}) * 0.5);
1576 1561
1577 $tex 1562 $tex
1578 }; 1563 };
1579 1564
… …
1636sub set_text { 1621sub set_text {
1637 my ($self, $text) = @_; 1622 my ($self, $text) = @_;
1638 1623
1639 $self->{cursor} = length $text; 1624 $self->{cursor} = length $text;
1640 $self->_set_text ($text); 1625 $self->_set_text ($text);
1641 $self->update; 1626
1642 $self->check_size; 1627 $self->realloc;
1643} 1628}
1644 1629
1645sub get_text { 1630sub get_text {
1646 $_[0]{text} 1631 $_[0]{text}
1647} 1632}
… …
1680 } elsif ($uni) { 1665 } elsif ($uni) {
1681 substr $text, $self->{cursor}++, 0, chr $uni; 1666 substr $text, $self->{cursor}++, 0, chr $uni;
1682 } 1667 }
1683 1668
1684 $self->_set_text ($text); 1669 $self->_set_text ($text);
1685 $self->update; 1670
1686 $self->check_size; 1671 $self->realloc;
1687} 1672}
1688 1673
1689sub focus_in { 1674sub focus_in {
1690 my ($self) = @_; 1675 my ($self) = @_;
1691 1676
… …
1818 1803
1819sub new { 1804sub new {
1820 my $class = shift; 1805 my $class = shift;
1821 1806
1822 $class->SUPER::new ( 1807 $class->SUPER::new (
1823 padding => 4, 1808 padding_x => 4,
1809 padding_y => 4,
1824 fg => [1, 1, 1], 1810 fg => [1, 1, 1],
1825 active_fg => [0, 0, 1], 1811 active_fg => [0, 0, 1],
1826 can_hover => 1, 1812 can_hover => 1,
1827 align => 0, 1813 align => 0,
1828 valign => 0, 1814 valign => 0,
… …
1875 1861
1876sub new { 1862sub new {
1877 my $class = shift; 1863 my $class = shift;
1878 1864
1879 $class->SUPER::new ( 1865 $class->SUPER::new (
1880 padding => 2, 1866 padding_x => 2,
1867 padding_y => 2,
1881 fg => [1, 1, 1], 1868 fg => [1, 1, 1],
1882 active_fg => [1, 1, 0], 1869 active_fg => [1, 1, 0],
1883 bg => [0, 0, 0, 0.2], 1870 bg => [0, 0, 0, 0.2],
1884 active_bg => [1, 1, 1, 0.5], 1871 active_bg => [1, 1, 1, 0.5],
1885 state => 0, 1872 state => 0,
… …
1889} 1876}
1890 1877
1891sub size_request { 1878sub size_request {
1892 my ($self) = @_; 1879 my ($self) = @_;
1893 1880
1894 ($self->{padding} * 2 + 6) x 2 1881 (6) x 2
1895} 1882}
1896 1883
1897sub button_down { 1884sub button_down {
1898 my ($self, $ev, $x, $y) = @_; 1885 my ($self, $ev, $x, $y) = @_;
1899 1886
1900 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1887 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1901 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1888 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1902 $self->{state} = !$self->{state}; 1889 $self->{state} = !$self->{state};
1903 $self->_emit (changed => $self->{state}); 1890 $self->_emit (changed => $self->{state});
1904 } 1891 }
1905} 1892}
1906 1893
1907sub _draw { 1894sub _draw {
1908 my ($self) = @_; 1895 my ($self) = @_;
1909 1896
1910 $self->SUPER::_draw; 1897 $self->SUPER::_draw;
1911 1898
1912 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1899 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1913 1900
1914 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1901 my ($w, $h) = @$self{qw(w h)};
1902
1903 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1915 1904
1916 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1905 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1917 1906
1918 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1907 my $tex = $self->{state} ? $tex[1] : $tex[0];
1919 1908
… …
2184 fg => [1, 1, 1], 2173 fg => [1, 1, 1],
2185 active_fg => [0, 0, 0], 2174 active_fg => [0, 0, 0],
2186 bg => [0, 0, 0, 0.2], 2175 bg => [0, 0, 0, 0.2],
2187 active_bg => [1, 1, 1, 0.5], 2176 active_bg => [1, 1, 1, 0.5],
2188 range => [0, 0, 100, 10, 0], 2177 range => [0, 0, 100, 10, 0],
2189 req_w => $::WIDTH / 80, 2178 min_w => $::WIDTH / 80,
2190 req_h => $::WIDTH / 80, 2179 min_h => $::WIDTH / 80,
2191 vertical => 0, 2180 vertical => 0,
2192 can_hover => 1, 2181 can_hover => 1,
2193 inner_pad => 0.02, 2182 inner_pad => 0.02,
2194 @_ 2183 @_
2195 ); 2184 );
… …
2198 $self->update; 2187 $self->update;
2199 2188
2200 $self 2189 $self
2201} 2190}
2202 2191
2192sub changed { }
2193
2203sub set_range { 2194sub set_range {
2204 my ($self, $range) = @_; 2195 my ($self, $range) = @_;
2205 2196
2206 ($range, $self->{range}) = ($self->{range}, $range); 2197 ($range, $self->{range}) = ($self->{range}, $range);
2207 2198
… …
2233} 2224}
2234 2225
2235sub size_request { 2226sub size_request {
2236 my ($self) = @_; 2227 my ($self) = @_;
2237 2228
2238 my $w = $self->{req_w}; 2229 ($self->{req_w}, $self->{req_h})
2239 my $h = $self->{req_h};
2240
2241 $self->{vertical} ? ($h, $w) : ($w, $h)
2242} 2230}
2243 2231
2244sub button_down { 2232sub button_down {
2245 my ($self, $ev, $x, $y) = @_; 2233 my ($self, $ev, $x, $y) = @_;
2246 2234
… …
2631} 2619}
2632 2620
2633sub set_tooltip_from { 2621sub set_tooltip_from {
2634 my ($self, $widget) = @_; 2622 my ($self, $widget) = @_;
2635 2623
2624 my $tooltip = $widget->{tooltip};
2625
2626 if ($ENV{CFPLUS_DEBUG} & 2) {
2627 $tooltip .= "\n\n" . (ref $widget) . "\n"
2628 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2629 . "req $widget->{req_w} $widget->{req_h}\n"
2630 . "visible $widget->{visible}";
2631 }
2632
2636 $self->add (new CFClient::UI::Label 2633 $self->add (new CFClient::UI::Label
2637 markup => $widget->{tooltip}, 2634 markup => $tooltip,
2638 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2635 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2639 fontsize => 0.8, 2636 fontsize => 0.8,
2640 fg => [0, 0, 0, 1], 2637 fg => [0, 0, 0, 1],
2641 ellipsise => 0, 2638 ellipsise => 0,
2642 font => ($widget->{tooltip_font} || $::FONT_PROP), 2639 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2653 2650
2654sub size_allocate { 2651sub size_allocate {
2655 my ($self, $w, $h) = @_; 2652 my ($self, $w, $h) = @_;
2656 2653
2657 $self->SUPER::size_allocate ($w - 4, $h - 4); 2654 $self->SUPER::size_allocate ($w - 4, $h - 4);
2655}
2656
2657sub visibility_change {
2658 my ($self, $visible) = @_;
2659
2660 return unless $visible;
2661
2662 $self->{root}->on_post_alloc ("move_$self" => sub {
2663 my $widget = $self->{owner}
2664 or return;
2665
2666 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2667
2668 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2669 if $x + $self->{w} > $::WIDTH;
2670
2671 $self->move_abs ($x, $y);
2672 });
2658} 2673}
2659 2674
2660sub _draw { 2675sub _draw {
2661 my ($self) = @_; 2676 my ($self) = @_;
2662 2677
… …
2679 glVertex $w, $h; 2694 glVertex $w, $h;
2680 glVertex $w, 0; 2695 glVertex $w, 0;
2681 glEnd; 2696 glEnd;
2682 2697
2683 glTranslate 2 - 0.375, 2 - 0.375; 2698 glTranslate 2 - 0.375, 2 - 0.375;
2699
2684 $self->SUPER::_draw; 2700 $self->SUPER::_draw;
2685} 2701}
2686 2702
2687############################################################################# 2703#############################################################################
2688 2704
… …
2804 2820
2805 $row++; 2821 $row++;
2806 } 2822 }
2807} 2823}
2808 2824
2809sub size_request {
2810 my ($self) = @_;
2811 ($self->{req_w}, $self->{req_h});
2812}
2813
2814############################################################################# 2825#############################################################################
2815 2826
2816package CFClient::UI::Menu; 2827package CFClient::UI::Menu;
2817 2828
2818our @ISA = CFClient::UI::FancyFrame::; 2829our @ISA = CFClient::UI::FancyFrame::;
… …
2858 # maybe save $GRAB? must be careful about events... 2869 # maybe save $GRAB? must be careful about events...
2859 $GRAB = $self; 2870 $GRAB = $self;
2860 $self->{button} = $ev->{button}; 2871 $self->{button} = $ev->{button};
2861 2872
2862 $self->show; 2873 $self->show;
2863 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2874 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2864} 2875}
2865 2876
2866sub mouse_motion { 2877sub mouse_motion {
2867 my ($self, $ev, $x, $y) = @_; 2878 my ($self, $ev, $x, $y) = @_;
2868 2879
… …
3002use CFClient::OpenGL; 3013use CFClient::OpenGL;
3003 3014
3004sub new { 3015sub new {
3005 my $class = shift; 3016 my $class = shift;
3006 3017
3007 $class->SUPER::new ( 3018 my $self = $class->SUPER::new (
3008 visible => 1, 3019 visible => 1,
3009 @_, 3020 @_,
3010 ) 3021 );
3011}
3012 3022
3013sub configure { 3023 Scalar::Util::weaken ($self->{root} = $self);
3014 my ($self, $x, $y, $w, $h) = @_;
3015 3024
3016 $self->{w} = $w; 3025 $self
3017 $self->{h} = $h;
3018}
3019
3020sub check_size {
3021 my ($self) = @_;
3022
3023 $self->size_allocate ($self->{w}, $self->{h})
3024 if $self->{w};
3025} 3026}
3026 3027
3027sub size_request { 3028sub size_request {
3028 my ($self) = @_; 3029 my ($self) = @_;
3029 3030
3030 ($self->{w}, $self->{h}) 3031 ($self->{w}, $self->{h})
3032}
3033
3034sub _to_pixel {
3035 my ($coord, $size, $max) = @_;
3036
3037 $coord =
3038 $coord eq "center" ? ($max - $size) * 0.5
3039 : $coord eq "max" ? $max
3040 : $coord;
3041
3042 $coord = 0 if $coord < 0;
3043 $coord = $max - $size if $coord > $max - $size;
3044
3045 int $coord + 0.5
3031} 3046}
3032 3047
3033sub size_allocate { 3048sub size_allocate {
3034 my ($self, $w, $h) = @_; 3049 my ($self, $w, $h) = @_;
3035 3050
3036 for my $child ($self->children) { 3051 for my $child ($self->children) {
3037 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3052 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3038 3053
3039 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3054 $X = $child->{force_x} if exists $child->{force_x};
3040 if exists $child->{req_x}; 3055 $Y = $child->{force_y} if exists $child->{force_y};
3041 3056
3042 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3057 $X = _to_pixel $X, $W, $self->{w};
3043 if exists $child->{req_y}; 3058 $Y = _to_pixel $Y, $H, $self->{h};
3044
3045 $X = $self->{user_x} if exists $self->{user_x};
3046 $Y = $self->{user_y} if exists $self->{user_y};
3047
3048 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3049 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3050 3059
3051 $child->configure ($X, $Y, $W, $H); 3060 $child->configure ($X, $Y, $W, $H);
3052 } 3061 }
3053} 3062}
3054 3063
… …
3065} 3074}
3066 3075
3067sub update { 3076sub update {
3068 my ($self) = @_; 3077 my ($self) = @_;
3069 3078
3070 $self->check_size;
3071 $::WANT_REFRESH++; 3079 $::WANT_REFRESH++;
3072} 3080}
3073 3081
3074sub add { 3082sub add {
3075 my ($self, @children) = @_; 3083 my ($self, @children) = @_;
3076 3084
3077 for (my @widgets = @children; my $w = pop @widgets; ) {
3078 push @widgets, $w->children;
3079 $w->{root} = $self;
3080 $w->{visible} = $self->{visible} + 1;
3081 }
3082
3083 for my $child (@children) {
3084 $child->{is_toplevel} = 1; 3085 $_->{is_toplevel} = 1
3085 3086 for @children;
3086 # integerise window positions
3087 $child->{x} = int $child->{x};
3088 $child->{y} = int $child->{y};
3089 }
3090 3087
3091 $self->SUPER::add (@children); 3088 $self->SUPER::add (@children);
3092} 3089}
3093 3090
3094sub remove { 3091sub remove {
3095 my ($self, @children) = @_; 3092 my ($self, @children) = @_;
3096 3093
3097 $self->SUPER::remove (@children); 3094 $self->SUPER::remove (@children);
3095
3096 delete $self->{is_toplevel}
3097 for @children;
3098 3098
3099 while (@children) { 3099 while (@children) {
3100 my $w = pop @children; 3100 my $w = pop @children;
3101 push @children, $w->children; 3101 push @children, $w->children;
3102 $w->set_invisible; 3102 $w->set_invisible;
… …
3121 while ($self->{refresh_hook}) { 3121 while ($self->{refresh_hook}) {
3122 $_->() 3122 $_->()
3123 for values %{delete $self->{refresh_hook}}; 3123 for values %{delete $self->{refresh_hook}};
3124 } 3124 }
3125 3125
3126 if ($self->{check_size}) { 3126 if ($self->{realloc}) {
3127 my @queue; 3127 my @queue;
3128 3128
3129 for (;;) { 3129 while () {
3130 if ($self->{check_size}) { 3130 if ($self->{realloc}) {
3131 #TODO use array-of-depth approach 3131 #TODO use array-of-depth approach
3132 3132
3133 use sort 'stable';
3134
3133 @queue = sort { $a->{visible} <=> $b->{visible} } 3135 @queue = sort { $a->{visible} <=> $b->{visible} }
3134 @queue, values %{delete $self->{check_size}}; 3136 @queue, values %{delete $self->{realloc}};
3135 } 3137 }
3136 3138
3137 my $widget = pop @queue || last; 3139 my $widget = pop @queue || last;
3138 3140
3139 defined $widget->{visible} or last; # do not resize invisible widgets 3141 $widget->{visible} or last; # do not resize invisible widgets
3140 3142
3141 my ($w, $h) = $widget->{user_w} && $widget->{user_h}
3142 ? @$widget{qw(user_w user_h)}
3143 : $widget->size_request; 3143 my ($w, $h) = $widget->size_request;
3144 3144
3145 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3146 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3147
3148 $w = $widget->{force_w} if exists $widget->{force_w};
3149 $h = $widget->{force_h} if exists $widget->{force_h};
3150
3151 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3145 if (delete $widget->{force_alloc} 3152 || delete $widget->{force_realloc}) {
3146 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3147 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3148
3149 $widget->{req_w} = $w; 3153 $widget->{req_w} = $w;
3150 $widget->{req_h} = $h; 3154 $widget->{req_h} = $h;
3151 3155
3152 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3156 $self->{size_alloc}{$widget+0} = $widget;
3153 3157
3154 $widget->{parent}->check_size
3155 if $widget->{parent}; 3158 if (my $parent = $widget->{parent}) {
3159 $self->{realloc}{$parent+0} = $parent;
3160 #unshift @queue, $parent;
3161 $parent->{force_size_alloc} = 1;
3162 $self->{size_alloc}{$parent+0} = $parent;
3163 }
3156 } 3164 }
3165
3166 delete $self->{realloc}{$widget+0};
3157 } 3167 }
3158 } 3168 }
3159 3169
3160 while ($self->{size_alloc}) { 3170 while (my $size_alloc = delete $self->{size_alloc}) {
3161 for (values %{delete $self->{size_alloc}}) { 3171 my @queue = sort { $b->{visible} <=> $a->{visible} }
3162 my ($widget, $w, $h) = @$_; 3172 values %$size_alloc;
3173
3174 while () {
3175 my $widget = pop @queue || last;
3176
3177 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3163 3178
3164 $w = 0 if $w < 0; 3179 $w = 0 if $w < 0;
3165 $h = 0 if $h < 0; 3180 $h = 0 if $h < 0;
3166 3181
3182 $w = int $w + 0.5;
3183 $h = int $h + 0.5;
3184
3185 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3167 $widget->{w} = $w; 3186 $widget->{w} = $w;
3168 $widget->{h} = $h; 3187 $widget->{h} = $h;
3188
3169 $widget->emit (size_allocate => $w, $h); 3189 $widget->emit (size_allocate => $w, $h);
3190 }
3170 } 3191 }
3171 } 3192 }
3172 3193
3173 while ($self->{post_alloc_hook}) { 3194 while ($self->{post_alloc_hook}) {
3174 $_->() 3195 $_->()
3175 for values %{delete $self->{post_alloc_hook}}; 3196 for values %{delete $self->{post_alloc_hook}};
3176 } 3197 }
3198
3177 3199
3178 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3200 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3179 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3201 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3180 glClear GL_COLOR_BUFFER_BIT; 3202 glClear GL_COLOR_BUFFER_BIT;
3181 3203
… …
3188 $self->_draw; 3210 $self->_draw;
3189} 3211}
3190 3212
3191############################################################################# 3213#############################################################################
3192 3214
3215package CFClient::UI::BindEditor;
3216
3217our @ISA = CFClient::UI::FancyFrame::;
3218
3219sub new {
3220 my $class = shift;
3221
3222 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3223
3224 $self->add (my $vb = new CFClient::UI::VBox);
3225
3226
3227 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3228 text => "start recording",
3229 tooltip => "Start/Stops recording of actions."
3230 ."All subsequent actions after the recording started will be captured."
3231 ."The actions are displayed after the record was stopped."
3232 ."To bind the action you have to click on the 'Bind' button",
3233 on_activate => sub {
3234 unless ($self->{recording}) {
3235 $self->start;
3236 } else {
3237 $self->stop;
3238 }
3239 });
3240
3241 $vb->add (new CFClient::UI::Label text => "Actions:");
3242 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3243
3244 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3245 $vb->add (my $hb = new CFClient::UI::HBox);
3246 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3247 $hb->add (new CFClient::UI::Button
3248 text => "bind",
3249 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3250 on_activate => sub {
3251 $self->ask_for_bind;
3252 });
3253
3254 $vb->add (my $hb = new CFClient::UI::HBox);
3255 $hb->add (new CFClient::UI::Button
3256 text => "ok",
3257 expand => 1,
3258 tooltip => "This closes the binding editor and saves the binding",
3259 on_activate => sub {
3260 $self->hide;
3261 $self->commit;
3262 });
3263
3264 $hb->add (new CFClient::UI::Button
3265 text => "cancel",
3266 expand => 1,
3267 tooltip => "This closes the binding editor without saving",
3268 on_activate => sub {
3269 $self->hide;
3270 $self->{binding_cancel}->()
3271 if $self->{binding_cancel};
3272 });
3273
3274 $self->update_binding_widgets;
3275
3276 $self
3277}
3278
3279sub commit {
3280 my ($self) = @_;
3281 my ($mod, $sym, $cmds) = $self->get_binding;
3282 if ($sym != 0 && @$cmds > 0) {
3283 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3284 ."'. Don't forget 'Save Config'!");
3285 $self->{binding_change}->($mod, $sym, $cmds)
3286 if $self->{binding_change};
3287 } else {
3288 $::STATUSBOX->add ("No action bound, no key or action specified!");
3289 $self->{binding_cancel}->()
3290 if $self->{binding_cancel};
3291 }
3292}
3293
3294sub start {
3295 my ($self) = @_;
3296
3297 $self->{rec_btn}->set_text ("stop recording");
3298 $self->{recording} = 1;
3299 $self->clear_command_list;
3300 $::CONN->start_record if $::CONN;
3301}
3302
3303sub stop {
3304 my ($self) = @_;
3305
3306 $self->{rec_btn}->set_text ("start recording");
3307 $self->{recording} = 0;
3308
3309 my $rec;
3310 $rec = $::CONN->stop_record if $::CONN;
3311 return unless ref $rec eq 'ARRAY';
3312 $self->set_command_list ($rec);
3313}
3314
3315# if $commit is true, the binding will be set after the user entered a key combo
3316sub ask_for_bind {
3317 my ($self, $commit) = @_;
3318
3319 CFClient::Binder::open_binding_dialog (sub {
3320 my ($mod, $sym) = @_;
3321 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3322 $self->update_binding_widgets;
3323 $self->commit if $commit;
3324 });
3325}
3326
3327# $mod and $sym are the modifiers and key symbol
3328# $cmds is a array ref of strings (the commands)
3329# $cb is the callback that is executed on OK
3330# $ccb is the callback that is executed on CANCEL and
3331# when the binding was unsuccessful on OK
3332sub set_binding {
3333 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3334
3335 $self->clear_command_list;
3336 $self->{recording} = 0;
3337 $self->{rec_btn}->set_text ("start recording");
3338
3339 $self->{binding} = [$mod, $sym];
3340 $self->{commands} = $cmds;
3341
3342 $self->{binding_change} = $cb;
3343 $self->{binding_cancel} = $ccb;
3344
3345 $self->update_binding_widgets;
3346}
3347
3348# this is a shortcut method that asks for a binding
3349# and then just binds it.
3350sub do_quick_binding {
3351 my ($self, $cmds) = @_;
3352 $self->set_binding (undef, undef, $cmds, sub {
3353 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3354 });
3355 $self->ask_for_bind (1);
3356}
3357
3358sub update_binding_widgets {
3359 my ($self) = @_;
3360 my ($mod, $sym, $cmds) = $self->get_binding;
3361 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3362 $self->set_command_list ($cmds);
3363}
3364
3365sub get_binding {
3366 my ($self) = @_;
3367 return (
3368 $self->{binding}->[0],
3369 $self->{binding}->[1],
3370 [ grep { defined $_ } @{$self->{commands}} ]
3371 );
3372}
3373
3374sub clear_command_list {
3375 my ($self) = @_;
3376 $self->{cmdbox}->clear ();
3377}
3378
3379sub set_command_list {
3380 my ($self, $cmds) = @_;
3381
3382 $self->{cmdbox}->clear ();
3383 $self->{commands} = $cmds;
3384
3385 my $idx = 0;
3386
3387 for (@$cmds) {
3388 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3389
3390 my $i = $idx;
3391 $hb->add (new CFClient::UI::Button
3392 text => "delete",
3393 tooltip => "Deletes the action from the record",
3394 on_activate => sub {
3395 $self->{cmdbox}->remove ($hb);
3396 $cmds->[$i] = undef;
3397 });
3398
3399 $hb->add (new CFClient::UI::Label text => $_);
3400
3401 $idx++
3402 }
3403}
3404
3405
3406#############################################################################
3407
3408package CFClient::UI::SpellList;
3409
3410our @ISA = CFClient::UI::FancyFrame::;
3411
3412sub new {
3413 my $class = shift;
3414
3415 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3416
3417 $self->add (new CFClient::UI::ScrolledWindow
3418 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3419
3420 $self;
3421}
3422
3423# XXX: Do sorting? Argl...
3424sub add_spell {
3425 my ($self, $spell) = @_;
3426 $self->{spells}->{$spell->{name}} = $spell;
3427
3428 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3429 face => $spell->{face},
3430 can_hover => 1,
3431 can_events => 1,
3432 tooltip => $spell->{message});
3433
3434 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3435 text => $spell->{name},
3436 can_hover => 1,
3437 can_events => 1,
3438 tooltip => $spell->{message},
3439 expand => 1);
3440 $self->{spellbox}->add (2, $self->{tbl_idx}++, new CFClient::UI::Button
3441 text => "bind to key",
3442 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3443}
3444
3445sub rebuild_spell_list {
3446 my ($self) = @_;
3447 $self->{tbl_idx} = 0;
3448 $self->add_spell ($_) for values %{$self->{spells}};
3449}
3450
3451sub remove_spell {
3452 my ($self, $spell) = @_;
3453 delete $self->{spells}->{$spell->{name}};
3454 $self->rebuild_spell_list;
3455}
3456
3457#############################################################################
3458
3193package CFClient::UI; 3459package CFClient::UI;
3194 3460
3195$ROOT = new CFClient::UI::Root; 3461$ROOT = new CFClient::UI::Root;
3196$TOOLTIP = new CFClient::UI::Tooltip z => 900; 3462$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3197 3463

Diff Legend

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