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.231 by root, Thu May 25 00:26:19 2006 UTC vs.
Revision 1.272 by root, Sat Jun 3 01:47:14 2006 UTC

… …
5 5
6use Scalar::Util (); 6use Scalar::Util ();
7use List::Util (); 7use List::Util ();
8 8
9use CFClient; 9use CFClient;
10use CFClient::Texture;
10 11
11our ($FOCUS, $HOVER, $GRAB); # various widgets 12our ($FOCUS, $HOVER, $GRAB); # various widgets
12 13
14our $LAYOUT;
13our $ROOT; 15our $ROOT;
14our $TOOLTIP; 16our $TOOLTIP;
15our $BUTTON_STATE; 17our $BUTTON_STATE;
16 18
17our %WIDGET; # all widgets, weak-referenced 19our %WIDGET; # all widgets, weak-referenced
18 20
21sub get_layout {
22 my $layout;
23
24 for (grep { $_->{name} } values %WIDGET) {
25 my $win = $layout->{$_->{name}} = { };
26
27 $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
28 $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
29 $win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
30 $win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
31
32 $win->{show} = $_->{visible} && $_->{is_toplevel};
33 }
34
35 $layout
36}
37
38sub set_layout {
39 my ($layout) = @_;
40
41 $LAYOUT = $layout;
42}
43
19sub check_tooltip { 44sub check_tooltip {
45 return if $ENV{CFPLUS_DEBUG} & 8;
46
20 if (!$GRAB) { 47 if (!$GRAB) {
21 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 48 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
22 if (length $widget->{tooltip}) { 49 if (length $widget->{tooltip}) {
23
24 if ($TOOLTIP->{owner} != $widget) { 50 if ($TOOLTIP->{owner} != $widget) {
51 $TOOLTIP->hide;
52
25 $TOOLTIP->{owner} = $widget; 53 $TOOLTIP->{owner} = $widget;
26 54
27 my $tip = $widget->{tooltip}; 55 my $tip = $widget->{tooltip};
28 56
29 $tip = $tip->($widget) if CODE:: eq ref $tip; 57 $tip = $tip->($widget) if CODE:: eq ref $tip;
30 58
31 $TOOLTIP->set_tooltip_from ($widget); 59 $TOOLTIP->set_tooltip_from ($widget);
32 $TOOLTIP->show; 60 $TOOLTIP->show;
33
34 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
35
36 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
37 if $x + $TOOLTIP->{w} > $::WIDTH;
38
39 $TOOLTIP->move ($x, $y);
40 $TOOLTIP->check_size;
41 $TOOLTIP->update;
42 } 61 }
43 62
44 return; 63 return;
45 } 64 }
46 } 65 }
… …
152sub rescale_widgets { 171sub rescale_widgets {
153 my ($sx, $sy) = @_; 172 my ($sx, $sy) = @_;
154 173
155 for my $widget (values %WIDGET) { 174 for my $widget (values %WIDGET) {
156 if ($widget->{is_toplevel}) { 175 if ($widget->{is_toplevel}) {
176 $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
177 $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
178
157 $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x}; 179 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
158 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 180 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
159 $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w}; 181 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
160 $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
161 $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y}; 182 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
162 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 183 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
163 $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h}; 184 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
164 $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h}; 185
186 $widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
187 $widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
188
165 } 189 }
166 } 190 }
167 191
168 reconfigure_widgets; 192 reconfigure_widgets;
169} 193}
… …
178 202
179sub new { 203sub new {
180 my $class = shift; 204 my $class = shift;
181 205
182 my $self = bless { 206 my $self = bless {
183 x => 0, 207 x => "center",
184 y => 0, 208 y => "center",
185 z => 0, 209 z => 0,
210 w => undef,
211 h => undef,
186 can_events => 1, 212 can_events => 1,
187 @_ 213 @_
188 }, $class; 214 }, $class;
189 215
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
190 for (keys %$self) { 218 for (keys %$self) {
191 if (/^connect_(.*)$/) { 219 if (/^on_(.*)$/) {
192 $self->connect ($1 => delete $self->{$_}); 220 $self->connect ($1 => delete $self->{$_});
193 } 221 }
194 } 222 }
195 223
196 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 224 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
225 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
226 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
227 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
228 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
229
230 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
231 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
232
233 $self->show if $layout->{show};
234 }
197 235
198 $self 236 $self
199} 237}
200 238
201sub destroy { 239sub destroy {
… …
205 %$self = (); 243 %$self = ();
206} 244}
207 245
208sub show { 246sub show {
209 my ($self) = @_; 247 my ($self) = @_;
248
210 return if $self->{parent}; 249 return if $self->{parent};
211 250
212 $CFClient::UI::ROOT->add ($self); 251 $CFClient::UI::ROOT->add ($self);
213} 252}
214 253
215sub show_centered { 254sub set_visible {
216 my ($self) = @_; 255 my ($self) = @_;
256
217 return if $self->{parent}; 257 return if $self->{visible};
218 258
219 $self->show; 259 $self->{root} = $self->{parent}{root};
260 $self->{visible} = $self->{parent}{visible} + 1;
220 261
221 $CFClient::UI::ROOT->on_post_alloc ( 262 $self->emit (visibility_change => 1);
222 "centered $self" => sub { 263
223 $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5); 264 $self->realloc if !exists $self->{req_w};
224 }, 265
225 ); 266 $_->set_visible for $self->children;
226} 267}
227 268
228sub set_invisible { 269sub set_invisible {
229 my ($self) = @_; 270 my ($self) = @_;
230 271
231 # broken show/hide model 272 return unless $self->{visible};
232 273
274 $_->set_invisible for $self->children;
275
276 delete $self->{root};
233 delete $self->{visible}; 277 delete $self->{visible};
234 278
235 undef $GRAB if $GRAB == $self; 279 undef $GRAB if $GRAB == $self;
236 undef $HOVER if $HOVER == $self; 280 undef $HOVER if $HOVER == $self;
237 281
282 CFClient::UI::check_tooltip
283 if $TOOLTIP->{owner} == $self;
284
238 $self->focus_out; 285 $self->focus_out;
286
287 $self->emit (visibility_change => 0);
288}
289
290sub set_visibility {
291 my ($self, $visible) = @_;
292
293 return if $self->{visible} == $visible;
294
295 $visible ? $self->hide
296 : $self->show;
297}
298
299sub toggle_visibility {
300 my ($self) = @_;
301
302 $self->{visible}
303 ? $self->hide
304 : $self->show;
239} 305}
240 306
241sub hide { 307sub hide {
242 my ($self) = @_; 308 my ($self) = @_;
243 309
… …
245 311
246 $self->{parent}->remove ($self) 312 $self->{parent}->remove ($self)
247 if $self->{parent}; 313 if $self->{parent};
248} 314}
249 315
250sub move { 316sub move_abs {
251 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
252 318
253 $self->{x} = int $x; 319 $self->{x} = List::Util::max 0, int $x;
254 $self->{y} = int $y; 320 $self->{y} = List::Util::max 0, int $y;
255 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
256 322
257 $self->update; 323 $self->update;
258} 324}
259 325
260sub set_size { 326sub set_size {
261 my ($self, $w, $h) = @_; 327 my ($self, $w, $h) = @_;
262 328
263 $self->{user_w} = $w; 329 $self->{force_w} = $w;
264 $self->{user_h} = $h; 330 $self->{force_h} = $h;
265 331
266 $self->check_size; 332 $self->realloc;
267} 333}
268 334
269sub size_request { 335sub size_request {
270 require Carp; 336 require Carp;
271 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
… …
273 339
274sub configure { 340sub configure {
275 my ($self, $x, $y, $w, $h) = @_; 341 my ($self, $x, $y, $w, $h) = @_;
276 342
277 if ($self->{aspect}) { 343 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h);
345
278 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 346 $w = List::Util::min $w, int $h * $self->{aspect};
279 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 347 $h = List::Util::min $h, int $w / $self->{aspect};
280 348
281 # use alignment to adjust x, y 349 # use alignment to adjust x, y
282 350
283 $x += int +($w - $w2) * 0.5; 351 $x += int 0.5 * ($ow - $w);
284 $y += int +($h - $h2) * 0.5; 352 $y += int 0.5 * ($oh - $h);
285
286 ($w, $h) = ($w2, $h2);
287 } 353 }
288 354
289 if ($self->{x} != $x || $self->{y} != $y) { 355 if ($self->{x} ne $x || $self->{y} ne $y) {
290 $self->{x} = $x; 356 $self->{x} = $x;
291 $self->{y} = $y; 357 $self->{y} = $y;
292 $self->update; 358 $self->update;
293 } 359 }
294 360
295 if ($self->{w} != $w || $self->{h} != $h) { 361 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
296 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h]; 362 return unless $self->{visible};
363
364 $self->{alloc_w} = $w;
365 $self->{alloc_h} = $h;
366
367 $self->{root}{size_alloc}{$self+0} = $self;
297 } 368 }
298} 369}
299 370
300sub size_allocate { 371sub size_allocate {
301 # nothing to be done 372 # nothing to be done
302} 373}
303 374
304sub reconfigure {
305 my ($self) = @_;
306
307 $self->check_size (1);
308 $self->update;
309}
310
311sub children { 375sub children {
376 # nop
377}
378
379sub visible_children {
380 $_[0]->children
312} 381}
313 382
314sub set_max_size { 383sub set_max_size {
315 my ($self, $w, $h) = @_; 384 my ($self, $w, $h) = @_;
316 385
… …
318 delete $self->{max_h}; $self->{max_h} = $h if $h; 387 delete $self->{max_h}; $self->{max_h} = $h if $h;
319} 388}
320 389
321sub set_tooltip { 390sub set_tooltip {
322 my ($self, $tooltip) = @_; 391 my ($self, $tooltip) = @_;
392
393 $tooltip =~ s/^\s+//;
394 $tooltip =~ s/\s+$//;
395
396 return if $self->{tooltip} eq $tooltip;
323 397
324 $self->{tooltip} = $tooltip; 398 $self->{tooltip} = $tooltip;
325 399
326 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 400 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
327 delete $CFClient::UI::TOOLTIP->{owner}; 401 delete $CFClient::UI::TOOLTIP->{owner};
… …
370 444
371 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus 445 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
372 unless $FOCUS; 446 unless $FOCUS;
373} 447}
374 448
375sub mouse_motion { } 449sub mouse_motion { 0 }
376sub button_up { } 450sub button_up { 0 }
377sub key_down { } 451sub key_down { 0 }
378sub key_up { } 452sub key_up { 0 }
379 453
380sub button_down { 454sub button_down {
381 my ($self, $ev, $x, $y) = @_; 455 my ($self, $ev, $x, $y) = @_;
382 456
383 $self->focus_in; 457 $self->focus_in;
384}
385 458
386sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 459 0
387sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 460}
388sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 461
389sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 462sub find_widget {
390sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 463 my ($self, $x, $y) = @_;
464
465 return () unless $self->{can_events};
466
467 return $self
468 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
469 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
470
471 ()
472}
473
474sub set_parent {
475 my ($self, $parent) = @_;
476
477 Scalar::Util::weaken ($self->{parent} = $parent);
478 $self->set_visible if $parent->{visible};
479}
480
481sub connect {
482 my ($self, $signal, $cb) = @_;
483
484 push @{ $self->{signal_cb}{$signal} }, $cb;
485}
486
487sub _emit {
488 my ($self, $signal, @args) = @_;
489
490 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
491}
492
493sub emit {
494 my ($self, $signal, @args) = @_;
495
496 $self->_emit ($signal, @args)
497 || $self->$signal (@args);
498}
499
500sub visibility_change {
501 #my ($self, $visible) = @_;
502}
503
504sub realloc {
505 my ($self) = @_;
506
507 if ($self->{visible}) {
508 return if $self->{root}{realloc}{$self+0};
509
510 $self->{root}{realloc}{$self+0} = $self;
511 $self->{root}->update;
512 } else {
513 delete $self->{req_w};
514 delete $self->{req_h};
515 }
516}
517
518sub update {
519 my ($self) = @_;
520
521 $self->{parent}->update
522 if $self->{parent};
523}
524
525sub reconfigure {
526 my ($self) = @_;
527
528 $self->realloc;
529 $self->update;
530}
531
532# using global variables seems a bit hacky, but passing through all drawing
533# functions seems pointless.
534our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
391 535
392sub draw { 536sub draw {
393 my ($self) = @_; 537 my ($self) = @_;
394 538
395 return unless $self->{h} && $self->{w}; 539 return unless $self->{h} && $self->{w};
540
541 # update screen rectangle
542 local $draw_x = $draw_x + $self->{x};
543 local $draw_y = $draw_y + $self->{y};
544 local $draw_w = $draw_x + $self->{w};
545 local $draw_h = $draw_y + $self->{h};
546
547 # skip widgets that are entirely outside the drawing area
548 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
549 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
396 550
397 glPushMatrix; 551 glPushMatrix;
398 glTranslate $self->{x}, $self->{y}, 0; 552 glTranslate $self->{x}, $self->{y}, 0;
399 $self->_draw; 553 $self->_draw;
400 glPopMatrix; 554 glPopMatrix;
… …
412 glVertex $x , $y + $self->{h}; 566 glVertex $x , $y + $self->{h};
413 glEnd; 567 glEnd;
414 glDisable GL_BLEND; 568 glDisable GL_BLEND;
415 } 569 }
416 570
417 if ($ENV{PCLIENT_DEBUG}) { 571 if ($ENV{CFPLUS_DEBUG} & 1) {
418 glPushMatrix; 572 glPushMatrix;
419 glColor 1, 1, 0, 1; 573 glColor 1, 1, 0, 1;
420 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 574 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
421 glBegin GL_LINE_LOOP; 575 glBegin GL_LINE_LOOP;
422 glVertex 0 , 0; 576 glVertex 0 , 0;
423 glVertex $self->{w}, 0; 577 glVertex $self->{w} - 1, 0;
424 glVertex $self->{w}, $self->{h}; 578 glVertex $self->{w} - 1, $self->{h} - 1;
425 glVertex 0 , $self->{h}; 579 glVertex 0 , $self->{h} - 1;
426 glEnd; 580 glEnd;
427 glPopMatrix; 581 glPopMatrix;
428 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 582 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
429 } 583 }
430} 584}
431 585
432sub _draw { 586sub _draw {
433 my ($self) = @_; 587 my ($self) = @_;
434 588
435 warn "no draw defined for $self\n"; 589 warn "no draw defined for $self\n";
436}
437
438sub find_widget {
439 my ($self, $x, $y) = @_;
440
441 return () unless $self->{can_events};
442
443 return $self
444 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
445 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
446
447 ()
448}
449
450sub set_parent {
451 my ($self, $parent) = @_;
452
453 Scalar::Util::weaken ($self->{parent} = $parent);
454
455 # TODO: req_w _does_change after ->reconfigure
456 $self->check_size
457 unless exists $self->{req_w};
458
459 $self->show;
460}
461
462sub check_size {
463 my ($self, $forced) = @_;
464
465 $self->{force_alloc} = 1 if $forced;
466 $CFClient::UI::ROOT->{check_size}{$self} = $self;
467}
468
469sub update {
470 my ($self) = @_;
471
472 $self->{parent}->update
473 if $self->{parent};
474}
475
476sub connect {
477 my ($self, $signal, $cb) = @_;
478
479 push @{ $self->{signal_cb}{$signal} }, $cb;
480}
481
482sub _emit {
483 my ($self, $signal, @args) = @_;
484
485 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
486}
487
488sub emit {
489 my ($self, $signal, @args) = @_;
490
491 $self->_emit ($signal, @args)
492 || $self->$signal (@args);
493} 590}
494 591
495sub DESTROY { 592sub DESTROY {
496 my ($self) = @_; 593 my ($self) = @_;
497 594
… …
555 my ($class, %arg) = @_; 652 my ($class, %arg) = @_;
556 $class->SUPER::new (can_events => 0, %arg); 653 $class->SUPER::new (can_events => 0, %arg);
557} 654}
558 655
559sub size_request { 656sub size_request {
560 (0, 0) 657 my ($self) = @_;
658
659 ($self->{w} + 0, $self->{h} + 0)
561} 660}
562 661
563sub draw { } 662sub draw { }
564 663
565############################################################################# 664#############################################################################
… …
569our @ISA = CFClient::UI::Base::; 668our @ISA = CFClient::UI::Base::;
570 669
571sub new { 670sub new {
572 my ($class, %arg) = @_; 671 my ($class, %arg) = @_;
573 672
574 my $children = delete $arg{children} || []; 673 my $children = delete $arg{children};
575 674
576 my $self = $class->SUPER::new ( 675 my $self = $class->SUPER::new (
577 children => [], 676 children => [],
578 can_events => 0, 677 can_events => 0,
579 %arg, 678 %arg,
580 ); 679 );
680
581 $self->add ($_) for @$children; 681 $self->add (@$children)
682 if $children;
582 683
583 $self 684 $self
584} 685}
585 686
586sub add { 687sub add {
… …
594 $self->{children} = [ 695 $self->{children} = [
595 sort { $a->{z} <=> $b->{z} } 696 sort { $a->{z} <=> $b->{z} }
596 @{$self->{children}}, @widgets 697 @{$self->{children}}, @widgets
597 ]; 698 ];
598 699
599 $self->check_size (1); 700 $self->realloc;
600 $self->update;
601} 701}
602 702
603sub children { 703sub children {
604 @{ $_[0]{children} } 704 @{ $_[0]{children} }
605} 705}
… …
610 delete $child->{parent}; 710 delete $child->{parent};
611 $child->hide; 711 $child->hide;
612 712
613 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 713 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
614 714
615 $self->check_size; 715 $self->realloc;
616 $self->update;
617} 716}
618 717
619sub clear { 718sub clear {
620 my ($self) = @_; 719 my ($self) = @_;
621 720
… …
625 for (@$children) { 724 for (@$children) {
626 delete $_->{parent}; 725 delete $_->{parent};
627 $_->hide; 726 $_->hide;
628 } 727 }
629 728
630 $self->check_size; 729 $self->realloc;
631 $self->update;
632} 730}
633 731
634sub find_widget { 732sub find_widget {
635 my ($self, $x, $y) = @_; 733 my ($self, $x, $y) = @_;
636 734
637 $x -= $self->{x}; 735 $x -= $self->{x};
638 $y -= $self->{y}; 736 $y -= $self->{y};
639 737
640 my $res; 738 my $res;
641 739
642 for (reverse @{ $self->{children} }) { 740 for (reverse $self->visible_children) {
643 $res = $_->find_widget ($x, $y) 741 $res = $_->find_widget ($x, $y)
644 and return $res; 742 and return $res;
645 } 743 }
646 744
647 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y}) 745 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
… …
723 $self->SUPER::size_allocate ($w, $h); 821 $self->SUPER::size_allocate ($w, $h);
724 $self->update; 822 $self->update;
725} 823}
726 824
727sub _render { 825sub _render {
826 my ($self) = @_;
827
728 $_[0]{children}[0]->draw; 828 $self->{children}[0]->draw;
729} 829}
730 830
731sub render_child { 831sub render_child {
732 my ($self) = @_; 832 my ($self) = @_;
733 833
734 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 834 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
735 glClearColor 0, 0, 0, 0; 835 glClearColor 0, 0, 0, 0;
736 glClear GL_COLOR_BUFFER_BIT; 836 glClear GL_COLOR_BUFFER_BIT;
737 837
838 {
839 package CFClient::UI::Base;
840
841 ($draw_x, $draw_y, $draw_w, $draw_h) =
842 (0, 0, $self->{w}, $self->{h});
843 }
844
738 $self->_render; 845 $self->_render;
739 }; 846 };
740} 847}
741 848
742sub _draw { 849sub _draw {
743 my ($self) = @_; 850 my ($self) = @_;
744 851
745 my ($w, $h) = ($self->w, $self->h); 852 my ($w, $h) = @$self{qw(w h)};
746 853
747 my $tex = $self->{texture} 854 my $tex = $self->{texture}
748 or return; 855 or return;
749 856
750 glEnable GL_TEXTURE_2D; 857 glEnable GL_TEXTURE_2D;
… …
760 867
761package CFClient::UI::ViewPort; 868package CFClient::UI::ViewPort;
762 869
763our @ISA = CFClient::UI::Window::; 870our @ISA = CFClient::UI::Window::;
764 871
872sub new {
873 my $class = shift;
874
875 $class->SUPER::new (
876 scroll_x => 0,
877 scroll_y => 1,
878 @_,
879 )
880}
881
765sub size_request { 882sub size_request {
766 my ($self) = @_; 883 my ($self) = @_;
767 884
768 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 885 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
769 886
770 @$self{qw(child_w child_h)} 887 $w = 10 if $self->{scroll_x};
888 $h = 10 if $self->{scroll_y};
889
890 ($w, $h)
771} 891}
772 892
773sub size_allocate { 893sub size_allocate {
774 my ($self, $w, $h) = @_; 894 my ($self, $w, $h) = @_;
775 895
776 my ($cw, $ch) = @$self{qw(child_w child_h)}; 896 my $child = $self->child;
777# $w = $self->{w}; 897
898 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
899 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
900
778 $self->child->configure (0, 0, $cw, $ch); 901 $self->child->configure (0, 0, $w, $h);
779 $self->update; 902 $self->update;
780} 903}
781 904
782sub set_offset { 905sub set_offset {
783 my ($self, $x, $y) = @_; 906 my ($self, $x, $y) = @_;
… …
817} 940}
818 941
819sub _render { 942sub _render {
820 my ($self) = @_; 943 my ($self) = @_;
821 944
945 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
946 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
947
822 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 948 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
823 949
824 $self->SUPER::_render; 950 $self->SUPER::_render;
825} 951}
826 952
… …
834 my $class = shift; 960 my $class = shift;
835 961
836 my $self; 962 my $self;
837 963
838 my $slider = new CFClient::UI::Slider 964 my $slider = new CFClient::UI::Slider
839 vertical => 1, 965 vertical => 1,
840 range => [0, 0, 1, 0.01], # HACK fix 966 range => [0, 0, 1, 0.01], # HACK fix
841 connect_changed => sub { 967 on_changed => sub {
842 $self->{vp}->set_offset (0, $_[1]); 968 $self->{vp}->set_offset (0, $_[1]);
843 }, 969 },
844 ; 970 ;
845 971
846 $self = $class->SUPER::new ( 972 $self = $class->SUPER::new (
… …
852 $self->{vp}->add ($self->{scrolled}); 978 $self->{vp}->add ($self->{scrolled});
853 $self->add ($self->{vp}); 979 $self->add ($self->{vp});
854 $self->add ($self->{slider}); 980 $self->add ($self->{slider});
855 981
856 $self 982 $self
983}
984
985sub update {
986 my ($self) = @_;
987
988 $self->SUPER::update;
989
990 # todo: overwrite size_allocate of child
991 my $child = $self->{vp}->child;
992 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
857} 993}
858 994
859sub size_allocate { 995sub size_allocate {
860 my ($self, $w, $h) = @_; 996 my ($self, $w, $h) = @_;
861 997
… …
914 1050
915our @ISA = CFClient::UI::Bin::; 1051our @ISA = CFClient::UI::Bin::;
916 1052
917use CFClient::OpenGL; 1053use CFClient::OpenGL;
918 1054
919my @tex = 1055my $bg =
1056 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1057 mipmap => 1, wrap => 1;
1058
1059my @border =
920 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1060 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
921 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1061 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
922 1062
923sub new { 1063sub new {
924 my $class = shift; 1064 my ($class, %arg) = @_;
925 1065
926 # TODO: user_x, user_y, overwrite moveto? 1066 my $title = delete $arg{title};
927 1067
928 my $self = $class->SUPER::new ( 1068 my $self = $class->SUPER::new (
929 bg => [1, 1, 1, 1], 1069 bg => [1, 1, 1, 1],
930 border_bg => [1, 1, 1, 1], 1070 border_bg => [1, 1, 1, 1],
931 border => 0.6, 1071 border => 0.6,
932 is_toplevel => 1,
933 can_events => 1, 1072 can_events => 1,
934 @_ 1073 min_w => 16,
1074 min_h => 16,
1075 %arg,
935 ); 1076 );
936 1077
937 $self->{title} &&= new CFClient::UI::Label 1078 $self->{title} = new CFClient::UI::Label
938 align => 0, 1079 align => 0,
939 valign => 1, 1080 valign => 1,
940 text => $self->{title}, 1081 text => $title,
941 fontsize => $self->{border}; 1082 fontsize => $self->{border}
1083 if defined $title;
942 1084
943 $self 1085 $self
1086}
1087
1088sub add {
1089 my ($self, @widgets) = @_;
1090
1091 $self->SUPER::add (@widgets);
1092 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
944} 1093}
945 1094
946sub border { 1095sub border {
947 int $_[0]{border} * $::FONTSIZE 1096 int $_[0]{border} * $::FONTSIZE
948} 1097}
949 1098
950sub size_request { 1099sub size_request {
951 my ($self) = @_; 1100 my ($self) = @_;
1101
1102 $self->{title}->size_request
1103 if $self->{title};
952 1104
953 my ($w, $h) = $self->SUPER::size_request; 1105 my ($w, $h) = $self->SUPER::size_request;
954 1106
955 ( 1107 (
956 $w + $self->border * 2, 1108 $w + $self->border * 2,
… …
959} 1111}
960 1112
961sub size_allocate { 1113sub size_allocate {
962 my ($self, $w, $h) = @_; 1114 my ($self, $w, $h) = @_;
963 1115
1116 if ($self->{title}) {
1117 $self->{title}{w} = $w;
1118 $self->{title}{h} = $h;
1119 $self->{title}->size_allocate ($w, $h);
1120 }
1121
1122 my $border = $self->border;
1123
964 $h -= List::Util::max 0, $self->border * 2; 1124 $h -= List::Util::max 0, $border * 2;
965 $w -= List::Util::max 0, $self->border * 2; 1125 $w -= List::Util::max 0, $border * 2;
966 1126
967 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
968 if $self->{title};
969
970 $self->child->configure ($self->border, $self->border, $w, $h); 1127 $self->child->configure ($border, $border, $w, $h);
971} 1128}
972 1129
973sub button_down { 1130sub button_down {
974 my ($self, $ev, $x, $y) = @_; 1131 my ($self, $ev, $x, $y) = @_;
975 1132
… …
991 my ($ev, $x, $y) = @_; 1148 my ($ev, $x, $y) = @_;
992 1149
993 my $dx = $ev->{x} - $ox; 1150 my $dx = $ev->{x} - $ox;
994 my $dy = $ev->{y} - $oy; 1151 my $dy = $ev->{y} - $oy;
995 1152
996 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1153 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
997 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1154 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1155
1156 $self->realloc;
998 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1157 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
999 $self->check_size;
1000 }; 1158 };
1001 1159
1002 } elsif ($lr ^ $td) { 1160 } elsif ($lr ^ $td) {
1003 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1161 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1004 my ($bx, $by) = ($self->{x}, $self->{y}); 1162 my ($bx, $by) = ($self->{x}, $self->{y});
… …
1006 $self->{motion} = sub { 1164 $self->{motion} = sub {
1007 my ($ev, $x, $y) = @_; 1165 my ($ev, $x, $y) = @_;
1008 1166
1009 ($x, $y) = ($ev->{x}, $ev->{y}); 1167 ($x, $y) = ($ev->{x}, $ev->{y});
1010 1168
1011 $self->move ($bx + $x - $ox, $by + $y - $oy); 1169 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1012 $self->update;
1013 }; 1170 };
1171 } else {
1172 return 0;
1173 }
1174
1014 } 1175 1
1015} 1176}
1016 1177
1017sub button_up { 1178sub button_up {
1018 my ($self, $ev, $x, $y) = @_; 1179 my ($self, $ev, $x, $y) = @_;
1019 1180
1020 delete $self->{motion}; 1181 !!delete $self->{motion}
1021} 1182}
1022 1183
1023sub mouse_motion { 1184sub mouse_motion {
1024 my ($self, $ev, $x, $y) = @_; 1185 my ($self, $ev, $x, $y) = @_;
1025 1186
1026 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1187 $self->{motion}->($ev, $x, $y) if $self->{motion};
1188
1189 !!$self->{motion}
1027} 1190}
1028 1191
1029sub _draw { 1192sub _draw {
1030 my ($self) = @_; 1193 my ($self) = @_;
1031 1194
1195 my $child = $self->{children}[0];
1196
1032 my ($w, $h ) = ($self->{w}, $self->{h}); 1197 my ($w, $h ) = ($self->{w}, $self->{h});
1033 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 1198 my ($cw, $ch) = ($child->{w}, $child->{h});
1034 1199
1035 glEnable GL_TEXTURE_2D; 1200 glEnable GL_TEXTURE_2D;
1036 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1201 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1037 1202
1038 my $border = $self->border; 1203 my $border = $self->border;
1039 1204
1040 glColor @{ $self->{border_bg} }; 1205 glColor @{ $self->{border_bg} };
1041 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1206 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1042 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1207 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1043 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1208 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1044 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1209 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1045 1210
1046 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1211 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1047 my $bg = $tex[0]; 1212 glColor @{ $self->{bg} };
1048 1213
1049 # TODO: repeat texture not scale 1214 # TODO: repeat texture not scale
1215 # solve this better(?)
1050 my $rep_x = $cw / $bg->{w}; 1216 $bg->{s} = $cw / $bg->{w};
1051 my $rep_y = $ch / $bg->{h}; 1217 $bg->{t} = $ch / $bg->{h};
1052
1053 glColor @{ $self->{bg} };
1054
1055 $bg->{s} = $rep_x;
1056 $bg->{t} = $rep_y;
1057 $bg->{wrap_mode} = 1;
1058 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1218 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1059 } 1219 }
1060 1220
1061 glDisable GL_TEXTURE_2D; 1221 glDisable GL_TEXTURE_2D;
1062 1222
1063 $self->{title}->draw if $self->{title};
1064
1065 $self->child->draw; 1223 $child->draw;
1224
1225 if ($self->{title}) {
1226 glTranslate 0, $border - $self->{h};
1227 $self->{title}->_draw;
1228 }
1066} 1229}
1067 1230
1068############################################################################# 1231#############################################################################
1069 1232
1070package CFClient::UI::Table; 1233package CFClient::UI::Table;
… …
1078sub new { 1241sub new {
1079 my $class = shift; 1242 my $class = shift;
1080 1243
1081 $class->SUPER::new ( 1244 $class->SUPER::new (
1082 col_expand => [], 1245 col_expand => [],
1083 @_ 1246 @_,
1084 ) 1247 )
1248}
1249
1250sub children {
1251 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1085} 1252}
1086 1253
1087sub add { 1254sub add {
1088 my ($self, $x, $y, $child) = @_; 1255 my ($self, $x, $y, $child) = @_;
1089 1256
1090 $child->set_parent ($self); 1257 $child->set_parent ($self);
1091 $self->{children}[$y][$x] = $child; 1258 $self->{children}[$y][$x] = $child;
1092 1259
1093 $child->check_size; 1260 $self->realloc;
1094} 1261}
1095 1262
1096sub children {
1097 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1098}
1099
1100# TODO: move to container class maybe? send childs a signal on removal? 1263# TODO: move to container class maybe? send children a signal on removal?
1101sub clear { 1264sub clear {
1102 my ($self) = @_; 1265 my ($self) = @_;
1103 1266
1104 my @children = $self->children; 1267 my @children = $self->children;
1105 delete $self->{children}; 1268 delete $self->{children};
… …
1107 for (@children) { 1270 for (@children) {
1108 delete $_->{parent}; 1271 delete $_->{parent};
1109 $_->hide; 1272 $_->hide;
1110 } 1273 }
1111 1274
1112 $self->update; 1275 $self->realloc;
1113} 1276}
1114 1277
1115sub get_wh { 1278sub get_wh {
1116 my ($self) = @_; 1279 my ($self) = @_;
1117 1280
… …
1148sub size_allocate { 1311sub size_allocate {
1149 my ($self, $w, $h) = @_; 1312 my ($self, $w, $h) = @_;
1150 1313
1151 my ($ws, $hs) = $self->get_wh; 1314 my ($ws, $hs) = $self->get_wh;
1152 1315
1153 my $req_w = sum @$ws; 1316 my $req_w = (sum @$ws) || 1;
1154 my $req_h = sum @$hs; 1317 my $req_h = (sum @$hs) || 1;
1155 1318
1156 # TODO: nicer code && do row_expand 1319 # TODO: nicer code && do row_expand
1157 my @col_expand = @{$self->{col_expand}}; 1320 my @col_expand = @{$self->{col_expand}};
1158 @col_expand = (1) x @$ws unless @col_expand; 1321 @col_expand = (1) x @$ws unless @col_expand;
1159 my $col_expand = (sum @col_expand) || 1; 1322 my $col_expand = (sum @col_expand) || 1;
… …
1213 } 1376 }
1214} 1377}
1215 1378
1216############################################################################# 1379#############################################################################
1217 1380
1218package CFClient::UI::HBox; 1381package CFClient::UI::Box;
1219
1220# TODO: wrap into common Box base class
1221 1382
1222our @ISA = CFClient::UI::Container::; 1383our @ISA = CFClient::UI::Container::;
1223 1384
1224sub size_request { 1385sub size_request {
1225 my ($self) = @_; 1386 my ($self) = @_;
1226 1387
1227 my @alloc = map [$_->size_request], @{$self->{children}}; 1388 $self->{vertical}
1228 1389 ? (
1229 ( 1390 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1230 (List::Util::sum map $_->[0], @alloc), 1391 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1231 (List::Util::max map $_->[1], @alloc), 1392 )
1232 ) 1393 : (
1394 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1395 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1396 )
1233} 1397}
1234 1398
1235sub size_allocate { 1399sub size_allocate {
1236 my ($self, $w, $h) = @_; 1400 my ($self, $w, $h) = @_;
1237 1401
1238 ($h, $w) = ($w, $h); 1402 my $space = $self->{vertical} ? $h : $w;
1239
1240 my $children = $self->{children}; 1403 my $children = $self->{children};
1241 1404
1242 my @h = map $_->{req_w}, @$children; 1405 my @req;
1243 1406
1244 my $req_h = List::Util::sum @h; 1407 if ($self->{homogeneous}) {
1245 1408 @req = ($space / (@$children || 1)) x @$children;
1246 if ($req_h > $h) {
1247 # ah well, not enough space
1248 $_ *= $h / $req_h for @h;
1249 } else { 1409 } else {
1410 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1411 my $req = List::Util::sum @req;
1412
1413 if ($req > $space) {
1414 # ah well, not enough space
1415 $_ *= $space / $req for @req;
1416 } else {
1250 my $exp = List::Util::sum map $_->{expand}, @$children; 1417 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1251 $exp ||= 1;
1252 1418
1419 $space = ($space - $req) / $expand; # remaining space to give away
1420
1421 $req[$_] += $space * $children->[$_]{expand}
1253 for (0 .. $#$children) { 1422 for 0 .. $#$children;
1254 my $child = $children->[$_];
1255
1256 my $alloc_h = $h[$_];
1257 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1258 $h[$_] = $alloc_h;
1259 } 1423 }
1260 } 1424 }
1261 1425
1262 CFClient::UI::harmonize \@h; 1426 CFClient::UI::harmonize \@req;
1263 1427
1264 my $y = 0; 1428 my $pos = 0;
1265 for (0 .. $#$children) { 1429 for (0 .. $#$children) {
1266 my $child = $children->[$_];
1267 my $h = $h[$_]; 1430 my $alloc = $req[$_];
1268 $child->configure ($y, 0, $h, $w); 1431 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1269 1432
1270 $y += $h; 1433 $pos += $alloc;
1271 } 1434 }
1272 1435
1273 1 1436 1
1274} 1437}
1275 1438
1276############################################################################# 1439#############################################################################
1277 1440
1441package CFClient::UI::HBox;
1442
1443our @ISA = CFClient::UI::Box::;
1444
1445sub new {
1446 my $class = shift;
1447
1448 $class->SUPER::new (
1449 vertical => 0,
1450 @_,
1451 )
1452}
1453
1454#############################################################################
1455
1278package CFClient::UI::VBox; 1456package CFClient::UI::VBox;
1279 1457
1280# TODO: wrap into common Box base class
1281
1282our @ISA = CFClient::UI::Container::; 1458our @ISA = CFClient::UI::Box::;
1283 1459
1284sub size_request { 1460sub new {
1285 my ($self) = @_; 1461 my $class = shift;
1286 1462
1287 my @alloc = map [$_->size_request], @{$self->{children}}; 1463 $class->SUPER::new (
1288 1464 vertical => 1,
1289 ( 1465 @_,
1290 (List::Util::max map $_->[0], @alloc),
1291 (List::Util::sum map $_->[1], @alloc),
1292 ) 1466 )
1293}
1294
1295sub size_allocate {
1296 my ($self, $w, $h) = @_;
1297
1298 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1299
1300 my $children = $self->{children};
1301
1302 my @h = map $_->{req_h}, @$children;
1303
1304 my $req_h = List::Util::sum @h;
1305
1306 if ($req_h > $h) {
1307 # ah well, not enough space
1308 $_ *= $h / $req_h for @h;
1309 } else {
1310 my $exp = List::Util::sum map $_->{expand}, @$children;
1311 $exp ||= 1;
1312
1313 for (0 .. $#$children) {
1314 my $child = $children->[$_];
1315
1316 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1317 }
1318 }
1319
1320 CFClient::UI::harmonize \@h;
1321
1322 my $y = 0;
1323 for (0 .. $#$children) {
1324 my $child = $children->[$_];
1325 my $h = $h[$_];
1326 $child->configure (0, $y, $w, $h);
1327
1328 $y += $h;
1329 }
1330
1331 1
1332} 1467}
1333 1468
1334############################################################################# 1469#############################################################################
1335 1470
1336package CFClient::UI::Label; 1471package CFClient::UI::Label;
… …
1353 ellipsise => 3, # end 1488 ellipsise => 3, # end
1354 layout => (new CFClient::Layout), 1489 layout => (new CFClient::Layout),
1355 fontsize => 1, 1490 fontsize => 1,
1356 align => -1, 1491 align => -1,
1357 valign => -1, 1492 valign => -1,
1358 padding => 2, 1493 padding_x => 2,
1494 padding_y => 2,
1359 can_events => 0, 1495 can_events => 0,
1360 %arg 1496 %arg
1361 ); 1497 );
1362 1498
1363 if (exists $self->{template}) { 1499 if (exists $self->{template}) {
… …
1399 $self->{text} = "T$text"; 1535 $self->{text} = "T$text";
1400 1536
1401 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1537 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1402 $self->{layout}->set_text ($text); 1538 $self->{layout}->set_text ($text);
1403 1539
1540 $self->realloc;
1404 $self->update; 1541 $self->update;
1405 $self->check_size;
1406} 1542}
1407 1543
1408sub set_markup { 1544sub set_markup {
1409 my ($self, $markup) = @_; 1545 my ($self, $markup) = @_;
1410 1546
… …
1414 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1550 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1415 1551
1416 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1552 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1417 $self->{layout}->set_markup ($markup); 1553 $self->{layout}->set_markup ($markup);
1418 1554
1555 $self->realloc;
1419 $self->update; 1556 $self->update;
1420 $self->check_size;
1421} 1557}
1422 1558
1423sub size_request { 1559sub size_request {
1424 my ($self) = @_; 1560 my ($self) = @_;
1425 1561
… …
1439 1575
1440 $w = List::Util::max $w, $w2; 1576 $w = List::Util::max $w, $w2;
1441 $h = List::Util::max $h, $h2; 1577 $h = List::Util::max $h, $h2;
1442 } 1578 }
1443 1579
1444 ( 1580 ($w, $h)
1445 $w + $self->{padding} * 2,
1446 $h + $self->{padding} * 2,
1447 )
1448} 1581}
1449 1582
1450sub size_allocate { 1583sub size_allocate {
1451 my ($self, $w, $h) = @_; 1584 my ($self, $w, $h) = @_;
1452 1585
1586 delete $self->{ox};
1587
1453 delete $self->{texture}; 1588 delete $self->{texture}
1589 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1454} 1590}
1455 1591
1456sub set_fontsize { 1592sub set_fontsize {
1457 my ($self, $fontsize) = @_; 1593 my ($self, $fontsize) = @_;
1458 1594
1459 $self->{fontsize} = $fontsize; 1595 $self->{fontsize} = $fontsize;
1460 delete $self->{texture}; 1596 delete $self->{texture};
1461 1597
1462 $self->update; 1598 $self->realloc;
1463 $self->check_size;
1464} 1599}
1465 1600
1466sub _draw { 1601sub _draw {
1467 my ($self) = @_; 1602 my ($self) = @_;
1468 1603
… …
1474 $self->{layout}->set_width ($self->{w}); 1609 $self->{layout}->set_width ($self->{w});
1475 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1610 $self->{layout}->set_ellipsise ($self->{ellipsise});
1476 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1611 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1477 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1612 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1478 1613
1479 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1614 new_from_layout CFClient::Texture $self->{layout}
1615 };
1480 1616
1617 unless (exists $self->{ox}) {
1481 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1618 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1482 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1619 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1483 : ($self->{w} - $tex->{w}) * 0.5); 1620 : ($self->{w} - $tex->{w}) * 0.5);
1484 1621
1485 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1622 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1486 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1623 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1487 : ($self->{h} - $tex->{h}) * 0.5); 1624 : ($self->{h} - $tex->{h}) * 0.5);
1488
1489 $tex
1490 }; 1625 };
1491 1626
1492 glEnable GL_TEXTURE_2D; 1627 glEnable GL_TEXTURE_2D;
1493 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1628 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1494 1629
… …
1548sub set_text { 1683sub set_text {
1549 my ($self, $text) = @_; 1684 my ($self, $text) = @_;
1550 1685
1551 $self->{cursor} = length $text; 1686 $self->{cursor} = length $text;
1552 $self->_set_text ($text); 1687 $self->_set_text ($text);
1553 $self->update; 1688
1554 $self->check_size; 1689 $self->realloc;
1555} 1690}
1556 1691
1557sub get_text { 1692sub get_text {
1558 $_[0]{text} 1693 $_[0]{text}
1559} 1694}
… …
1562 my ($self) = @_; 1697 my ($self) = @_;
1563 1698
1564 my ($w, $h) = $self->SUPER::size_request; 1699 my ($w, $h) = $self->SUPER::size_request;
1565 1700
1566 ($w + 1, $h) # add 1 for cursor 1701 ($w + 1, $h) # add 1 for cursor
1567}
1568
1569sub size_allocate {
1570 my ($self, $w, $h) = @_;
1571
1572 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1573} 1702}
1574 1703
1575sub key_down { 1704sub key_down {
1576 my ($self, $ev) = @_; 1705 my ($self, $ev) = @_;
1577 1706
… …
1595 $self->{cursor} = length $text; 1724 $self->{cursor} = length $text;
1596 } elsif ($uni == 27) { 1725 } elsif ($uni == 27) {
1597 $self->_emit ('escape'); 1726 $self->_emit ('escape');
1598 } elsif ($uni) { 1727 } elsif ($uni) {
1599 substr $text, $self->{cursor}++, 0, chr $uni; 1728 substr $text, $self->{cursor}++, 0, chr $uni;
1729 } else {
1730 return 0;
1600 } 1731 }
1601 1732
1602 $self->_set_text ($text); 1733 $self->_set_text ($text);
1603 $self->update; 1734
1604 $self->check_size; 1735 $self->realloc;
1736
1737 1
1605} 1738}
1606 1739
1607sub focus_in { 1740sub focus_in {
1608 my ($self) = @_; 1741 my ($self) = @_;
1609 1742
… …
1624 utf8::encode $text; 1757 utf8::encode $text;
1625 $self->{cursor} = length substr $text, 0, $idx; 1758 $self->{cursor} = length substr $text, 0, $idx;
1626 1759
1627 $self->_set_text ($self->{text}); 1760 $self->_set_text ($self->{text});
1628 $self->update; 1761 $self->update;
1762
1763 1
1629} 1764}
1630 1765
1631sub mouse_motion { 1766sub mouse_motion {
1632 my ($self, $ev, $x, $y) = @_; 1767 my ($self, $ev, $x, $y) = @_;
1633# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1768# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1769
1770 0
1634} 1771}
1635 1772
1636sub _draw { 1773sub _draw {
1637 my ($self) = @_; 1774 my ($self) = @_;
1638 1775
… …
1715 } else { 1852 } else {
1716 $self->set_text ($self->{history_saveback}); 1853 $self->set_text ($self->{history_saveback});
1717 } 1854 }
1718 1855
1719 } else { 1856 } else {
1720 $self->SUPER::key_down ($ev); 1857 return $self->SUPER::key_down ($ev)
1858 }
1859
1721 } 1860 1
1722
1723} 1861}
1724 1862
1725############################################################################# 1863#############################################################################
1726 1864
1727package CFClient::UI::Button; 1865package CFClient::UI::Button;
… …
1736 1874
1737sub new { 1875sub new {
1738 my $class = shift; 1876 my $class = shift;
1739 1877
1740 $class->SUPER::new ( 1878 $class->SUPER::new (
1741 padding => 4, 1879 padding_x => 4,
1880 padding_y => 4,
1742 fg => [1, 1, 1], 1881 fg => [1, 1, 1],
1743 active_fg => [0, 0, 1], 1882 active_fg => [0, 0, 1],
1744 can_hover => 1, 1883 can_hover => 1,
1745 align => 0, 1884 align => 0,
1746 valign => 0, 1885 valign => 0,
… …
1755 my ($self, $ev, $x, $y) = @_; 1894 my ($self, $ev, $x, $y) = @_;
1756 1895
1757 $self->emit ("activate") 1896 $self->emit ("activate")
1758 if $x >= 0 && $x < $self->{w} 1897 if $x >= 0 && $x < $self->{w}
1759 && $y >= 0 && $y < $self->{h}; 1898 && $y >= 0 && $y < $self->{h};
1899
1900 1
1760} 1901}
1761 1902
1762sub _draw { 1903sub _draw {
1763 my ($self) = @_; 1904 my ($self) = @_;
1764 1905
… …
1793 1934
1794sub new { 1935sub new {
1795 my $class = shift; 1936 my $class = shift;
1796 1937
1797 $class->SUPER::new ( 1938 $class->SUPER::new (
1798 padding => 2, 1939 padding_x => 2,
1940 padding_y => 2,
1799 fg => [1, 1, 1], 1941 fg => [1, 1, 1],
1800 active_fg => [1, 1, 0], 1942 active_fg => [1, 1, 0],
1801 bg => [0, 0, 0, 0.2], 1943 bg => [0, 0, 0, 0.2],
1802 active_bg => [1, 1, 1, 0.5], 1944 active_bg => [1, 1, 1, 0.5],
1803 state => 0, 1945 state => 0,
… …
1807} 1949}
1808 1950
1809sub size_request { 1951sub size_request {
1810 my ($self) = @_; 1952 my ($self) = @_;
1811 1953
1812 ($self->{padding} * 2 + 6) x 2 1954 (6) x 2
1813} 1955}
1814 1956
1815sub button_down { 1957sub button_down {
1816 my ($self, $ev, $x, $y) = @_; 1958 my ($self, $ev, $x, $y) = @_;
1817 1959
1818 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1960 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1819 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1961 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1820 $self->{state} = !$self->{state}; 1962 $self->{state} = !$self->{state};
1821 $self->_emit (changed => $self->{state}); 1963 $self->_emit (changed => $self->{state});
1964 } else {
1965 return 0
1966 }
1967
1822 } 1968 1
1823} 1969}
1824 1970
1825sub _draw { 1971sub _draw {
1826 my ($self) = @_; 1972 my ($self) = @_;
1827 1973
1828 $self->SUPER::_draw; 1974 $self->SUPER::_draw;
1829 1975
1830 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1976 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1831 1977
1832 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1978 my ($w, $h) = @$self{qw(w h)};
1979
1980 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1833 1981
1834 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1982 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1835 1983
1836 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1984 my $tex = $self->{state} ? $tex[1] : $tex[0];
1837 1985
… …
2102 fg => [1, 1, 1], 2250 fg => [1, 1, 1],
2103 active_fg => [0, 0, 0], 2251 active_fg => [0, 0, 0],
2104 bg => [0, 0, 0, 0.2], 2252 bg => [0, 0, 0, 0.2],
2105 active_bg => [1, 1, 1, 0.5], 2253 active_bg => [1, 1, 1, 0.5],
2106 range => [0, 0, 100, 10, 0], 2254 range => [0, 0, 100, 10, 0],
2107 req_w => $::WIDTH / 80, 2255 min_w => $::WIDTH / 80,
2108 req_h => $::WIDTH / 80, 2256 min_h => $::WIDTH / 80,
2109 vertical => 0, 2257 vertical => 0,
2110 can_hover => 1, 2258 can_hover => 1,
2111 inner_pad => 0.02, 2259 inner_pad => 0.02,
2112 @_ 2260 @_
2113 ); 2261 );
… …
2116 $self->update; 2264 $self->update;
2117 2265
2118 $self 2266 $self
2119} 2267}
2120 2268
2269sub changed { }
2270
2121sub set_range { 2271sub set_range {
2122 my ($self, $range) = @_; 2272 my ($self, $range) = @_;
2123 2273
2124 $self->{range} = $range; 2274 ($range, $self->{range}) = ($self->{range}, $range);
2125 2275
2126 $self->update; 2276 $self->update
2277 if "@$range" ne "@{$self->{range}}";
2127} 2278}
2128 2279
2129sub set_value { 2280sub set_value {
2130 my ($self, $value) = @_; 2281 my ($self, $value) = @_;
2131 2282
… …
2150} 2301}
2151 2302
2152sub size_request { 2303sub size_request {
2153 my ($self) = @_; 2304 my ($self) = @_;
2154 2305
2155 my $w = $self->{req_w}; 2306 ($self->{req_w}, $self->{req_h})
2156 my $h = $self->{req_h};
2157
2158 $self->{vertical} ? ($h, $w) : ($w, $h)
2159} 2307}
2160 2308
2161sub button_down { 2309sub button_down {
2162 my ($self, $ev, $x, $y) = @_; 2310 my ($self, $ev, $x, $y) = @_;
2163 2311
2164 $self->SUPER::button_down ($ev, $x, $y); 2312 $self->SUPER::button_down ($ev, $x, $y);
2165 2313
2166 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2314 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2167 2315
2168 $self->mouse_motion ($ev, $x, $y); 2316 $self->mouse_motion ($ev, $x, $y)
2169} 2317}
2170 2318
2171sub mouse_motion { 2319sub mouse_motion {
2172 my ($self, $ev, $x, $y) = @_; 2320 my ($self, $ev, $x, $y) = @_;
2173 2321
… …
2177 my (undef, $lo, $hi, $page) = @{$self->{range}}; 2325 my (undef, $lo, $hi, $page) = @{$self->{range}};
2178 2326
2179 $x = ($x - $self->{click}[1]) / ($w * $self->{scale}); 2327 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2180 2328
2181 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); 2329 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2330 } else {
2331 return 0;
2332 }
2333
2182 } 2334 1
2183} 2335}
2184 2336
2185sub update { 2337sub update {
2186 my ($self) = @_; 2338 my ($self) = @_;
2187 2339
… …
2514 2666
2515sub new { 2667sub new {
2516 my $class = shift; 2668 my $class = shift;
2517 2669
2518 my $self = $class->SUPER::new ( 2670 my $self = $class->SUPER::new (
2519 state => 0, 2671 state => 0,
2520 connect_activate => \&toggle_flopper, 2672 on_activate => \&toggle_flopper,
2521 @_ 2673 @_
2522 ); 2674 );
2523 2675
2524 if ($self->{state}) {
2525 $self->{state} = 0;
2526 $self->toggle_flopper;
2527 }
2528
2529 $self 2676 $self
2530} 2677}
2531 2678
2532sub toggle_flopper { 2679sub toggle_flopper {
2533 my ($self) = @_; 2680 my ($self) = @_;
2534 2681
2535 # TODO: use animation 2682 $self->{other}->toggle_visibility;
2536 if ($self->{state} = !$self->{state}) {
2537 $CFClient::UI::ROOT->add ($self->{other});
2538 $self->{other}->move ($self->coord2global (0, $self->{h}));
2539 $self->_emit ("open");
2540 } else {
2541 $CFClient::UI::ROOT->remove ($self->{other});
2542 $self->_emit ("close");
2543 }
2544
2545 $self->_emit (changed => $self->{state});
2546} 2683}
2547 2684
2548############################################################################# 2685#############################################################################
2549 2686
2550package CFClient::UI::Tooltip; 2687package CFClient::UI::Tooltip;
… …
2563} 2700}
2564 2701
2565sub set_tooltip_from { 2702sub set_tooltip_from {
2566 my ($self, $widget) = @_; 2703 my ($self, $widget) = @_;
2567 2704
2705 my $tooltip = $widget->{tooltip};
2706
2707 if ($ENV{CFPLUS_DEBUG} & 2) {
2708 $tooltip .= "\n\n" . (ref $widget) . "\n"
2709 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2710 . "req $widget->{req_w} $widget->{req_h}\n"
2711 . "visible $widget->{visible}";
2712 }
2713
2568 $self->add (new CFClient::UI::Label 2714 $self->add (new CFClient::UI::Label
2569 markup => $widget->{tooltip}, 2715 markup => $tooltip,
2570 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2716 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2571 fontsize => 0.8, 2717 fontsize => 0.8,
2572 fg => [0, 0, 0, 1], 2718 fg => [0, 0, 0, 1],
2573 ellipsise => 0, 2719 ellipsise => 0,
2574 font => ($widget->{tooltip_font} || $::FONT_PROP), 2720 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2585 2731
2586sub size_allocate { 2732sub size_allocate {
2587 my ($self, $w, $h) = @_; 2733 my ($self, $w, $h) = @_;
2588 2734
2589 $self->SUPER::size_allocate ($w - 4, $h - 4); 2735 $self->SUPER::size_allocate ($w - 4, $h - 4);
2736}
2737
2738sub visibility_change {
2739 my ($self, $visible) = @_;
2740
2741 return unless $visible;
2742
2743 $self->{root}->on_post_alloc ("move_$self" => sub {
2744 my $widget = $self->{owner}
2745 or return;
2746
2747 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2748
2749 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2750 if $x + $self->{w} > $::WIDTH;
2751
2752 $self->move_abs ($x, $y);
2753 });
2590} 2754}
2591 2755
2592sub _draw { 2756sub _draw {
2593 my ($self) = @_; 2757 my ($self) = @_;
2594 2758
… …
2611 glVertex $w, $h; 2775 glVertex $w, $h;
2612 glVertex $w, 0; 2776 glVertex $w, 0;
2613 glEnd; 2777 glEnd;
2614 2778
2615 glTranslate 2 - 0.375, 2 - 0.375; 2779 glTranslate 2 - 0.375, 2 - 0.375;
2780
2616 $self->SUPER::_draw; 2781 $self->SUPER::_draw;
2617} 2782}
2618 2783
2619############################################################################# 2784#############################################################################
2620 2785
… …
2626 2791
2627sub new { 2792sub new {
2628 my $class = shift; 2793 my $class = shift;
2629 2794
2630 my $self = $class->SUPER::new ( 2795 my $self = $class->SUPER::new (
2631 aspect => 1, 2796 aspect => 1,
2797 can_events => 0,
2632 @_, 2798 @_,
2633 ); 2799 );
2634 2800
2635 if ($self->{anim} && $self->{animspeed}) { 2801 if ($self->{anim} && $self->{animspeed}) {
2636 Scalar::Util::weaken (my $widget = $self); 2802 Scalar::Util::weaken (my $widget = $self);
… …
2695 $self->SUPER::DESTROY; 2861 $self->SUPER::DESTROY;
2696} 2862}
2697 2863
2698############################################################################# 2864#############################################################################
2699 2865
2700package CFClient::UI::InventoryItem; 2866package CFClient::UI::Buttonbar;
2701 2867
2702our @ISA = CFClient::UI::HBox::; 2868our @ISA = CFClient::UI::HBox::;
2703 2869
2704sub _item_to_desc { 2870# TODO: should actualyl wrap buttons and other goodies.
2705 my ($item) = @_;
2706
2707 my $desc =
2708 $item->{nrof} < 2
2709 ? $item->{name}
2710 : "$item->{nrof} × $item->{name_pl}";
2711
2712 $item->{flags} & Crossfire::Protocol::F_OPEN
2713 and $desc .= " (open)";
2714 $item->{flags} & Crossfire::Protocol::F_APPLIED
2715 and $desc .= " (applied)";
2716 $item->{flags} & Crossfire::Protocol::F_UNPAID
2717 and $desc .= " (unpaid)";
2718 $item->{flags} & Crossfire::Protocol::F_MAGIC
2719 and $desc .= " (magic)";
2720 $item->{flags} & Crossfire::Protocol::F_CURSED
2721 and $desc .= " (cursed)";
2722 $item->{flags} & Crossfire::Protocol::F_DAMNED
2723 and $desc .= " (damned)";
2724 $item->{flags} & Crossfire::Protocol::F_LOCKED
2725 and $desc .= " *";
2726
2727 $desc
2728}
2729
2730sub new {
2731 my $class = shift;
2732
2733 my %args = @_;
2734
2735 my $item = delete $args{item};
2736
2737 my $desc = _item_to_desc ($item);
2738
2739 my $self = $class->SUPER::new (
2740 can_hover => 1,
2741 can_events => 1,
2742 tooltip => ((CFClient::UI::Label::escape $desc)
2743 . "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2744 connect_button_down => sub {
2745 my ($self, $ev, $x, $y) = @_;
2746
2747 # todo: maybe put examine on 1? but should just be a tooltip :(
2748 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2749 my $targ = $::CONN->{player}{tag};
2750
2751 if ($item->{container} == $::CONN->{player}{tag}) {
2752 $targ = $main::OPENCONT;
2753 }
2754
2755 $::CONN->send ("move $targ $item->{tag} 0");
2756 } elsif ($ev->{button} == 1) {
2757 $::CONN->send ("examine $item->{tag}");
2758 } elsif ($ev->{button} == 2) {
2759 $::CONN->send ("apply $item->{tag}");
2760 } elsif ($ev->{button} == 3) {
2761 my @menu_items = (
2762 ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2763 ["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2764 ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2765 (
2766 $item->{flags} & Crossfire::Protocol::F_LOCKED
2767 ? (
2768 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2769 )
2770 : (
2771 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2772 ["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2773 )
2774 ),
2775 );
2776
2777 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2778 }
2779
2780 1
2781 },
2782 %args
2783 );
2784
2785
2786 $self->add (new CFClient::UI::Face
2787 can_events => 0,
2788 face => $item->{face},
2789 anim => $item->{anim},
2790 animspeed => $item->{animspeed},
2791 );
2792
2793 $self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2794
2795 $self->{item} = $item;
2796
2797 $self->update_item;
2798
2799 $self
2800}
2801
2802sub update_item {
2803 my ($self) = @_;
2804
2805 my $desc = _item_to_desc ($self->{item});
2806
2807 $self->{name_lbl}->set_text ($desc);
2808}
2809
2810#############################################################################
2811
2812package CFClient::UI::Inventory;
2813
2814our @ISA = CFClient::UI::ScrolledWindow::;
2815
2816sub new {
2817 my $class = shift;
2818
2819 my $self = $class->SUPER::new (
2820 scrolled => (new CFClient::UI::Table),
2821 @_,
2822 );
2823
2824 $self
2825}
2826
2827sub set_items {
2828 my ($self, $items) = @_;
2829
2830 $self->{scrolled}->clear;
2831 return unless $items;
2832
2833 my @items = sort {
2834 ($a->{type} <=> $b->{type})
2835 or ($a->{name} cmp $b->{name})
2836 } @$items;
2837
2838 $self->{real_items} = \@items;
2839
2840 for my $item (@items) {
2841 $item->{item} = $item;
2842 $item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2843 $item->update_item ();
2844 }
2845
2846 my $i = 0;
2847 for (@items) {
2848 $self->{scrolled}->add (0, $i, $_);
2849 my $nrof = $_->{item}->{nrof} || 1;
2850 $self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2851 }
2852
2853# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2854}
2855
2856sub size_request {
2857 my ($self) = @_;
2858 ($self->{req_w}, $self->{req_h});
2859}
2860 2871
2861############################################################################# 2872#############################################################################
2862 2873
2863package CFClient::UI::Menu; 2874package CFClient::UI::Menu;
2864 2875
… …
2905 # maybe save $GRAB? must be careful about events... 2916 # maybe save $GRAB? must be careful about events...
2906 $GRAB = $self; 2917 $GRAB = $self;
2907 $self->{button} = $ev->{button}; 2918 $self->{button} = $ev->{button};
2908 2919
2909 $self->show; 2920 $self->show;
2910 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2921 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2911} 2922}
2912 2923
2913sub mouse_motion { 2924sub mouse_motion {
2914 my ($self, $ev, $x, $y) = @_; 2925 my ($self, $ev, $x, $y) = @_;
2915 2926
2916 # TODO: should use vbox->find_widget or so 2927 # TODO: should use vbox->find_widget or so
2917 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 2928 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2918 $self->{hover} = $self->{item}{$HOVER}; 2929 $self->{hover} = $self->{item}{$HOVER};
2930
2931 0
2919} 2932}
2920 2933
2921sub button_up { 2934sub button_up {
2922 my ($self, $ev, $x, $y) = @_; 2935 my ($self, $ev, $x, $y) = @_;
2923 2936
… …
2925 undef $GRAB; 2938 undef $GRAB;
2926 $self->hide; 2939 $self->hide;
2927 2940
2928 $self->_emit ("popdown"); 2941 $self->_emit ("popdown");
2929 $self->{hover}[1]->() if $self->{hover}; 2942 $self->{hover}[1]->() if $self->{hover};
2943 } else {
2944 return 0
2945 }
2946
2930 } 2947 1
2948}
2949
2950#############################################################################
2951
2952package CFClient::UI::Multiplexer;
2953
2954our @ISA = CFClient::UI::Container::;
2955
2956sub new {
2957 my $class = shift;
2958
2959 my $self = $class->SUPER::new (
2960 @_,
2961 );
2962
2963 $self->{current} = $self->{children}[0]
2964 if @{ $self->{children} };
2965
2966 $self
2967}
2968
2969sub add {
2970 my ($self, @widgets) = @_;
2971
2972 $self->SUPER::add (@widgets);
2973
2974 $self->{current} = $self->{children}[0]
2975 if @{ $self->{children} };
2976}
2977
2978sub set_current_page {
2979 my ($self, $page_or_widget) = @_;
2980
2981 my $widget = ref $page_or_widget
2982 ? $page_or_widget
2983 : $self->{children}[$page_or_widget];
2984
2985 $self->{current} = $widget;
2986 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
2987
2988 $self->_emit (page_changed => $self->{current});
2989
2990 $self->realloc;
2991}
2992
2993sub visible_children {
2994 $_[0]{current}
2995}
2996
2997sub size_request {
2998 my ($self) = @_;
2999
3000 $self->{current}->size_request
3001}
3002
3003sub size_allocate {
3004 my ($self, $w, $h) = @_;
3005
3006 $self->{current}->configure (0, 0, $w, $h);
3007}
3008
3009sub _draw {
3010 my ($self) = @_;
3011
3012 $self->{current}->draw;
3013}
3014
3015#############################################################################
3016
3017package CFClient::UI::Notebook;
3018
3019our @ISA = CFClient::UI::VBox::;
3020
3021sub new {
3022 my $class = shift;
3023
3024 my $self = $class->SUPER::new (
3025 buttonbar => (new CFClient::UI::Buttonbar),
3026 multiplexer => (new CFClient::UI::Multiplexer expand => 1),
3027 @_,
3028 );
3029
3030 $self->SUPER::add ($self->{buttonbar}, $self->{multiplexer});
3031
3032 $self
3033}
3034
3035sub add {
3036 my ($self, $title, $widget, $tooltip) = @_;
3037
3038 Scalar::Util::weaken $self;
3039
3040 $self->{buttonbar}->add (new CFClient::UI::Button
3041 markup => $title,
3042 tooltip => $tooltip,
3043 on_activate => sub { $self->set_current_page ($widget) },
3044 );
3045
3046 $self->{multiplexer}->add ($widget);
3047}
3048
3049sub set_current_page {
3050 my ($self, $page) = @_;
3051
3052 $self->{multiplexer}->set_current_page ($page);
3053 $self->_emit (page_changed => $self->{multiplexer}{current});
2931} 3054}
2932 3055
2933############################################################################# 3056#############################################################################
2934 3057
2935package CFClient::UI::Statusbox; 3058package CFClient::UI::Statusbox;
… …
2995sub add { 3118sub add {
2996 my ($self, $text, %arg) = @_; 3119 my ($self, $text, %arg) = @_;
2997 3120
2998 $text =~ s/^\s+//; 3121 $text =~ s/^\s+//;
2999 $text =~ s/\s+$//; 3122 $text =~ s/\s+$//;
3123
3124 return unless $text;
3000 3125
3001 my $timeout = time + ((delete $arg{timeout}) || 60); 3126 my $timeout = time + ((delete $arg{timeout}) || 60);
3002 3127
3003 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 3128 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
3004 3129
… …
3038 $self->SUPER::reconfigure; 3163 $self->SUPER::reconfigure;
3039} 3164}
3040 3165
3041############################################################################# 3166#############################################################################
3042 3167
3043package CFClient::UI::Root; 3168package CFClient::UI::Inventory;
3044 3169
3045our @ISA = CFClient::UI::Container::; 3170our @ISA = CFClient::UI::ScrolledWindow::;
3046
3047use CFClient::OpenGL;
3048 3171
3049sub new { 3172sub new {
3050 my $class = shift; 3173 my $class = shift;
3051 3174
3052 $class->SUPER::new ( 3175 my $self = $class->SUPER::new (
3176 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3177 @_,
3178 );
3179
3180 $self
3181}
3182
3183sub set_items {
3184 my ($self, $items) = @_;
3185
3186 $self->{scrolled}->clear;
3187 return unless $items;
3188
3189 my @items = sort {
3190 ($a->{type} <=> $b->{type})
3191 or ($a->{name} cmp $b->{name})
3192 } @$items;
3193
3194 $self->{real_items} = \@items;
3195
3196 my $row = 0;
3197 for my $item (@items) {
3198 CFClient::Item::update_widgets $item;
3199
3200 $self->{scrolled}->add (0, $row, $item->{face_widget});
3201 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3202 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3203
3204 $row++;
3205 }
3206}
3207
3208#############################################################################
3209
3210package CFClient::UI::BindEditor;
3211
3212our @ISA = CFClient::UI::FancyFrame::;
3213
3214sub new {
3215 my $class = shift;
3216
3217 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3218
3219 $self->add (my $vb = new CFClient::UI::VBox);
3220
3221
3222 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3223 text => "start recording",
3224 tooltip => "Start/Stops recording of actions."
3225 ."All subsequent actions after the recording started will be captured."
3226 ."The actions are displayed after the record was stopped."
3227 ."To bind the action you have to click on the 'Bind' button",
3228 on_activate => sub {
3229 unless ($self->{recording}) {
3230 $self->start;
3231 } else {
3232 $self->stop;
3233 }
3234 });
3235
3236 $vb->add (new CFClient::UI::Label text => "Actions:");
3237 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3238
3239 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3240 $vb->add (my $hb = new CFClient::UI::HBox);
3241 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3242 $hb->add (new CFClient::UI::Button
3243 text => "bind",
3244 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3245 on_activate => sub {
3246 $self->ask_for_bind;
3247 });
3248
3249 $vb->add (my $hb = new CFClient::UI::HBox);
3250 $hb->add (new CFClient::UI::Button
3251 text => "ok",
3252 expand => 1,
3253 tooltip => "This closes the binding editor and saves the binding",
3254 on_activate => sub {
3255 $self->hide;
3256 $self->commit;
3257 });
3258
3259 $hb->add (new CFClient::UI::Button
3260 text => "cancel",
3261 expand => 1,
3262 tooltip => "This closes the binding editor without saving",
3263 on_activate => sub {
3264 $self->hide;
3265 $self->{binding_cancel}->()
3266 if $self->{binding_cancel};
3267 });
3268
3269 $self->update_binding_widgets;
3270
3271 $self
3272}
3273
3274sub commit {
3275 my ($self) = @_;
3276 my ($mod, $sym, $cmds) = $self->get_binding;
3277 if ($sym != 0 && @$cmds > 0) {
3278 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3279 ."'. Don't forget 'Save Config'!");
3280 $self->{binding_change}->($mod, $sym, $cmds)
3281 if $self->{binding_change};
3282 } else {
3283 $::STATUSBOX->add ("No action bound, no key or action specified!");
3284 $self->{binding_cancel}->()
3285 if $self->{binding_cancel};
3286 }
3287}
3288
3289sub start {
3290 my ($self) = @_;
3291
3292 $self->{rec_btn}->set_text ("stop recording");
3293 $self->{recording} = 1;
3294 $self->clear_command_list;
3295 $::CONN->start_record if $::CONN;
3296}
3297
3298sub stop {
3299 my ($self) = @_;
3300
3301 $self->{rec_btn}->set_text ("start recording");
3302 $self->{recording} = 0;
3303
3304 my $rec;
3305 $rec = $::CONN->stop_record if $::CONN;
3306 return unless ref $rec eq 'ARRAY';
3307 $self->set_command_list ($rec);
3308}
3309
3310
3311sub ask_for_bind_and_commit {
3312 my ($self) = @_;
3313 $self->ask_for_bind (1);
3314}
3315
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::Label text => $_);
3392 $hb->add (new CFClient::UI::Button
3393 text => "delete",
3394 tooltip => "Deletes the action from the record",
3395 on_activate => sub {
3396 $self->{cmdbox}->remove ($hb);
3397 $cmds->[$i] = undef;
3398 });
3399
3400
3401 $idx++
3402 }
3403}
3404
3405#############################################################################
3406
3407package CFClient::UI::SpellList;
3408
3409our @ISA = CFClient::UI::ScrolledWindow::;
3410
3411sub new {
3412 my $class = shift;
3413
3414 my $self = $class->SUPER::new (
3415 binding => [],
3416 commands => [],
3417 scrolled => (new CFClient::UI::Table),
3053 @_, 3418 @_,
3054 ) 3419 )
3055} 3420}
3056 3421
3057sub configure { 3422# XXX: Do sorting? Argl...
3058 my ($self, $x, $y, $w, $h) = @_; 3423sub add_spell {
3059
3060 $self->{w} = $w;
3061 $self->{h} = $h;
3062}
3063
3064sub check_size {
3065 my ($self) = @_; 3424 my ($self, $spell) = @_;
3425 $self->{spells}->{$spell->{name}} = $spell;
3066 3426
3067 $self->size_allocate ($self->{w}, $self->{h}) 3427 $self->{scrolled}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3068 if $self->{w}; 3428 face => $spell->{face},
3429 can_hover => 1,
3430 can_events => 1,
3431 tooltip => $spell->{message});
3432
3433 $self->{scrolled}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3434 text => $spell->{name},
3435 can_hover => 1,
3436 can_events => 1,
3437 tooltip => $spell->{message},
3438 expand => 1);
3439
3440 $self->{scrolled}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3441 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3442 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3443 expand => 1);
3444
3445 $self->{scrolled}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3446 text => "bind to key",
3447 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3448}
3449
3450sub rebuild_spell_list {
3451 my ($self) = @_;
3452 $self->{tbl_idx} = 0;
3453 $self->add_spell ($_) for values %{$self->{spells}};
3454}
3455
3456sub remove_spell {
3457 my ($self, $spell) = @_;
3458 delete $self->{spells}->{$spell->{name}};
3459 $self->rebuild_spell_list;
3460}
3461
3462#############################################################################
3463
3464package CFClient::UI::Root;
3465
3466our @ISA = CFClient::UI::Container::;
3467
3468use CFClient::OpenGL;
3469
3470sub new {
3471 my $class = shift;
3472
3473 my $self = $class->SUPER::new (
3474 visible => 1,
3475 @_,
3476 );
3477
3478 Scalar::Util::weaken ($self->{root} = $self);
3479
3480 $self
3069} 3481}
3070 3482
3071sub size_request { 3483sub size_request {
3072 my ($self) = @_; 3484 my ($self) = @_;
3073 3485
3074 ($self->{w}, $self->{h}) 3486 ($self->{w}, $self->{h})
3487}
3488
3489sub _to_pixel {
3490 my ($coord, $size, $max) = @_;
3491
3492 $coord =
3493 $coord eq "center" ? ($max - $size) * 0.5
3494 : $coord eq "max" ? $max
3495 : $coord;
3496
3497 $coord = 0 if $coord < 0;
3498 $coord = $max - $size if $coord > $max - $size;
3499
3500 int $coord + 0.5
3075} 3501}
3076 3502
3077sub size_allocate { 3503sub size_allocate {
3078 my ($self, $w, $h) = @_; 3504 my ($self, $w, $h) = @_;
3079 3505
3080 for my $child ($self->children) { 3506 for my $child ($self->children) {
3081 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3507 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3082 3508
3083 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3509 $X = $child->{force_x} if exists $child->{force_x};
3084 if exists $child->{req_x}; 3510 $Y = $child->{force_y} if exists $child->{force_y};
3085 3511
3086 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3512 $X = _to_pixel $X, $W, $self->{w};
3087 if exists $child->{req_y}; 3513 $Y = _to_pixel $Y, $H, $self->{h};
3088
3089 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3090 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3091 3514
3092 $child->configure ($X, $Y, $W, $H); 3515 $child->configure ($X, $Y, $W, $H);
3093 } 3516 }
3094} 3517}
3095 3518
… …
3106} 3529}
3107 3530
3108sub update { 3531sub update {
3109 my ($self) = @_; 3532 my ($self) = @_;
3110 3533
3111 $self->check_size;
3112 $::WANT_REFRESH++; 3534 $::WANT_REFRESH++;
3113} 3535}
3114 3536
3115sub add { 3537sub add {
3116 my ($self, @children) = @_; 3538 my ($self, @children) = @_;
3117 3539
3118 for (my @widgets = @children; my $w = pop @widgets; ) {
3119 push @widgets, $w->children;
3120 $w->{root} = $self;
3121 $w->{visible} = 1;
3122 }
3123
3124 for my $child (@children) {
3125 $child->{is_toplevel} = 1; 3540 $_->{is_toplevel} = 1
3126 3541 for @children;
3127 # integerise window positions
3128 $child->{x} = int $child->{x};
3129 $child->{y} = int $child->{y};
3130 }
3131 3542
3132 $self->SUPER::add (@children); 3543 $self->SUPER::add (@children);
3133} 3544}
3134 3545
3135sub remove { 3546sub remove {
3136 my ($self, @children) = @_; 3547 my ($self, @children) = @_;
3137 3548
3138 $self->SUPER::remove (@children); 3549 $self->SUPER::remove (@children);
3550
3551 delete $self->{is_toplevel}
3552 for @children;
3139 3553
3140 while (@children) { 3554 while (@children) {
3141 my $w = pop @children; 3555 my $w = pop @children;
3142 push @children, $w->children; 3556 push @children, $w->children;
3143 $w->set_invisible; 3557 $w->set_invisible;
… …
3162 while ($self->{refresh_hook}) { 3576 while ($self->{refresh_hook}) {
3163 $_->() 3577 $_->()
3164 for values %{delete $self->{refresh_hook}}; 3578 for values %{delete $self->{refresh_hook}};
3165 } 3579 }
3166 3580
3167 if ($self->{check_size}) { 3581 if ($self->{realloc}) {
3168 my @queue = ([], []); 3582 my %queue;
3583 my @queue;
3584 my $widget;
3169 3585
3170 for (;;) { 3586 outer:
3171 if ($self->{check_size}) { 3587 while () {
3172 # heuristic: check containers last 3588 if (my $realloc = delete $self->{realloc}) {
3173 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3589 for $widget (values %$realloc) {
3174 for values %{delete $self->{check_size}} 3590 $widget->{visible} or next; # do not resize invisible widgets
3591
3592 $queue{$widget+0}++ and next; # duplicates are common
3593
3594 push @{ $queue[$widget->{visible}] }, $widget;
3595 }
3175 } 3596 }
3176 3597
3177 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3598 while () {
3599 @queue or last outer;
3178 3600
3179 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3601 $widget = pop @{ $queue[-1] || [] }
3180 ? @$widget{qw(user_w user_h)} 3602 and last;
3181 : $widget->size_request;
3182
3183 if (delete $widget->{force_alloc}
3184 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3185 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3186 3603
3604 pop @queue;
3605 }
3606
3607 delete $queue{$widget+0};
3608
3609 my ($w, $h) = $widget->size_request;
3610
3611 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3612 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3613
3614 $w = $widget->{force_w} if exists $widget->{force_w};
3615 $h = $widget->{force_h} if exists $widget->{force_h};
3616
3617 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3618 || delete $widget->{force_realloc}) {
3187 $widget->{req_w} = $w; 3619 $widget->{req_w} = $w;
3188 $widget->{req_h} = $h; 3620 $widget->{req_h} = $h;
3189 3621
3190 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3622 $self->{size_alloc}{$widget+0} = $widget;
3191 3623
3192 $widget->{parent}->check_size
3193 if $widget->{parent}; 3624 if (my $parent = $widget->{parent}) {
3625 $self->{realloc}{$parent+0} = $parent
3626 unless $queue{$parent+0};
3627
3628 $parent->{force_size_alloc} = 1;
3629 $self->{size_alloc}{$parent+0} = $parent;
3630 }
3194 } 3631 }
3632
3633 delete $self->{realloc}{$widget+0};
3195 } 3634 }
3196 } 3635 }
3197 3636
3198 while ($self->{size_alloc}) { 3637 while (my $size_alloc = delete $self->{size_alloc}) {
3199 for (values %{delete $self->{size_alloc}}) { 3638 my @queue = sort { $b->{visible} <=> $a->{visible} }
3200 my ($widget, $w, $h) = @$_; 3639 values %$size_alloc;
3640
3641 while () {
3642 my $widget = pop @queue || last;
3643
3644 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3201 3645
3202 $w = 0 if $w < 0; 3646 $w = 0 if $w < 0;
3203 $h = 0 if $h < 0; 3647 $h = 0 if $h < 0;
3204 3648
3649 $w = int $w + 0.5;
3650 $h = int $h + 0.5;
3651
3652 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3653 $widget->{old_w} = $widget->{w};
3654 $widget->{old_h} = $widget->{h};
3655
3205 $widget->{w} = $w; 3656 $widget->{w} = $w;
3206 $widget->{h} = $h; 3657 $widget->{h} = $h;
3658
3207 $widget->emit (size_allocate => $w, $h); 3659 $widget->emit (size_allocate => $w, $h);
3660 }
3208 } 3661 }
3209 } 3662 }
3210 3663
3211 while ($self->{post_alloc_hook}) { 3664 while ($self->{post_alloc_hook}) {
3212 $_->() 3665 $_->()
3213 for values %{delete $self->{post_alloc_hook}}; 3666 for values %{delete $self->{post_alloc_hook}};
3214 } 3667 }
3668
3215 3669
3216 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3670 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3217 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3671 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3218 glClear GL_COLOR_BUFFER_BIT; 3672 glClear GL_COLOR_BUFFER_BIT;
3219 3673
… …
3221 glLoadIdentity; 3675 glLoadIdentity;
3222 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 3676 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3223 glMatrixMode GL_MODELVIEW; 3677 glMatrixMode GL_MODELVIEW;
3224 glLoadIdentity; 3678 glLoadIdentity;
3225 3679
3680 {
3681 package CFClient::UI::Base;
3682
3683 ($draw_x, $draw_y, $draw_w, $draw_h) =
3684 (0, 0, $self->{w}, $self->{h});
3685 }
3686
3226 $self->_draw; 3687 $self->_draw;
3227} 3688}
3228 3689
3229############################################################################# 3690#############################################################################
3230 3691

Diff Legend

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