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.265 by root, Thu Jun 1 02:59:46 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
1541 delete $self->{texture}; 1527 delete $self->{texture}
1528 ;#d#
1542} 1529}
1543 1530
1544sub set_fontsize { 1531sub set_fontsize {
1545 my ($self, $fontsize) = @_; 1532 my ($self, $fontsize) = @_;
1546 1533
1547 $self->{fontsize} = $fontsize; 1534 $self->{fontsize} = $fontsize;
1548 delete $self->{texture}; 1535 delete $self->{texture};
1549 1536
1550 $self->update; 1537 $self->realloc;
1551 $self->check_size;
1552} 1538}
1553 1539
1554sub _draw { 1540sub _draw {
1555 my ($self) = @_; 1541 my ($self) = @_;
1556 1542
… …
1564 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1550 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1565 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1551 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1566 1552
1567 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1553 my $tex = new_from_layout CFClient::Texture $self->{layout};
1568 1554
1569 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1555 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1570 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1556 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1571 : ($self->{w} - $tex->{w}) * 0.5); 1557 : ($self->{w} - $tex->{w}) * 0.5);
1572 1558
1573 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1559 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1574 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1560 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1575 : ($self->{h} - $tex->{h}) * 0.5); 1561 : ($self->{h} - $tex->{h}) * 0.5);
1576 1562
1577 $tex 1563 $tex
1578 }; 1564 };
1579 1565
… …
1636sub set_text { 1622sub set_text {
1637 my ($self, $text) = @_; 1623 my ($self, $text) = @_;
1638 1624
1639 $self->{cursor} = length $text; 1625 $self->{cursor} = length $text;
1640 $self->_set_text ($text); 1626 $self->_set_text ($text);
1641 $self->update; 1627
1642 $self->check_size; 1628 $self->realloc;
1643} 1629}
1644 1630
1645sub get_text { 1631sub get_text {
1646 $_[0]{text} 1632 $_[0]{text}
1647} 1633}
… …
1680 } elsif ($uni) { 1666 } elsif ($uni) {
1681 substr $text, $self->{cursor}++, 0, chr $uni; 1667 substr $text, $self->{cursor}++, 0, chr $uni;
1682 } 1668 }
1683 1669
1684 $self->_set_text ($text); 1670 $self->_set_text ($text);
1685 $self->update; 1671
1686 $self->check_size; 1672 $self->realloc;
1687} 1673}
1688 1674
1689sub focus_in { 1675sub focus_in {
1690 my ($self) = @_; 1676 my ($self) = @_;
1691 1677
… …
1818 1804
1819sub new { 1805sub new {
1820 my $class = shift; 1806 my $class = shift;
1821 1807
1822 $class->SUPER::new ( 1808 $class->SUPER::new (
1823 padding => 4, 1809 padding_x => 4,
1810 padding_y => 4,
1824 fg => [1, 1, 1], 1811 fg => [1, 1, 1],
1825 active_fg => [0, 0, 1], 1812 active_fg => [0, 0, 1],
1826 can_hover => 1, 1813 can_hover => 1,
1827 align => 0, 1814 align => 0,
1828 valign => 0, 1815 valign => 0,
… …
1875 1862
1876sub new { 1863sub new {
1877 my $class = shift; 1864 my $class = shift;
1878 1865
1879 $class->SUPER::new ( 1866 $class->SUPER::new (
1880 padding => 2, 1867 padding_x => 2,
1868 padding_y => 2,
1881 fg => [1, 1, 1], 1869 fg => [1, 1, 1],
1882 active_fg => [1, 1, 0], 1870 active_fg => [1, 1, 0],
1883 bg => [0, 0, 0, 0.2], 1871 bg => [0, 0, 0, 0.2],
1884 active_bg => [1, 1, 1, 0.5], 1872 active_bg => [1, 1, 1, 0.5],
1885 state => 0, 1873 state => 0,
… …
1889} 1877}
1890 1878
1891sub size_request { 1879sub size_request {
1892 my ($self) = @_; 1880 my ($self) = @_;
1893 1881
1894 ($self->{padding} * 2 + 6) x 2 1882 (6) x 2
1895} 1883}
1896 1884
1897sub button_down { 1885sub button_down {
1898 my ($self, $ev, $x, $y) = @_; 1886 my ($self, $ev, $x, $y) = @_;
1899 1887
1900 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1888 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1901 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1889 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1902 $self->{state} = !$self->{state}; 1890 $self->{state} = !$self->{state};
1903 $self->_emit (changed => $self->{state}); 1891 $self->_emit (changed => $self->{state});
1904 } 1892 }
1905} 1893}
1906 1894
1907sub _draw { 1895sub _draw {
1908 my ($self) = @_; 1896 my ($self) = @_;
1909 1897
1910 $self->SUPER::_draw; 1898 $self->SUPER::_draw;
1911 1899
1912 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1900 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1913 1901
1914 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1902 my ($w, $h) = @$self{qw(w h)};
1903
1904 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1915 1905
1916 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1906 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1917 1907
1918 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1908 my $tex = $self->{state} ? $tex[1] : $tex[0];
1919 1909
… …
2184 fg => [1, 1, 1], 2174 fg => [1, 1, 1],
2185 active_fg => [0, 0, 0], 2175 active_fg => [0, 0, 0],
2186 bg => [0, 0, 0, 0.2], 2176 bg => [0, 0, 0, 0.2],
2187 active_bg => [1, 1, 1, 0.5], 2177 active_bg => [1, 1, 1, 0.5],
2188 range => [0, 0, 100, 10, 0], 2178 range => [0, 0, 100, 10, 0],
2189 req_w => $::WIDTH / 80, 2179 min_w => $::WIDTH / 80,
2190 req_h => $::WIDTH / 80, 2180 min_h => $::WIDTH / 80,
2191 vertical => 0, 2181 vertical => 0,
2192 can_hover => 1, 2182 can_hover => 1,
2193 inner_pad => 0.02, 2183 inner_pad => 0.02,
2194 @_ 2184 @_
2195 ); 2185 );
… …
2198 $self->update; 2188 $self->update;
2199 2189
2200 $self 2190 $self
2201} 2191}
2202 2192
2193sub changed { }
2194
2203sub set_range { 2195sub set_range {
2204 my ($self, $range) = @_; 2196 my ($self, $range) = @_;
2205 2197
2206 ($range, $self->{range}) = ($self->{range}, $range); 2198 ($range, $self->{range}) = ($self->{range}, $range);
2207 2199
… …
2233} 2225}
2234 2226
2235sub size_request { 2227sub size_request {
2236 my ($self) = @_; 2228 my ($self) = @_;
2237 2229
2238 my $w = $self->{req_w}; 2230 ($self->{req_w}, $self->{req_h})
2239 my $h = $self->{req_h};
2240
2241 $self->{vertical} ? ($h, $w) : ($w, $h)
2242} 2231}
2243 2232
2244sub button_down { 2233sub button_down {
2245 my ($self, $ev, $x, $y) = @_; 2234 my ($self, $ev, $x, $y) = @_;
2246 2235
… …
2631} 2620}
2632 2621
2633sub set_tooltip_from { 2622sub set_tooltip_from {
2634 my ($self, $widget) = @_; 2623 my ($self, $widget) = @_;
2635 2624
2625 my $tooltip = $widget->{tooltip};
2626
2627 if ($ENV{CFPLUS_DEBUG} & 2) {
2628 $tooltip .= "\n\n" . (ref $widget) . "\n"
2629 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2630 . "req $widget->{req_w} $widget->{req_h}\n"
2631 . "visible $widget->{visible}";
2632 }
2633
2636 $self->add (new CFClient::UI::Label 2634 $self->add (new CFClient::UI::Label
2637 markup => $widget->{tooltip}, 2635 markup => $tooltip,
2638 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2636 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2639 fontsize => 0.8, 2637 fontsize => 0.8,
2640 fg => [0, 0, 0, 1], 2638 fg => [0, 0, 0, 1],
2641 ellipsise => 0, 2639 ellipsise => 0,
2642 font => ($widget->{tooltip_font} || $::FONT_PROP), 2640 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2653 2651
2654sub size_allocate { 2652sub size_allocate {
2655 my ($self, $w, $h) = @_; 2653 my ($self, $w, $h) = @_;
2656 2654
2657 $self->SUPER::size_allocate ($w - 4, $h - 4); 2655 $self->SUPER::size_allocate ($w - 4, $h - 4);
2656}
2657
2658sub visibility_change {
2659 my ($self, $visible) = @_;
2660
2661 return unless $visible;
2662
2663 $self->{root}->on_post_alloc ("move_$self" => sub {
2664 my $widget = $self->{owner}
2665 or return;
2666
2667 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2668
2669 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2670 if $x + $self->{w} > $::WIDTH;
2671
2672 $self->move_abs ($x, $y);
2673 });
2658} 2674}
2659 2675
2660sub _draw { 2676sub _draw {
2661 my ($self) = @_; 2677 my ($self) = @_;
2662 2678
… …
2679 glVertex $w, $h; 2695 glVertex $w, $h;
2680 glVertex $w, 0; 2696 glVertex $w, 0;
2681 glEnd; 2697 glEnd;
2682 2698
2683 glTranslate 2 - 0.375, 2 - 0.375; 2699 glTranslate 2 - 0.375, 2 - 0.375;
2700
2684 $self->SUPER::_draw; 2701 $self->SUPER::_draw;
2685} 2702}
2686 2703
2687############################################################################# 2704#############################################################################
2688 2705
… …
2764 $self->SUPER::DESTROY; 2781 $self->SUPER::DESTROY;
2765} 2782}
2766 2783
2767############################################################################# 2784#############################################################################
2768 2785
2769package CFClient::UI::Inventory;
2770
2771our @ISA = CFClient::UI::ScrolledWindow::;
2772
2773sub new {
2774 my $class = shift;
2775
2776 my $self = $class->SUPER::new (
2777 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2778 @_,
2779 );
2780
2781 $self
2782}
2783
2784sub set_items {
2785 my ($self, $items) = @_;
2786
2787 $self->{scrolled}->clear;
2788 return unless $items;
2789
2790 my @items = sort {
2791 ($a->{type} <=> $b->{type})
2792 or ($a->{name} cmp $b->{name})
2793 } @$items;
2794
2795 $self->{real_items} = \@items;
2796
2797 my $row = 0;
2798 for my $item (@items) {
2799 CFClient::Item::update_widgets $item;
2800
2801 $self->{scrolled}->add (0, $row, $item->{face_widget});
2802 $self->{scrolled}->add (1, $row, $item->{desc_widget});
2803 $self->{scrolled}->add (2, $row, $item->{weight_widget});
2804
2805 $row++;
2806 }
2807}
2808
2809sub size_request {
2810 my ($self) = @_;
2811 ($self->{req_w}, $self->{req_h});
2812}
2813
2814#############################################################################
2815
2816package CFClient::UI::Menu; 2786package CFClient::UI::Menu;
2817 2787
2818our @ISA = CFClient::UI::FancyFrame::; 2788our @ISA = CFClient::UI::FancyFrame::;
2819 2789
2820use CFClient::OpenGL; 2790use CFClient::OpenGL;
… …
2858 # maybe save $GRAB? must be careful about events... 2828 # maybe save $GRAB? must be careful about events...
2859 $GRAB = $self; 2829 $GRAB = $self;
2860 $self->{button} = $ev->{button}; 2830 $self->{button} = $ev->{button};
2861 2831
2862 $self->show; 2832 $self->show;
2863 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2833 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2864} 2834}
2865 2835
2866sub mouse_motion { 2836sub mouse_motion {
2867 my ($self, $ev, $x, $y) = @_; 2837 my ($self, $ev, $x, $y) = @_;
2868 2838
… …
2993 $self->SUPER::reconfigure; 2963 $self->SUPER::reconfigure;
2994} 2964}
2995 2965
2996############################################################################# 2966#############################################################################
2997 2967
2998package CFClient::UI::Root; 2968package CFClient::UI::Inventory;
2999 2969
3000our @ISA = CFClient::UI::Container::; 2970our @ISA = CFClient::UI::ScrolledWindow::;
3001
3002use CFClient::OpenGL;
3003 2971
3004sub new { 2972sub new {
3005 my $class = shift; 2973 my $class = shift;
3006 2974
3007 $class->SUPER::new ( 2975 my $self = $class->SUPER::new (
2976 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2977 @_,
2978 );
2979
2980 $self
2981}
2982
2983sub set_items {
2984 my ($self, $items) = @_;
2985
2986 $self->{scrolled}->clear;
2987 return unless $items;
2988
2989 my @items = sort {
2990 ($a->{type} <=> $b->{type})
2991 or ($a->{name} cmp $b->{name})
2992 } @$items;
2993
2994 $self->{real_items} = \@items;
2995
2996 my $row = 0;
2997 for my $item (@items) {
2998 CFClient::Item::update_widgets $item;
2999
3000 $self->{scrolled}->add (0, $row, $item->{face_widget});
3001 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3002 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3003
3004 $row++;
3005 }
3006}
3007
3008#############################################################################
3009
3010package CFClient::UI::BindEditor;
3011
3012our @ISA = CFClient::UI::FancyFrame::;
3013
3014sub new {
3015 my $class = shift;
3016
3017 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3018
3019 $self->add (my $vb = new CFClient::UI::VBox);
3020
3021
3022 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3023 text => "start recording",
3024 tooltip => "Start/Stops recording of actions."
3025 ."All subsequent actions after the recording started will be captured."
3026 ."The actions are displayed after the record was stopped."
3027 ."To bind the action you have to click on the 'Bind' button",
3028 on_activate => sub {
3029 unless ($self->{recording}) {
3030 $self->start;
3031 } else {
3032 $self->stop;
3033 }
3034 });
3035
3036 $vb->add (new CFClient::UI::Label text => "Actions:");
3037 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3038
3039 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3040 $vb->add (my $hb = new CFClient::UI::HBox);
3041 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3042 $hb->add (new CFClient::UI::Button
3043 text => "bind",
3044 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3045 on_activate => sub {
3046 $self->ask_for_bind;
3047 });
3048
3049 $vb->add (my $hb = new CFClient::UI::HBox);
3050 $hb->add (new CFClient::UI::Button
3051 text => "ok",
3052 expand => 1,
3053 tooltip => "This closes the binding editor and saves the binding",
3054 on_activate => sub {
3055 $self->hide;
3056 $self->commit;
3057 });
3058
3059 $hb->add (new CFClient::UI::Button
3060 text => "cancel",
3061 expand => 1,
3062 tooltip => "This closes the binding editor without saving",
3063 on_activate => sub {
3064 $self->hide;
3065 $self->{binding_cancel}->()
3066 if $self->{binding_cancel};
3067 });
3068
3069 $self->update_binding_widgets;
3070
3071 $self
3072}
3073
3074sub commit {
3075 my ($self) = @_;
3076 my ($mod, $sym, $cmds) = $self->get_binding;
3077 if ($sym != 0 && @$cmds > 0) {
3078 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3079 ."'. Don't forget 'Save Config'!");
3080 $self->{binding_change}->($mod, $sym, $cmds)
3081 if $self->{binding_change};
3082 } else {
3083 $::STATUSBOX->add ("No action bound, no key or action specified!");
3084 $self->{binding_cancel}->()
3085 if $self->{binding_cancel};
3086 }
3087}
3088
3089sub start {
3090 my ($self) = @_;
3091
3092 $self->{rec_btn}->set_text ("stop recording");
3093 $self->{recording} = 1;
3094 $self->clear_command_list;
3095 $::CONN->start_record if $::CONN;
3096}
3097
3098sub stop {
3099 my ($self) = @_;
3100
3101 $self->{rec_btn}->set_text ("start recording");
3102 $self->{recording} = 0;
3103
3104 my $rec;
3105 $rec = $::CONN->stop_record if $::CONN;
3106 return unless ref $rec eq 'ARRAY';
3107 $self->set_command_list ($rec);
3108}
3109
3110# if $commit is true, the binding will be set after the user entered a key combo
3111sub ask_for_bind {
3112 my ($self, $commit) = @_;
3113
3114 CFClient::Binder::open_binding_dialog (sub {
3115 my ($mod, $sym) = @_;
3116 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3117 $self->update_binding_widgets;
3118 $self->commit if $commit;
3119 });
3120}
3121
3122# $mod and $sym are the modifiers and key symbol
3123# $cmds is a array ref of strings (the commands)
3124# $cb is the callback that is executed on OK
3125# $ccb is the callback that is executed on CANCEL and
3126# when the binding was unsuccessful on OK
3127sub set_binding {
3128 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3129
3130 $self->clear_command_list;
3131 $self->{recording} = 0;
3132 $self->{rec_btn}->set_text ("start recording");
3133
3134 $self->{binding} = [$mod, $sym];
3135 $self->{commands} = $cmds;
3136
3137 $self->{binding_change} = $cb;
3138 $self->{binding_cancel} = $ccb;
3139
3140 $self->update_binding_widgets;
3141}
3142
3143# this is a shortcut method that asks for a binding
3144# and then just binds it.
3145sub do_quick_binding {
3146 my ($self, $cmds) = @_;
3147 $self->set_binding (undef, undef, $cmds, sub {
3148 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3149 });
3150 $self->ask_for_bind (1);
3151}
3152
3153sub update_binding_widgets {
3154 my ($self) = @_;
3155 my ($mod, $sym, $cmds) = $self->get_binding;
3156 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3157 $self->set_command_list ($cmds);
3158}
3159
3160sub get_binding {
3161 my ($self) = @_;
3162 return (
3163 $self->{binding}->[0],
3164 $self->{binding}->[1],
3165 [ grep { defined $_ } @{$self->{commands}} ]
3166 );
3167}
3168
3169sub clear_command_list {
3170 my ($self) = @_;
3171 $self->{cmdbox}->clear ();
3172}
3173
3174sub set_command_list {
3175 my ($self, $cmds) = @_;
3176
3177 $self->{cmdbox}->clear ();
3178 $self->{commands} = $cmds;
3179
3180 my $idx = 0;
3181
3182 for (@$cmds) {
3183 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3184
3185 my $i = $idx;
3186 $hb->add (new CFClient::UI::Label text => $_);
3187 $hb->add (new CFClient::UI::Button
3188 text => "delete",
3189 tooltip => "Deletes the action from the record",
3190 on_activate => sub {
3191 $self->{cmdbox}->remove ($hb);
3192 $cmds->[$i] = undef;
3193 });
3194
3195
3196 $idx++
3197 }
3198}
3199
3200#############################################################################
3201
3202package CFClient::UI::SpellList;
3203
3204our @ISA = CFClient::UI::FancyFrame::;
3205
3206sub new {
3207 my $class = shift;
3208
3209 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3210
3211 $self->add (new CFClient::UI::ScrolledWindow
3212 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3213
3214 $self;
3215}
3216
3217# XXX: Do sorting? Argl...
3218sub add_spell {
3219 my ($self, $spell) = @_;
3220 $self->{spells}->{$spell->{name}} = $spell;
3221
3222 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3223 face => $spell->{face},
3224 can_hover => 1,
3225 can_events => 1,
3226 tooltip => $spell->{message});
3227
3228 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3229 text => $spell->{name},
3230 can_hover => 1,
3231 can_events => 1,
3232 tooltip => $spell->{message},
3233 expand => 1);
3234
3235 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3236 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3237 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3238 expand => 1);
3239
3240 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3241 text => "bind to key",
3242 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3243}
3244
3245sub rebuild_spell_list {
3246 my ($self) = @_;
3247 $self->{tbl_idx} = 0;
3248 $self->add_spell ($_) for values %{$self->{spells}};
3249}
3250
3251sub remove_spell {
3252 my ($self, $spell) = @_;
3253 delete $self->{spells}->{$spell->{name}};
3254 $self->rebuild_spell_list;
3255}
3256
3257#############################################################################
3258
3259package CFClient::UI::Root;
3260
3261our @ISA = CFClient::UI::Container::;
3262
3263use CFClient::OpenGL;
3264
3265sub new {
3266 my $class = shift;
3267
3268 my $self = $class->SUPER::new (
3008 visible => 1, 3269 visible => 1,
3009 @_, 3270 @_,
3010 ) 3271 );
3011}
3012 3272
3013sub configure { 3273 Scalar::Util::weaken ($self->{root} = $self);
3014 my ($self, $x, $y, $w, $h) = @_;
3015 3274
3016 $self->{w} = $w; 3275 $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} 3276}
3026 3277
3027sub size_request { 3278sub size_request {
3028 my ($self) = @_; 3279 my ($self) = @_;
3029 3280
3030 ($self->{w}, $self->{h}) 3281 ($self->{w}, $self->{h})
3282}
3283
3284sub _to_pixel {
3285 my ($coord, $size, $max) = @_;
3286
3287 $coord =
3288 $coord eq "center" ? ($max - $size) * 0.5
3289 : $coord eq "max" ? $max
3290 : $coord;
3291
3292 $coord = 0 if $coord < 0;
3293 $coord = $max - $size if $coord > $max - $size;
3294
3295 int $coord + 0.5
3031} 3296}
3032 3297
3033sub size_allocate { 3298sub size_allocate {
3034 my ($self, $w, $h) = @_; 3299 my ($self, $w, $h) = @_;
3035 3300
3036 for my $child ($self->children) { 3301 for my $child ($self->children) {
3037 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3302 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3038 3303
3039 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3304 $X = $child->{force_x} if exists $child->{force_x};
3040 if exists $child->{req_x}; 3305 $Y = $child->{force_y} if exists $child->{force_y};
3041 3306
3042 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3307 $X = _to_pixel $X, $W, $self->{w};
3043 if exists $child->{req_y}; 3308 $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 3309
3051 $child->configure ($X, $Y, $W, $H); 3310 $child->configure ($X, $Y, $W, $H);
3052 } 3311 }
3053} 3312}
3054 3313
… …
3065} 3324}
3066 3325
3067sub update { 3326sub update {
3068 my ($self) = @_; 3327 my ($self) = @_;
3069 3328
3070 $self->check_size;
3071 $::WANT_REFRESH++; 3329 $::WANT_REFRESH++;
3072} 3330}
3073 3331
3074sub add { 3332sub add {
3075 my ($self, @children) = @_; 3333 my ($self, @children) = @_;
3076 3334
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; 3335 $_->{is_toplevel} = 1
3085 3336 for @children;
3086 # integerise window positions
3087 $child->{x} = int $child->{x};
3088 $child->{y} = int $child->{y};
3089 }
3090 3337
3091 $self->SUPER::add (@children); 3338 $self->SUPER::add (@children);
3092} 3339}
3093 3340
3094sub remove { 3341sub remove {
3095 my ($self, @children) = @_; 3342 my ($self, @children) = @_;
3096 3343
3097 $self->SUPER::remove (@children); 3344 $self->SUPER::remove (@children);
3345
3346 delete $self->{is_toplevel}
3347 for @children;
3098 3348
3099 while (@children) { 3349 while (@children) {
3100 my $w = pop @children; 3350 my $w = pop @children;
3101 push @children, $w->children; 3351 push @children, $w->children;
3102 $w->set_invisible; 3352 $w->set_invisible;
… …
3121 while ($self->{refresh_hook}) { 3371 while ($self->{refresh_hook}) {
3122 $_->() 3372 $_->()
3123 for values %{delete $self->{refresh_hook}}; 3373 for values %{delete $self->{refresh_hook}};
3124 } 3374 }
3125 3375
3126 if ($self->{check_size}) { 3376 if ($self->{realloc}) {
3127 my @queue; 3377 my @queue;
3128 3378
3129 for (;;) { 3379 while () {
3130 if ($self->{check_size}) { 3380 if ($self->{realloc}) {
3131 #TODO use array-of-depth approach 3381 #TODO use array-of-depth approach
3132 3382
3383 use sort 'stable';
3384
3133 @queue = sort { $a->{visible} <=> $b->{visible} } 3385 @queue = sort { $a->{visible} <=> $b->{visible} }
3134 @queue, values %{delete $self->{check_size}}; 3386 @queue, values %{delete $self->{realloc}};
3135 } 3387 }
3136 3388
3137 my $widget = pop @queue || last; 3389 my $widget = pop @queue || last;
3138 3390
3139 defined $widget->{visible} or last; # do not resize invisible widgets 3391 $widget->{visible} or last; # do not resize invisible widgets
3140 3392
3141 my ($w, $h) = $widget->{user_w} && $widget->{user_h}
3142 ? @$widget{qw(user_w user_h)}
3143 : $widget->size_request; 3393 my ($w, $h) = $widget->size_request;
3144 3394
3395 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3396 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3397
3398 $w = $widget->{force_w} if exists $widget->{force_w};
3399 $h = $widget->{force_h} if exists $widget->{force_h};
3400
3401 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3145 if (delete $widget->{force_alloc} 3402 || 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; 3403 $widget->{req_w} = $w;
3150 $widget->{req_h} = $h; 3404 $widget->{req_h} = $h;
3151 3405
3152 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3406 $self->{size_alloc}{$widget+0} = $widget;
3153 3407
3154 $widget->{parent}->check_size
3155 if $widget->{parent}; 3408 if (my $parent = $widget->{parent}) {
3409 $self->{realloc}{$parent+0} = $parent;
3410 #unshift @queue, $parent;
3411 $parent->{force_size_alloc} = 1;
3412 $self->{size_alloc}{$parent+0} = $parent;
3413 }
3156 } 3414 }
3415
3416 delete $self->{realloc}{$widget+0};
3157 } 3417 }
3158 } 3418 }
3159 3419
3160 while ($self->{size_alloc}) { 3420 while (my $size_alloc = delete $self->{size_alloc}) {
3161 for (values %{delete $self->{size_alloc}}) { 3421 my @queue = sort { $b->{visible} <=> $a->{visible} }
3162 my ($widget, $w, $h) = @$_; 3422 values %$size_alloc;
3423
3424 while () {
3425 my $widget = pop @queue || last;
3426
3427 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3163 3428
3164 $w = 0 if $w < 0; 3429 $w = 0 if $w < 0;
3165 $h = 0 if $h < 0; 3430 $h = 0 if $h < 0;
3166 3431
3432 $w = int $w + 0.5;
3433 $h = int $h + 0.5;
3434
3435 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3167 $widget->{w} = $w; 3436 $widget->{w} = $w;
3168 $widget->{h} = $h; 3437 $widget->{h} = $h;
3438
3169 $widget->emit (size_allocate => $w, $h); 3439 $widget->emit (size_allocate => $w, $h);
3440 }
3170 } 3441 }
3171 } 3442 }
3172 3443
3173 while ($self->{post_alloc_hook}) { 3444 while ($self->{post_alloc_hook}) {
3174 $_->() 3445 $_->()
3175 for values %{delete $self->{post_alloc_hook}}; 3446 for values %{delete $self->{post_alloc_hook}};
3176 } 3447 }
3448
3177 3449
3178 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3450 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3179 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3451 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3180 glClear GL_COLOR_BUFFER_BIT; 3452 glClear GL_COLOR_BUFFER_BIT;
3181 3453

Diff Legend

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