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.230 by root, Wed May 24 21:59:54 2006 UTC vs.
Revision 1.271 by root, Fri Jun 2 22:13:47 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 }
… …
50 delete $TOOLTIP->{owner}; 69 delete $TOOLTIP->{owner};
51} 70}
52 71
53# class methods for events 72# class methods for events
54sub feed_sdl_key_down_event { 73sub feed_sdl_key_down_event {
55 $FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0]) 74 $FOCUS->emit (key_down => $_[0])
56 if $FOCUS; 75 if $FOCUS;
57} 76}
58 77
59sub feed_sdl_key_up_event { 78sub feed_sdl_key_up_event {
60 $FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0]) 79 $FOCUS->emit (key_up => $_[0])
61 if $FOCUS; 80 if $FOCUS;
62} 81}
63 82
64sub feed_sdl_button_down_event { 83sub feed_sdl_button_down_event {
65 my ($ev) = @_; 84 my ($ev) = @_;
… …
74 check_tooltip; 93 check_tooltip;
75 } 94 }
76 95
77 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 96 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
78 97
79 if ($GRAB) { 98 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
80 ($x, $y) = $GRAB->coord2local ($x, $y); 99 if $GRAB;
81 $GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
82 }
83} 100}
84 101
85sub feed_sdl_button_up_event { 102sub feed_sdl_button_up_event {
86 my ($ev) = @_; 103 my ($ev) = @_;
87 my ($x, $y) = ($ev->{x}, $ev->{y}); 104 my ($x, $y) = ($ev->{x}, $ev->{y});
88 105
89 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 106 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
90 107
91 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 108 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
92 109
93 if ($GRAB) { 110 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
94 ($x, $y) = $GRAB->coord2local ($x, $y); 111 if $GRAB;
95 $GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
96 }
97 112
98 if (!$BUTTON_STATE) { 113 if (!$BUTTON_STATE) {
99 my $grab = $GRAB; undef $GRAB; 114 my $grab = $GRAB; undef $GRAB;
100 $grab->update if $grab; 115 $grab->update if $grab;
101 $GRAB->update if $GRAB; 116 $GRAB->update if $GRAB;
… …
117 $HOVER->update if $HOVER && $HOVER->{can_hover}; 132 $HOVER->update if $HOVER && $HOVER->{can_hover};
118 133
119 check_tooltip; 134 check_tooltip;
120 } 135 }
121 136
122 if ($HOVER) {
123 ($x, $y) = $HOVER->coord2local ($x, $y);
124 $HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y); 137 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
125 } 138 if $HOVER;
126} 139}
127 140
128# convert position array to integers 141# convert position array to integers
129sub harmonize { 142sub harmonize {
130 my ($vals) = @_; 143 my ($vals) = @_;
… …
158sub rescale_widgets { 171sub rescale_widgets {
159 my ($sx, $sy) = @_; 172 my ($sx, $sy) = @_;
160 173
161 for my $widget (values %WIDGET) { 174 for my $widget (values %WIDGET) {
162 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
163 $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.]+$/;
164 $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};
165 $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};
166 $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
167 $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.]+$/;
168 $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};
169 $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};
170 $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
171 } 189 }
172 } 190 }
173 191
174 reconfigure_widgets; 192 reconfigure_widgets;
175} 193}
… …
184 202
185sub new { 203sub new {
186 my $class = shift; 204 my $class = shift;
187 205
188 my $self = bless { 206 my $self = bless {
189 x => 0, 207 x => "center",
190 y => 0, 208 y => "center",
191 z => 0, 209 z => 0,
210 w => undef,
211 h => undef,
192 can_events => 1, 212 can_events => 1,
193 @_ 213 @_
194 }, $class; 214 }, $class;
195 215
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
196 for (keys %$self) { 218 for (keys %$self) {
197 if (/^connect_(.*)$/) { 219 if (/^on_(.*)$/) {
198 $self->connect ($1 => delete $self->{$_}); 220 $self->connect ($1 => delete $self->{$_});
199 } 221 }
200 } 222 }
201 223
202 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 }
203 235
204 $self 236 $self
205} 237}
206 238
207sub destroy { 239sub destroy {
… …
211 %$self = (); 243 %$self = ();
212} 244}
213 245
214sub show { 246sub show {
215 my ($self) = @_; 247 my ($self) = @_;
248
216 return if $self->{parent}; 249 return if $self->{parent};
217 250
218 $CFClient::UI::ROOT->add ($self); 251 $CFClient::UI::ROOT->add ($self);
219} 252}
220 253
221sub show_centered { 254sub set_visible {
222 my ($self) = @_; 255 my ($self) = @_;
256
223 return if $self->{parent}; 257 return if $self->{visible};
224 258
225 $self->show; 259 $self->{root} = $self->{parent}{root};
260 $self->{visible} = $self->{parent}{visible} + 1;
226 261
227 $CFClient::UI::ROOT->on_post_alloc ( 262 $self->emit (visibility_change => 1);
228 "centered $self" => sub {
229 $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);
230 },
231 );
232}
233 263
234sub hide { 264 $self->realloc if !exists $self->{req_w};
265
266 $_->set_visible for $self->children;
267}
268
269sub set_invisible {
235 my ($self) = @_; 270 my ($self) = @_;
271
272 return unless $self->{visible};
273
274 $_->set_invisible for $self->children;
275
276 delete $self->{root};
277 delete $self->{visible};
236 278
237 undef $GRAB if $GRAB == $self; 279 undef $GRAB if $GRAB == $self;
238 undef $HOVER if $HOVER == $self; 280 undef $HOVER if $HOVER == $self;
239 281
282 CFClient::UI::check_tooltip
283 if $TOOLTIP->{owner} == $self;
284
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;
305}
306
307sub hide {
308 my ($self) = @_;
309
310 $self->set_invisible;
311
240 $self->{parent}->remove ($self) 312 $self->{parent}->remove ($self)
241 if $self->{parent}; 313 if $self->{parent};
242} 314}
243 315
244sub move { 316sub move_abs {
245 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
246 318
247 $self->{x} = int $x; 319 $self->{x} = List::Util::max 0, int $x;
248 $self->{y} = int $y; 320 $self->{y} = List::Util::max 0, int $y;
249 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
250 322
251 $self->update; 323 $self->update;
252} 324}
253 325
254sub set_size { 326sub set_size {
255 my ($self, $w, $h) = @_; 327 my ($self, $w, $h) = @_;
256 328
257 $self->{user_w} = $w; 329 $self->{force_w} = $w;
258 $self->{user_h} = $h; 330 $self->{force_h} = $h;
259 331
260 $self->check_size; 332 $self->realloc;
261} 333}
262 334
263sub size_request { 335sub size_request {
264 require Carp; 336 require Carp;
265 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
… …
267 339
268sub configure { 340sub configure {
269 my ($self, $x, $y, $w, $h) = @_; 341 my ($self, $x, $y, $w, $h) = @_;
270 342
271 if ($self->{aspect}) { 343 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h);
345
272 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 346 $w = List::Util::min $w, int $h * $self->{aspect};
273 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 347 $h = List::Util::min $h, int $w / $self->{aspect};
274 348
275 # use alignment to adjust x, y 349 # use alignment to adjust x, y
276 350
277 $x += int +($w - $w2) * 0.5; 351 $x += int 0.5 * ($ow - $w);
278 $y += int +($h - $h2) * 0.5; 352 $y += int 0.5 * ($oh - $h);
279
280 ($w, $h) = ($w2, $h2);
281 } 353 }
282 354
283 if ($self->{x} != $x || $self->{y} != $y) { 355 if ($self->{x} ne $x || $self->{y} ne $y) {
284 $self->{x} = $x; 356 $self->{x} = $x;
285 $self->{y} = $y; 357 $self->{y} = $y;
286 $self->update; 358 $self->update;
287 } 359 }
288 360
289 if ($self->{w} != $w || $self->{h} != $h) { 361 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
290 $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;
291 } 368 }
292} 369}
293 370
294sub size_allocate { 371sub size_allocate {
295 # nothing to be done 372 # nothing to be done
296} 373}
297 374
298sub reconfigure {
299 my ($self) = @_;
300
301 $self->check_size (1);
302 $self->update;
303}
304
305sub children { 375sub children {
306} 376}
307 377
308sub set_max_size { 378sub set_max_size {
309 my ($self, $w, $h) = @_; 379 my ($self, $w, $h) = @_;
… …
312 delete $self->{max_h}; $self->{max_h} = $h if $h; 382 delete $self->{max_h}; $self->{max_h} = $h if $h;
313} 383}
314 384
315sub set_tooltip { 385sub set_tooltip {
316 my ($self, $tooltip) = @_; 386 my ($self, $tooltip) = @_;
387
388 $tooltip =~ s/^\s+//;
389 $tooltip =~ s/\s+$//;
390
391 return if $self->{tooltip} eq $tooltip;
317 392
318 $self->{tooltip} = $tooltip; 393 $self->{tooltip} = $tooltip;
319 394
320 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 395 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
321 delete $CFClient::UI::TOOLTIP->{owner}; 396 delete $CFClient::UI::TOOLTIP->{owner};
… …
343 return if $FOCUS == $self; 418 return if $FOCUS == $self;
344 return unless $self->{can_focus}; 419 return unless $self->{can_focus};
345 420
346 my $focus = $FOCUS; $FOCUS = $self; 421 my $focus = $FOCUS; $FOCUS = $self;
347 422
348 $self->emit (focus_in => $focus); 423 $self->_emit (focus_in => $focus);
349 424
350 $focus->update if $focus; 425 $focus->update if $focus;
351 $FOCUS->update; 426 $FOCUS->update;
352} 427}
353 428
… …
356 431
357 return unless $FOCUS == $self; 432 return unless $FOCUS == $self;
358 433
359 my $focus = $FOCUS; undef $FOCUS; 434 my $focus = $FOCUS; undef $FOCUS;
360 435
361 $self->emit (focus_out => $focus); 436 $self->_emit (focus_out => $focus);
362 437
363 $focus->update if $focus; #? 438 $focus->update if $focus; #?
364}
365 439
440 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
441 unless $FOCUS;
442}
443
366sub mouse_motion { } 444sub mouse_motion { 0 }
367sub button_up { } 445sub button_up { 0 }
368sub key_down { } 446sub key_down { 0 }
369sub key_up { } 447sub key_up { 0 }
370 448
371sub button_down { 449sub button_down {
372 my ($self, $ev, $x, $y) = @_; 450 my ($self, $ev, $x, $y) = @_;
373 451
374 $self->focus_in; 452 $self->focus_in;
375}
376 453
377sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 454 0
378sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 455}
379sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 456
380sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 457sub find_widget {
381sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 458 my ($self, $x, $y) = @_;
459
460 return () unless $self->{can_events};
461
462 return $self
463 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
464 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
465
466 ()
467}
468
469sub set_parent {
470 my ($self, $parent) = @_;
471
472 Scalar::Util::weaken ($self->{parent} = $parent);
473 $self->set_visible if $parent->{visible};
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}
494
495sub visibility_change {
496 #my ($self, $visible) = @_;
497}
498
499sub realloc {
500 my ($self) = @_;
501
502 if ($self->{visible}) {
503 return if $self->{root}{realloc}{$self+0};
504
505 $self->{root}{realloc}{$self+0} = $self;
506 $self->{root}->update;
507 } else {
508 delete $self->{req_w};
509 delete $self->{req_h};
510 }
511}
512
513sub update {
514 my ($self) = @_;
515
516 $self->{parent}->update
517 if $self->{parent};
518}
519
520sub reconfigure {
521 my ($self) = @_;
522
523 $self->realloc;
524 $self->update;
525}
526
527# using global variables seems a bit hacky, but passing through all drawing
528# functions seems pointless.
529our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
382 530
383sub draw { 531sub draw {
384 my ($self) = @_; 532 my ($self) = @_;
385 533
386 return unless $self->{h} && $self->{w}; 534 return unless $self->{h} && $self->{w};
535
536 # update screen rectangle
537 local $draw_x = $draw_x + $self->{x};
538 local $draw_y = $draw_y + $self->{y};
539 local $draw_w = $draw_x + $self->{w};
540 local $draw_h = $draw_y + $self->{h};
541
542 # skip widgets that are entirely outside the drawing area
543 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
544 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
387 545
388 glPushMatrix; 546 glPushMatrix;
389 glTranslate $self->{x}, $self->{y}, 0; 547 glTranslate $self->{x}, $self->{y}, 0;
390 $self->_draw; 548 $self->_draw;
391 glPopMatrix; 549 glPopMatrix;
… …
403 glVertex $x , $y + $self->{h}; 561 glVertex $x , $y + $self->{h};
404 glEnd; 562 glEnd;
405 glDisable GL_BLEND; 563 glDisable GL_BLEND;
406 } 564 }
407 565
408 if ($ENV{PCLIENT_DEBUG}) { 566 if ($ENV{CFPLUS_DEBUG} & 1) {
409 glPushMatrix; 567 glPushMatrix;
410 glColor 1, 1, 0, 1; 568 glColor 1, 1, 0, 1;
411 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 569 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
412 glBegin GL_LINE_LOOP; 570 glBegin GL_LINE_LOOP;
413 glVertex 0 , 0; 571 glVertex 0 , 0;
414 glVertex $self->{w}, 0; 572 glVertex $self->{w} - 1, 0;
415 glVertex $self->{w}, $self->{h}; 573 glVertex $self->{w} - 1, $self->{h} - 1;
416 glVertex 0 , $self->{h}; 574 glVertex 0 , $self->{h} - 1;
417 glEnd; 575 glEnd;
418 glPopMatrix; 576 glPopMatrix;
419 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 577 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
420 } 578 }
421} 579}
422 580
423sub _draw { 581sub _draw {
424 my ($self) = @_; 582 my ($self) = @_;
425 583
426 warn "no draw defined for $self\n"; 584 warn "no draw defined for $self\n";
427}
428
429sub find_widget {
430 my ($self, $x, $y) = @_;
431
432 return () unless $self->{can_events};
433
434 return $self
435 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
436 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
437
438 ()
439}
440
441sub set_parent {
442 my ($self, $parent) = @_;
443
444 Scalar::Util::weaken ($self->{parent} = $parent);
445
446 # TODO: req_w _does_change after ->reconfigure
447 $self->check_size
448 unless exists $self->{req_w};
449
450 $self->show;
451}
452
453sub check_size {
454 my ($self, $forced) = @_;
455
456 $self->{force_alloc} = 1 if $forced;
457 $CFClient::UI::ROOT->{check_size}{$self} = $self;
458}
459
460sub update {
461 my ($self) = @_;
462
463 $self->{parent}->update
464 if $self->{parent};
465}
466
467sub connect {
468 my ($self, $signal, $cb) = @_;
469
470 push @{ $self->{signal_cb}{$signal} }, $cb;
471}
472
473sub emit {
474 my ($self, $signal, @args) = @_;
475
476 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
477} 585}
478 586
479sub DESTROY { 587sub DESTROY {
480 my ($self) = @_; 588 my ($self) = @_;
481 589
… …
539 my ($class, %arg) = @_; 647 my ($class, %arg) = @_;
540 $class->SUPER::new (can_events => 0, %arg); 648 $class->SUPER::new (can_events => 0, %arg);
541} 649}
542 650
543sub size_request { 651sub size_request {
544 (0, 0) 652 my ($self) = @_;
653
654 ($self->{w} + 0, $self->{h} + 0)
545} 655}
546 656
547sub draw { } 657sub draw { }
548 658
549############################################################################# 659#############################################################################
… …
578 $self->{children} = [ 688 $self->{children} = [
579 sort { $a->{z} <=> $b->{z} } 689 sort { $a->{z} <=> $b->{z} }
580 @{$self->{children}}, @widgets 690 @{$self->{children}}, @widgets
581 ]; 691 ];
582 692
583 $self->check_size (1); 693 $self->realloc;
584 $self->update;
585} 694}
586 695
587sub children { 696sub children {
588 @{ $_[0]{children} } 697 @{ $_[0]{children} }
589} 698}
… …
594 delete $child->{parent}; 703 delete $child->{parent};
595 $child->hide; 704 $child->hide;
596 705
597 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 706 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
598 707
599 $self->check_size; 708 $self->realloc;
600 $self->update;
601} 709}
602 710
603sub clear { 711sub clear {
604 my ($self) = @_; 712 my ($self) = @_;
605 713
… …
609 for (@$children) { 717 for (@$children) {
610 delete $_->{parent}; 718 delete $_->{parent};
611 $_->hide; 719 $_->hide;
612 } 720 }
613 721
614 $self->check_size; 722 $self->realloc;
615 $self->update;
616} 723}
617 724
618sub find_widget { 725sub find_widget {
619 my ($self, $x, $y) = @_; 726 my ($self, $x, $y) = @_;
620 727
… …
707 $self->SUPER::size_allocate ($w, $h); 814 $self->SUPER::size_allocate ($w, $h);
708 $self->update; 815 $self->update;
709} 816}
710 817
711sub _render { 818sub _render {
819 my ($self) = @_;
820
712 $_[0]{children}[0]->draw; 821 $self->{children}[0]->draw;
713} 822}
714 823
715sub render_child { 824sub render_child {
716 my ($self) = @_; 825 my ($self) = @_;
717 826
718 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 827 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
719 glClearColor 0, 0, 0, 0; 828 glClearColor 0, 0, 0, 0;
720 glClear GL_COLOR_BUFFER_BIT; 829 glClear GL_COLOR_BUFFER_BIT;
721 830
831 {
832 package CFClient::UI::Base;
833
834 ($draw_x, $draw_y, $draw_w, $draw_h) =
835 (0, 0, $self->{w}, $self->{h});
836 }
837
722 $self->_render; 838 $self->_render;
723 }; 839 };
724} 840}
725 841
726sub _draw { 842sub _draw {
727 my ($self) = @_; 843 my ($self) = @_;
728 844
729 my ($w, $h) = ($self->w, $self->h); 845 my ($w, $h) = @$self{qw(w h)};
730 846
731 my $tex = $self->{texture} 847 my $tex = $self->{texture}
732 or return; 848 or return;
733 849
734 glEnable GL_TEXTURE_2D; 850 glEnable GL_TEXTURE_2D;
… …
744 860
745package CFClient::UI::ViewPort; 861package CFClient::UI::ViewPort;
746 862
747our @ISA = CFClient::UI::Window::; 863our @ISA = CFClient::UI::Window::;
748 864
865sub new {
866 my $class = shift;
867
868 $class->SUPER::new (
869 scroll_x => 0,
870 scroll_y => 1,
871 @_,
872 )
873}
874
749sub size_request { 875sub size_request {
750 my ($self) = @_; 876 my ($self) = @_;
751 877
752 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 878 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
753 879
754 @$self{qw(child_w child_h)} 880 $w = 10 if $self->{scroll_x};
881 $h = 10 if $self->{scroll_y};
882
883 ($w, $h)
755} 884}
756 885
757sub size_allocate { 886sub size_allocate {
758 my ($self, $w, $h) = @_; 887 my ($self, $w, $h) = @_;
759 888
760 my ($cw, $ch) = @$self{qw(child_w child_h)}; 889 my $child = $self->child;
761# $w = $self->{w}; 890
891 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
892 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
893
762 $self->child->configure (0, 0, $cw, $ch); 894 $self->child->configure (0, 0, $w, $h);
763 $self->update; 895 $self->update;
764} 896}
765 897
766sub set_offset { 898sub set_offset {
767 my ($self, $x, $y) = @_; 899 my ($self, $x, $y) = @_;
… …
801} 933}
802 934
803sub _render { 935sub _render {
804 my ($self) = @_; 936 my ($self) = @_;
805 937
938 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
939 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
940
806 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 941 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
807 942
808 $self->SUPER::_render; 943 $self->SUPER::_render;
809} 944}
810 945
… …
818 my $class = shift; 953 my $class = shift;
819 954
820 my $self; 955 my $self;
821 956
822 my $slider = new CFClient::UI::Slider 957 my $slider = new CFClient::UI::Slider
823 vertical => 1, 958 vertical => 1,
824 range => [0, 0, 1, 0.01], # HACK fix 959 range => [0, 0, 1, 0.01], # HACK fix
825 connect_changed => sub { 960 on_changed => sub {
826 $self->{vp}->set_offset (0, $_[1]); 961 $self->{vp}->set_offset (0, $_[1]);
827 }, 962 },
828 ; 963 ;
829 964
830 $self = $class->SUPER::new ( 965 $self = $class->SUPER::new (
… …
836 $self->{vp}->add ($self->{scrolled}); 971 $self->{vp}->add ($self->{scrolled});
837 $self->add ($self->{vp}); 972 $self->add ($self->{vp});
838 $self->add ($self->{slider}); 973 $self->add ($self->{slider});
839 974
840 $self 975 $self
976}
977
978sub update {
979 my ($self) = @_;
980
981 $self->SUPER::update;
982
983 # todo: overwrite size_allocate of child
984 my $child = $self->{vp}->child;
985 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
841} 986}
842 987
843sub size_allocate { 988sub size_allocate {
844 my ($self, $w, $h) = @_; 989 my ($self, $w, $h) = @_;
845 990
… …
898 1043
899our @ISA = CFClient::UI::Bin::; 1044our @ISA = CFClient::UI::Bin::;
900 1045
901use CFClient::OpenGL; 1046use CFClient::OpenGL;
902 1047
903my @tex = 1048my $bg =
1049 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1050 mipmap => 1, wrap => 1;
1051
1052my @border =
904 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1053 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
905 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1054 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
906 1055
907sub new { 1056sub new {
908 my $class = shift; 1057 my ($class, %arg) = @_;
909 1058
910 # TODO: user_x, user_y, overwrite moveto? 1059 my $title = delete $arg{title};
911 1060
912 my $self = $class->SUPER::new ( 1061 my $self = $class->SUPER::new (
913 bg => [1, 1, 1, 1], 1062 bg => [1, 1, 1, 1],
914 border_bg => [1, 1, 1, 1], 1063 border_bg => [1, 1, 1, 1],
915 border => 0.6, 1064 border => 0.6,
916 is_toplevel => 1,
917 can_events => 1, 1065 can_events => 1,
918 @_ 1066 min_w => 16,
1067 min_h => 16,
1068 %arg,
919 ); 1069 );
920 1070
921 $self->{title} &&= new CFClient::UI::Label 1071 $self->{title} = new CFClient::UI::Label
922 align => 0, 1072 align => 0,
923 valign => 1, 1073 valign => 1,
924 text => $self->{title}, 1074 text => $title,
925 fontsize => $self->{border}; 1075 fontsize => $self->{border}
1076 if defined $title;
926 1077
927 $self 1078 $self
1079}
1080
1081sub add {
1082 my ($self, @widgets) = @_;
1083
1084 $self->SUPER::add (@widgets);
1085 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
928} 1086}
929 1087
930sub border { 1088sub border {
931 int $_[0]{border} * $::FONTSIZE 1089 int $_[0]{border} * $::FONTSIZE
932} 1090}
933 1091
934sub size_request { 1092sub size_request {
935 my ($self) = @_; 1093 my ($self) = @_;
1094
1095 $self->{title}->size_request
1096 if $self->{title};
936 1097
937 my ($w, $h) = $self->SUPER::size_request; 1098 my ($w, $h) = $self->SUPER::size_request;
938 1099
939 ( 1100 (
940 $w + $self->border * 2, 1101 $w + $self->border * 2,
… …
943} 1104}
944 1105
945sub size_allocate { 1106sub size_allocate {
946 my ($self, $w, $h) = @_; 1107 my ($self, $w, $h) = @_;
947 1108
1109 if ($self->{title}) {
1110 $self->{title}{w} = $w;
1111 $self->{title}{h} = $h;
1112 $self->{title}->size_allocate ($w, $h);
1113 }
1114
1115 my $border = $self->border;
1116
948 $h -= List::Util::max 0, $self->border * 2; 1117 $h -= List::Util::max 0, $border * 2;
949 $w -= List::Util::max 0, $self->border * 2; 1118 $w -= List::Util::max 0, $border * 2;
950 1119
951 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
952 if $self->{title};
953
954 $self->child->configure ($self->border, $self->border, $w, $h); 1120 $self->child->configure ($border, $border, $w, $h);
955} 1121}
956 1122
957sub button_down { 1123sub button_down {
958 my ($self, $ev, $x, $y) = @_; 1124 my ($self, $ev, $x, $y) = @_;
959 1125
… …
975 my ($ev, $x, $y) = @_; 1141 my ($ev, $x, $y) = @_;
976 1142
977 my $dx = $ev->{x} - $ox; 1143 my $dx = $ev->{x} - $ox;
978 my $dy = $ev->{y} - $oy; 1144 my $dy = $ev->{y} - $oy;
979 1145
980 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1146 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
981 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1147 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1148
1149 $self->realloc;
982 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1150 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
983 $self->check_size;
984 }; 1151 };
985 1152
986 } elsif ($lr ^ $td) { 1153 } elsif ($lr ^ $td) {
987 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1154 my ($ox, $oy) = ($ev->{x}, $ev->{y});
988 my ($bx, $by) = ($self->{x}, $self->{y}); 1155 my ($bx, $by) = ($self->{x}, $self->{y});
… …
990 $self->{motion} = sub { 1157 $self->{motion} = sub {
991 my ($ev, $x, $y) = @_; 1158 my ($ev, $x, $y) = @_;
992 1159
993 ($x, $y) = ($ev->{x}, $ev->{y}); 1160 ($x, $y) = ($ev->{x}, $ev->{y});
994 1161
995 $self->move ($bx + $x - $ox, $by + $y - $oy); 1162 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
996 $self->update;
997 }; 1163 };
1164 } else {
1165 return 0;
1166 }
1167
998 } 1168 1
999} 1169}
1000 1170
1001sub button_up { 1171sub button_up {
1002 my ($self, $ev, $x, $y) = @_; 1172 my ($self, $ev, $x, $y) = @_;
1003 1173
1004 delete $self->{motion}; 1174 !!delete $self->{motion}
1005} 1175}
1006 1176
1007sub mouse_motion { 1177sub mouse_motion {
1008 my ($self, $ev, $x, $y) = @_; 1178 my ($self, $ev, $x, $y) = @_;
1009 1179
1010 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1180 $self->{motion}->($ev, $x, $y) if $self->{motion};
1181
1182 !!$self->{motion}
1011} 1183}
1012 1184
1013sub _draw { 1185sub _draw {
1014 my ($self) = @_; 1186 my ($self) = @_;
1015 1187
1188 my $child = $self->{children}[0];
1189
1016 my ($w, $h ) = ($self->{w}, $self->{h}); 1190 my ($w, $h ) = ($self->{w}, $self->{h});
1017 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 1191 my ($cw, $ch) = ($child->{w}, $child->{h});
1018 1192
1019 glEnable GL_TEXTURE_2D; 1193 glEnable GL_TEXTURE_2D;
1020 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1194 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1021 1195
1022 my $border = $self->border; 1196 my $border = $self->border;
1023 1197
1024 glColor @{ $self->{border_bg} }; 1198 glColor @{ $self->{border_bg} };
1025 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1199 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1026 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1200 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1027 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1201 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1028 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1202 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1029 1203
1030 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1204 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1031 my $bg = $tex[0]; 1205 glColor @{ $self->{bg} };
1032 1206
1033 # TODO: repeat texture not scale 1207 # TODO: repeat texture not scale
1208 # solve this better(?)
1034 my $rep_x = $cw / $bg->{w}; 1209 $bg->{s} = $cw / $bg->{w};
1035 my $rep_y = $ch / $bg->{h}; 1210 $bg->{t} = $ch / $bg->{h};
1036
1037 glColor @{ $self->{bg} };
1038
1039 $bg->{s} = $rep_x;
1040 $bg->{t} = $rep_y;
1041 $bg->{wrap_mode} = 1;
1042 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1211 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1043 } 1212 }
1044 1213
1045 glDisable GL_TEXTURE_2D; 1214 glDisable GL_TEXTURE_2D;
1046 1215
1047 $self->{title}->draw if $self->{title};
1048
1049 $self->child->draw; 1216 $child->draw;
1217
1218 if ($self->{title}) {
1219 glTranslate 0, $border - $self->{h};
1220 $self->{title}->_draw;
1221 }
1050} 1222}
1051 1223
1052############################################################################# 1224#############################################################################
1053 1225
1054package CFClient::UI::Table; 1226package CFClient::UI::Table;
… …
1062sub new { 1234sub new {
1063 my $class = shift; 1235 my $class = shift;
1064 1236
1065 $class->SUPER::new ( 1237 $class->SUPER::new (
1066 col_expand => [], 1238 col_expand => [],
1067 @_ 1239 @_,
1068 ) 1240 )
1241}
1242
1243sub children {
1244 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1069} 1245}
1070 1246
1071sub add { 1247sub add {
1072 my ($self, $x, $y, $child) = @_; 1248 my ($self, $x, $y, $child) = @_;
1073 1249
1074 $child->set_parent ($self); 1250 $child->set_parent ($self);
1075 $self->{children}[$y][$x] = $child; 1251 $self->{children}[$y][$x] = $child;
1076 1252
1077 $child->check_size; 1253 $self->realloc;
1078} 1254}
1079 1255
1080sub children {
1081 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1082}
1083
1084# TODO: move to container class maybe? send childs a signal on removal? 1256# TODO: move to container class maybe? send children a signal on removal?
1085sub clear { 1257sub clear {
1086 my ($self) = @_; 1258 my ($self) = @_;
1087 1259
1088 my @children = $self->children; 1260 my @children = $self->children;
1089 delete $self->{children}; 1261 delete $self->{children};
… …
1091 for (@children) { 1263 for (@children) {
1092 delete $_->{parent}; 1264 delete $_->{parent};
1093 $_->hide; 1265 $_->hide;
1094 } 1266 }
1095 1267
1096 $self->update; 1268 $self->realloc;
1097} 1269}
1098 1270
1099sub get_wh { 1271sub get_wh {
1100 my ($self) = @_; 1272 my ($self) = @_;
1101 1273
… …
1132sub size_allocate { 1304sub size_allocate {
1133 my ($self, $w, $h) = @_; 1305 my ($self, $w, $h) = @_;
1134 1306
1135 my ($ws, $hs) = $self->get_wh; 1307 my ($ws, $hs) = $self->get_wh;
1136 1308
1137 my $req_w = sum @$ws; 1309 my $req_w = (sum @$ws) || 1;
1138 my $req_h = sum @$hs; 1310 my $req_h = (sum @$hs) || 1;
1139 1311
1140 # TODO: nicer code && do row_expand 1312 # TODO: nicer code && do row_expand
1141 my @col_expand = @{$self->{col_expand}}; 1313 my @col_expand = @{$self->{col_expand}};
1142 @col_expand = (1) x @$ws unless @col_expand; 1314 @col_expand = (1) x @$ws unless @col_expand;
1143 my $col_expand = (sum @col_expand) || 1; 1315 my $col_expand = (sum @col_expand) || 1;
… …
1197 } 1369 }
1198} 1370}
1199 1371
1200############################################################################# 1372#############################################################################
1201 1373
1202package CFClient::UI::HBox; 1374package CFClient::UI::Box;
1203
1204# TODO: wrap into common Box base class
1205 1375
1206our @ISA = CFClient::UI::Container::; 1376our @ISA = CFClient::UI::Container::;
1207 1377
1208sub size_request { 1378sub size_request {
1209 my ($self) = @_; 1379 my ($self) = @_;
1210 1380
1211 my @alloc = map [$_->size_request], @{$self->{children}}; 1381 $self->{vertical}
1212 1382 ? (
1213 ( 1383 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1214 (List::Util::sum map $_->[0], @alloc), 1384 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1215 (List::Util::max map $_->[1], @alloc), 1385 )
1216 ) 1386 : (
1387 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1388 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1389 )
1217} 1390}
1218 1391
1219sub size_allocate { 1392sub size_allocate {
1220 my ($self, $w, $h) = @_; 1393 my ($self, $w, $h) = @_;
1221 1394
1222 ($h, $w) = ($w, $h); 1395 my $space = $self->{vertical} ? $h : $w;
1223
1224 my $children = $self->{children}; 1396 my $children = $self->{children};
1225 1397
1226 my @h = map $_->{req_w}, @$children; 1398 my @req;
1227 1399
1228 my $req_h = List::Util::sum @h; 1400 if ($self->{homogeneous}) {
1229 1401 @req = ($space / (@$children || 1)) x @$children;
1230 if ($req_h > $h) {
1231 # ah well, not enough space
1232 $_ *= $h / $req_h for @h;
1233 } else { 1402 } else {
1403 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1404 my $req = List::Util::sum @req;
1405
1406 if ($req > $space) {
1407 # ah well, not enough space
1408 $_ *= $space / $req for @req;
1409 } else {
1234 my $exp = List::Util::sum map $_->{expand}, @$children; 1410 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1235 $exp ||= 1;
1236 1411
1412 $space = ($space - $req) / $expand; # remaining space to give away
1413
1414 $req[$_] += $space * $children->[$_]{expand}
1237 for (0 .. $#$children) { 1415 for 0 .. $#$children;
1238 my $child = $children->[$_];
1239
1240 my $alloc_h = $h[$_];
1241 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1242 $h[$_] = $alloc_h;
1243 } 1416 }
1244 } 1417 }
1245 1418
1246 CFClient::UI::harmonize \@h; 1419 CFClient::UI::harmonize \@req;
1247 1420
1248 my $y = 0; 1421 my $pos = 0;
1249 for (0 .. $#$children) { 1422 for (0 .. $#$children) {
1250 my $child = $children->[$_];
1251 my $h = $h[$_]; 1423 my $alloc = $req[$_];
1252 $child->configure ($y, 0, $h, $w); 1424 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1253 1425
1254 $y += $h; 1426 $pos += $alloc;
1255 } 1427 }
1256 1428
1257 1 1429 1
1258} 1430}
1259 1431
1260############################################################################# 1432#############################################################################
1261 1433
1434package CFClient::UI::HBox;
1435
1436our @ISA = CFClient::UI::Box::;
1437
1438sub new {
1439 my $class = shift;
1440
1441 $class->SUPER::new (
1442 vertical => 0,
1443 @_,
1444 )
1445}
1446
1447#############################################################################
1448
1262package CFClient::UI::VBox; 1449package CFClient::UI::VBox;
1263 1450
1264# TODO: wrap into common Box base class
1265
1266our @ISA = CFClient::UI::Container::; 1451our @ISA = CFClient::UI::Box::;
1267 1452
1268sub size_request { 1453sub new {
1269 my ($self) = @_; 1454 my $class = shift;
1270 1455
1271 my @alloc = map [$_->size_request], @{$self->{children}}; 1456 $class->SUPER::new (
1272 1457 vertical => 1,
1273 ( 1458 @_,
1274 (List::Util::max map $_->[0], @alloc),
1275 (List::Util::sum map $_->[1], @alloc),
1276 ) 1459 )
1277}
1278
1279sub size_allocate {
1280 my ($self, $w, $h) = @_;
1281
1282 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1283
1284 my $children = $self->{children};
1285
1286 my @h = map $_->{req_h}, @$children;
1287
1288 my $req_h = List::Util::sum @h;
1289
1290 if ($req_h > $h) {
1291 # ah well, not enough space
1292 $_ *= $h / $req_h for @h;
1293 } else {
1294 my $exp = List::Util::sum map $_->{expand}, @$children;
1295 $exp ||= 1;
1296
1297 for (0 .. $#$children) {
1298 my $child = $children->[$_];
1299
1300 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1301 }
1302 }
1303
1304 CFClient::UI::harmonize \@h;
1305
1306 my $y = 0;
1307 for (0 .. $#$children) {
1308 my $child = $children->[$_];
1309 my $h = $h[$_];
1310 $child->configure (0, $y, $w, $h);
1311
1312 $y += $h;
1313 }
1314
1315 1
1316} 1460}
1317 1461
1318############################################################################# 1462#############################################################################
1319 1463
1320package CFClient::UI::Label; 1464package CFClient::UI::Label;
… …
1337 ellipsise => 3, # end 1481 ellipsise => 3, # end
1338 layout => (new CFClient::Layout), 1482 layout => (new CFClient::Layout),
1339 fontsize => 1, 1483 fontsize => 1,
1340 align => -1, 1484 align => -1,
1341 valign => -1, 1485 valign => -1,
1342 padding => 2, 1486 padding_x => 2,
1487 padding_y => 2,
1343 can_events => 0, 1488 can_events => 0,
1344 %arg 1489 %arg
1345 ); 1490 );
1346 1491
1347 if (exists $self->{template}) { 1492 if (exists $self->{template}) {
… …
1383 $self->{text} = "T$text"; 1528 $self->{text} = "T$text";
1384 1529
1385 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1530 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1386 $self->{layout}->set_text ($text); 1531 $self->{layout}->set_text ($text);
1387 1532
1533 $self->realloc;
1388 $self->update; 1534 $self->update;
1389 $self->check_size;
1390} 1535}
1391 1536
1392sub set_markup { 1537sub set_markup {
1393 my ($self, $markup) = @_; 1538 my ($self, $markup) = @_;
1394 1539
… …
1398 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1543 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1399 1544
1400 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1545 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1401 $self->{layout}->set_markup ($markup); 1546 $self->{layout}->set_markup ($markup);
1402 1547
1548 $self->realloc;
1403 $self->update; 1549 $self->update;
1404 $self->check_size;
1405} 1550}
1406 1551
1407sub size_request { 1552sub size_request {
1408 my ($self) = @_; 1553 my ($self) = @_;
1409 1554
… …
1423 1568
1424 $w = List::Util::max $w, $w2; 1569 $w = List::Util::max $w, $w2;
1425 $h = List::Util::max $h, $h2; 1570 $h = List::Util::max $h, $h2;
1426 } 1571 }
1427 1572
1428 ( 1573 ($w, $h)
1429 $w + $self->{padding} * 2,
1430 $h + $self->{padding} * 2,
1431 )
1432} 1574}
1433 1575
1434sub size_allocate { 1576sub size_allocate {
1435 my ($self, $w, $h) = @_; 1577 my ($self, $w, $h) = @_;
1436 1578
1579 delete $self->{ox};
1580
1437 delete $self->{texture}; 1581 delete $self->{texture}
1582 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1438} 1583}
1439 1584
1440sub set_fontsize { 1585sub set_fontsize {
1441 my ($self, $fontsize) = @_; 1586 my ($self, $fontsize) = @_;
1442 1587
1443 $self->{fontsize} = $fontsize; 1588 $self->{fontsize} = $fontsize;
1444 delete $self->{texture}; 1589 delete $self->{texture};
1445 1590
1446 $self->update; 1591 $self->realloc;
1447 $self->check_size;
1448} 1592}
1449 1593
1450sub _draw { 1594sub _draw {
1451 my ($self) = @_; 1595 my ($self) = @_;
1452 1596
… …
1458 $self->{layout}->set_width ($self->{w}); 1602 $self->{layout}->set_width ($self->{w});
1459 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1603 $self->{layout}->set_ellipsise ($self->{ellipsise});
1460 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1604 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1461 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1605 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1462 1606
1463 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1607 new_from_layout CFClient::Texture $self->{layout}
1608 };
1464 1609
1610 unless (exists $self->{ox}) {
1465 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1611 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1466 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1612 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1467 : ($self->{w} - $tex->{w}) * 0.5); 1613 : ($self->{w} - $tex->{w}) * 0.5);
1468 1614
1469 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1615 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1470 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1616 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1471 : ($self->{h} - $tex->{h}) * 0.5); 1617 : ($self->{h} - $tex->{h}) * 0.5);
1472
1473 $tex
1474 }; 1618 };
1475 1619
1476 glEnable GL_TEXTURE_2D; 1620 glEnable GL_TEXTURE_2D;
1477 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1621 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1478 1622
… …
1524 $self->{text} = $text; 1668 $self->{text} = $text;
1525 1669
1526 $text =~ s/./*/g if $self->{hidden}; 1670 $text =~ s/./*/g if $self->{hidden};
1527 $self->{layout}->set_text ("$text "); 1671 $self->{layout}->set_text ("$text ");
1528 1672
1529 $self->emit (changed => $self->{text}); 1673 $self->_emit (changed => $self->{text});
1530} 1674}
1531 1675
1532sub set_text { 1676sub set_text {
1533 my ($self, $text) = @_; 1677 my ($self, $text) = @_;
1534 1678
1535 $self->{cursor} = length $text; 1679 $self->{cursor} = length $text;
1536 $self->_set_text ($text); 1680 $self->_set_text ($text);
1537 $self->update; 1681
1538 $self->check_size; 1682 $self->realloc;
1539} 1683}
1540 1684
1541sub get_text { 1685sub get_text {
1542 $_[0]{text} 1686 $_[0]{text}
1543} 1687}
… …
1546 my ($self) = @_; 1690 my ($self) = @_;
1547 1691
1548 my ($w, $h) = $self->SUPER::size_request; 1692 my ($w, $h) = $self->SUPER::size_request;
1549 1693
1550 ($w + 1, $h) # add 1 for cursor 1694 ($w + 1, $h) # add 1 for cursor
1551}
1552
1553sub size_allocate {
1554 my ($self, $w, $h) = @_;
1555
1556 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1557} 1695}
1558 1696
1559sub key_down { 1697sub key_down {
1560 my ($self, $ev) = @_; 1698 my ($self, $ev) = @_;
1561 1699
… …
1576 } elsif ($sym == CFClient::SDLK_HOME) { 1714 } elsif ($sym == CFClient::SDLK_HOME) {
1577 $self->{cursor} = 0; 1715 $self->{cursor} = 0;
1578 } elsif ($sym == CFClient::SDLK_END) { 1716 } elsif ($sym == CFClient::SDLK_END) {
1579 $self->{cursor} = length $text; 1717 $self->{cursor} = length $text;
1580 } elsif ($uni == 27) { 1718 } elsif ($uni == 27) {
1581 $self->emit ('escape'); 1719 $self->_emit ('escape');
1582 } elsif ($uni) { 1720 } elsif ($uni) {
1583 substr $text, $self->{cursor}++, 0, chr $uni; 1721 substr $text, $self->{cursor}++, 0, chr $uni;
1722 } else {
1723 return 0;
1584 } 1724 }
1585 1725
1586 $self->_set_text ($text); 1726 $self->_set_text ($text);
1587 $self->update; 1727
1588 $self->check_size; 1728 $self->realloc;
1729
1730 1
1589} 1731}
1590 1732
1591sub focus_in { 1733sub focus_in {
1592 my ($self) = @_; 1734 my ($self) = @_;
1593 1735
… …
1608 utf8::encode $text; 1750 utf8::encode $text;
1609 $self->{cursor} = length substr $text, 0, $idx; 1751 $self->{cursor} = length substr $text, 0, $idx;
1610 1752
1611 $self->_set_text ($self->{text}); 1753 $self->_set_text ($self->{text});
1612 $self->update; 1754 $self->update;
1755
1756 1
1613} 1757}
1614 1758
1615sub mouse_motion { 1759sub mouse_motion {
1616 my ($self, $ev, $x, $y) = @_; 1760 my ($self, $ev, $x, $y) = @_;
1617# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1761# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1762
1763 0
1618} 1764}
1619 1765
1620sub _draw { 1766sub _draw {
1621 my ($self) = @_; 1767 my ($self) = @_;
1622 1768
… …
1673 if ($sym == 13) { 1819 if ($sym == 13) {
1674 unshift @{$self->{history}}, 1820 unshift @{$self->{history}},
1675 my $txt = $self->get_text; 1821 my $txt = $self->get_text;
1676 $self->{history_pointer} = -1; 1822 $self->{history_pointer} = -1;
1677 $self->{history_saveback} = ''; 1823 $self->{history_saveback} = '';
1678 $self->emit (activate => $txt); 1824 $self->_emit (activate => $txt);
1679 $self->update; 1825 $self->update;
1680 1826
1681 } elsif ($sym == CFClient::SDLK_UP) { 1827 } elsif ($sym == CFClient::SDLK_UP) {
1682 if ($self->{history_pointer} < 0) { 1828 if ($self->{history_pointer} < 0) {
1683 $self->{history_saveback} = $self->get_text; 1829 $self->{history_saveback} = $self->get_text;
… …
1699 } else { 1845 } else {
1700 $self->set_text ($self->{history_saveback}); 1846 $self->set_text ($self->{history_saveback});
1701 } 1847 }
1702 1848
1703 } else { 1849 } else {
1704 $self->SUPER::key_down ($ev); 1850 return $self->SUPER::key_down ($ev)
1851 }
1852
1705 } 1853 1
1706
1707} 1854}
1708 1855
1709############################################################################# 1856#############################################################################
1710 1857
1711package CFClient::UI::Button; 1858package CFClient::UI::Button;
… …
1720 1867
1721sub new { 1868sub new {
1722 my $class = shift; 1869 my $class = shift;
1723 1870
1724 $class->SUPER::new ( 1871 $class->SUPER::new (
1725 padding => 4, 1872 padding_x => 4,
1873 padding_y => 4,
1726 fg => [1, 1, 1], 1874 fg => [1, 1, 1],
1727 active_fg => [0, 0, 1], 1875 active_fg => [0, 0, 1],
1728 can_hover => 1, 1876 can_hover => 1,
1729 align => 0, 1877 align => 0,
1730 valign => 0, 1878 valign => 0,
1731 can_events => 1, 1879 can_events => 1,
1732 @_ 1880 @_
1733 ) 1881 )
1734} 1882}
1735 1883
1884sub activate { }
1885
1736sub button_up { 1886sub button_up {
1737 my ($self, $ev, $x, $y) = @_; 1887 my ($self, $ev, $x, $y) = @_;
1738 1888
1889 $self->emit ("activate")
1739 if ($x >= 0 && $x < $self->{w} 1890 if $x >= 0 && $x < $self->{w}
1740 && $y >= 0 && $y < $self->{h}) { 1891 && $y >= 0 && $y < $self->{h};
1741 $self->emit ("activate"); 1892
1742 } 1893 1
1743} 1894}
1744 1895
1745sub _draw { 1896sub _draw {
1746 my ($self) = @_; 1897 my ($self) = @_;
1747 1898
… …
1776 1927
1777sub new { 1928sub new {
1778 my $class = shift; 1929 my $class = shift;
1779 1930
1780 $class->SUPER::new ( 1931 $class->SUPER::new (
1781 padding => 2, 1932 padding_x => 2,
1933 padding_y => 2,
1782 fg => [1, 1, 1], 1934 fg => [1, 1, 1],
1783 active_fg => [1, 1, 0], 1935 active_fg => [1, 1, 0],
1784 bg => [0, 0, 0, 0.2], 1936 bg => [0, 0, 0, 0.2],
1785 active_bg => [1, 1, 1, 0.5], 1937 active_bg => [1, 1, 1, 0.5],
1786 state => 0, 1938 state => 0,
… …
1790} 1942}
1791 1943
1792sub size_request { 1944sub size_request {
1793 my ($self) = @_; 1945 my ($self) = @_;
1794 1946
1795 ($self->{padding} * 2 + 6) x 2 1947 (6) x 2
1796} 1948}
1797 1949
1798sub button_down { 1950sub button_down {
1799 my ($self, $ev, $x, $y) = @_; 1951 my ($self, $ev, $x, $y) = @_;
1800 1952
1801 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1953 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1802 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1954 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1803 $self->{state} = !$self->{state}; 1955 $self->{state} = !$self->{state};
1804 $self->emit (changed => $self->{state}); 1956 $self->_emit (changed => $self->{state});
1957 } else {
1958 return 0
1959 }
1960
1805 } 1961 1
1806} 1962}
1807 1963
1808sub _draw { 1964sub _draw {
1809 my ($self) = @_; 1965 my ($self) = @_;
1810 1966
1811 $self->SUPER::_draw; 1967 $self->SUPER::_draw;
1812 1968
1813 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1969 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1814 1970
1815 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1971 my ($w, $h) = @$self{qw(w h)};
1972
1973 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1816 1974
1817 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1975 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1818 1976
1819 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1977 my $tex = $self->{state} ? $tex[1] : $tex[0];
1820 1978
… …
2085 fg => [1, 1, 1], 2243 fg => [1, 1, 1],
2086 active_fg => [0, 0, 0], 2244 active_fg => [0, 0, 0],
2087 bg => [0, 0, 0, 0.2], 2245 bg => [0, 0, 0, 0.2],
2088 active_bg => [1, 1, 1, 0.5], 2246 active_bg => [1, 1, 1, 0.5],
2089 range => [0, 0, 100, 10, 0], 2247 range => [0, 0, 100, 10, 0],
2090 req_w => $::WIDTH / 80, 2248 min_w => $::WIDTH / 80,
2091 req_h => $::WIDTH / 80, 2249 min_h => $::WIDTH / 80,
2092 vertical => 0, 2250 vertical => 0,
2093 can_hover => 1, 2251 can_hover => 1,
2094 inner_pad => 0.02, 2252 inner_pad => 0.02,
2095 @_ 2253 @_
2096 ); 2254 );
… …
2099 $self->update; 2257 $self->update;
2100 2258
2101 $self 2259 $self
2102} 2260}
2103 2261
2262sub changed { }
2263
2104sub set_range { 2264sub set_range {
2105 my ($self, $range) = @_; 2265 my ($self, $range) = @_;
2106 2266
2107 $self->{range} = $range; 2267 ($range, $self->{range}) = ($self->{range}, $range);
2108 2268
2109 $self->update; 2269 $self->update
2270 if "@$range" ne "@{$self->{range}}";
2110} 2271}
2111 2272
2112sub set_value { 2273sub set_value {
2113 my ($self, $value) = @_; 2274 my ($self, $value) = @_;
2114 2275
… …
2125 if $unit; 2286 if $unit;
2126 2287
2127 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2288 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2128 2289
2129 if ($value != $old_value) { 2290 if ($value != $old_value) {
2130 $self->emit (changed => $value); 2291 $self->_emit (changed => $value);
2131 $self->update; 2292 $self->update;
2132 } 2293 }
2133} 2294}
2134 2295
2135sub size_request { 2296sub size_request {
2136 my ($self) = @_; 2297 my ($self) = @_;
2137 2298
2138 my $w = $self->{req_w}; 2299 ($self->{req_w}, $self->{req_h})
2139 my $h = $self->{req_h};
2140
2141 $self->{vertical} ? ($h, $w) : ($w, $h)
2142} 2300}
2143 2301
2144sub button_down { 2302sub button_down {
2145 my ($self, $ev, $x, $y) = @_; 2303 my ($self, $ev, $x, $y) = @_;
2146 2304
2147 $self->SUPER::button_down ($ev, $x, $y); 2305 $self->SUPER::button_down ($ev, $x, $y);
2148 2306
2149 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2307 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2150 2308
2151 $self->mouse_motion ($ev, $x, $y); 2309 $self->mouse_motion ($ev, $x, $y)
2152} 2310}
2153 2311
2154sub mouse_motion { 2312sub mouse_motion {
2155 my ($self, $ev, $x, $y) = @_; 2313 my ($self, $ev, $x, $y) = @_;
2156 2314
… …
2160 my (undef, $lo, $hi, $page) = @{$self->{range}}; 2318 my (undef, $lo, $hi, $page) = @{$self->{range}};
2161 2319
2162 $x = ($x - $self->{click}[1]) / ($w * $self->{scale}); 2320 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2163 2321
2164 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); 2322 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2323 } else {
2324 return 0;
2325 }
2326
2165 } 2327 1
2166} 2328}
2167 2329
2168sub update { 2330sub update {
2169 my ($self) = @_; 2331 my ($self) = @_;
2170 2332
… …
2497 2659
2498sub new { 2660sub new {
2499 my $class = shift; 2661 my $class = shift;
2500 2662
2501 my $self = $class->SUPER::new ( 2663 my $self = $class->SUPER::new (
2502 state => 0, 2664 state => 0,
2503 connect_activate => \&toggle_flopper, 2665 on_activate => \&toggle_flopper,
2504 @_ 2666 @_
2505 ); 2667 );
2506 2668
2507 if ($self->{state}) {
2508 $self->{state} = 0;
2509 $self->toggle_flopper;
2510 }
2511
2512 $self 2669 $self
2513} 2670}
2514 2671
2515sub toggle_flopper { 2672sub toggle_flopper {
2516 my ($self) = @_; 2673 my ($self) = @_;
2517 2674
2518 # TODO: use animation 2675 $self->{other}->toggle_visibility;
2519 if ($self->{state} = !$self->{state}) {
2520 $CFClient::UI::ROOT->add ($self->{other});
2521 $self->{other}->move ($self->coord2global (0, $self->{h}));
2522 $self->emit ("open");
2523 } else {
2524 $CFClient::UI::ROOT->remove ($self->{other});
2525 $self->emit ("close");
2526 }
2527
2528 $self->emit (changed => $self->{state});
2529} 2676}
2530 2677
2531############################################################################# 2678#############################################################################
2532 2679
2533package CFClient::UI::Tooltip; 2680package CFClient::UI::Tooltip;
… …
2546} 2693}
2547 2694
2548sub set_tooltip_from { 2695sub set_tooltip_from {
2549 my ($self, $widget) = @_; 2696 my ($self, $widget) = @_;
2550 2697
2698 my $tooltip = $widget->{tooltip};
2699
2700 if ($ENV{CFPLUS_DEBUG} & 2) {
2701 $tooltip .= "\n\n" . (ref $widget) . "\n"
2702 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2703 . "req $widget->{req_w} $widget->{req_h}\n"
2704 . "visible $widget->{visible}";
2705 }
2706
2551 $self->add (new CFClient::UI::Label 2707 $self->add (new CFClient::UI::Label
2552 markup => $widget->{tooltip}, 2708 markup => $tooltip,
2553 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2709 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2554 fontsize => 0.8, 2710 fontsize => 0.8,
2555 fg => [0, 0, 0, 1], 2711 fg => [0, 0, 0, 1],
2556 ellipsise => 0, 2712 ellipsise => 0,
2557 font => ($widget->{tooltip_font} || $::FONT_PROP), 2713 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2568 2724
2569sub size_allocate { 2725sub size_allocate {
2570 my ($self, $w, $h) = @_; 2726 my ($self, $w, $h) = @_;
2571 2727
2572 $self->SUPER::size_allocate ($w - 4, $h - 4); 2728 $self->SUPER::size_allocate ($w - 4, $h - 4);
2729}
2730
2731sub visibility_change {
2732 my ($self, $visible) = @_;
2733
2734 return unless $visible;
2735
2736 $self->{root}->on_post_alloc ("move_$self" => sub {
2737 my $widget = $self->{owner}
2738 or return;
2739
2740 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2741
2742 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2743 if $x + $self->{w} > $::WIDTH;
2744
2745 $self->move_abs ($x, $y);
2746 });
2573} 2747}
2574 2748
2575sub _draw { 2749sub _draw {
2576 my ($self) = @_; 2750 my ($self) = @_;
2577 2751
… …
2594 glVertex $w, $h; 2768 glVertex $w, $h;
2595 glVertex $w, 0; 2769 glVertex $w, 0;
2596 glEnd; 2770 glEnd;
2597 2771
2598 glTranslate 2 - 0.375, 2 - 0.375; 2772 glTranslate 2 - 0.375, 2 - 0.375;
2773
2599 $self->SUPER::_draw; 2774 $self->SUPER::_draw;
2600} 2775}
2601 2776
2602############################################################################# 2777#############################################################################
2603 2778
… …
2609 2784
2610sub new { 2785sub new {
2611 my $class = shift; 2786 my $class = shift;
2612 2787
2613 my $self = $class->SUPER::new ( 2788 my $self = $class->SUPER::new (
2614 aspect => 1, 2789 aspect => 1,
2790 can_events => 0,
2615 @_, 2791 @_,
2616 ); 2792 );
2617 2793
2618 if ($self->{anim} && $self->{animspeed}) { 2794 if ($self->{anim} && $self->{animspeed}) {
2619 Scalar::Util::weaken (my $widget = $self); 2795 Scalar::Util::weaken (my $widget = $self);
… …
2678 $self->SUPER::DESTROY; 2854 $self->SUPER::DESTROY;
2679} 2855}
2680 2856
2681############################################################################# 2857#############################################################################
2682 2858
2683package CFClient::UI::InventoryItem;
2684
2685our @ISA = CFClient::UI::HBox::;
2686
2687sub _item_to_desc {
2688 my ($item) = @_;
2689
2690 my $desc =
2691 $item->{nrof} < 2
2692 ? $item->{name}
2693 : "$item->{nrof} × $item->{name_pl}";
2694
2695 $item->{flags} & Crossfire::Protocol::F_OPEN
2696 and $desc .= " (open)";
2697 $item->{flags} & Crossfire::Protocol::F_APPLIED
2698 and $desc .= " (applied)";
2699 $item->{flags} & Crossfire::Protocol::F_UNPAID
2700 and $desc .= " (unpaid)";
2701 $item->{flags} & Crossfire::Protocol::F_MAGIC
2702 and $desc .= " (magic)";
2703 $item->{flags} & Crossfire::Protocol::F_CURSED
2704 and $desc .= " (cursed)";
2705 $item->{flags} & Crossfire::Protocol::F_DAMNED
2706 and $desc .= " (damned)";
2707 $item->{flags} & Crossfire::Protocol::F_LOCKED
2708 and $desc .= " *";
2709
2710 $desc
2711}
2712
2713sub new {
2714 my $class = shift;
2715
2716 my %args = @_;
2717
2718 my $item = delete $args{item};
2719
2720 my $desc = _item_to_desc ($item);
2721
2722 my $self = $class->SUPER::new (
2723 can_hover => 1,
2724 can_events => 1,
2725 tooltip => ((CFClient::UI::Label::escape $desc)
2726 . "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2727 connect_button_down => sub {
2728 my ($self, $ev, $x, $y) = @_;
2729
2730 # todo: maybe put examine on 1? but should just be a tooltip :(
2731 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2732 my $targ = $::CONN->{player}{tag};
2733
2734 if ($item->{container} == $::CONN->{player}{tag}) {
2735 $targ = $main::OPENCONT;
2736 }
2737
2738 $::CONN->send ("move $targ $item->{tag} 0");
2739 } elsif ($ev->{button} == 1) {
2740 $::CONN->send ("examine $item->{tag}");
2741 } elsif ($ev->{button} == 2) {
2742 $::CONN->send ("apply $item->{tag}");
2743 } elsif ($ev->{button} == 3) {
2744 my @menu_items = (
2745 ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2746 ["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2747 ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2748 (
2749 $item->{flags} & Crossfire::Protocol::F_LOCKED
2750 ? (
2751 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2752 )
2753 : (
2754 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2755 ["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2756 )
2757 ),
2758 );
2759
2760 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2761 }
2762
2763 1
2764 },
2765 %args
2766 );
2767
2768
2769 $self->add (new CFClient::UI::Face
2770 can_events => 0,
2771 face => $item->{face},
2772 anim => $item->{anim},
2773 animspeed => $item->{animspeed},
2774 );
2775
2776 $self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2777
2778 $self->{item} = $item;
2779
2780 $self->update_item;
2781
2782 $self
2783}
2784
2785sub update_item {
2786 my ($self) = @_;
2787
2788 my $desc = _item_to_desc ($self->{item});
2789
2790 $self->{name_lbl}->set_text ($desc);
2791}
2792
2793#############################################################################
2794
2795package CFClient::UI::Inventory;
2796
2797our @ISA = CFClient::UI::ScrolledWindow::;
2798
2799sub new {
2800 my $class = shift;
2801
2802 my $self = $class->SUPER::new (
2803 scrolled => (new CFClient::UI::Table),
2804 @_,
2805 );
2806
2807 $self
2808}
2809
2810sub set_items {
2811 my ($self, $items) = @_;
2812
2813 $self->{scrolled}->clear;
2814 return unless $items;
2815
2816 my @items = sort {
2817 ($a->{type} <=> $b->{type})
2818 or ($a->{name} cmp $b->{name})
2819 } @$items;
2820
2821 $self->{real_items} = \@items;
2822
2823 for my $item (@items) {
2824 $item->{item} = $item;
2825 $item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2826 $item->update_item ();
2827 }
2828
2829 my $i = 0;
2830 for (@items) {
2831 $self->{scrolled}->add (0, $i, $_);
2832 my $nrof = $_->{item}->{nrof} || 1;
2833 $self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2834 }
2835
2836# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2837}
2838
2839sub size_request {
2840 my ($self) = @_;
2841 ($self->{req_w}, $self->{req_h});
2842}
2843
2844#############################################################################
2845
2846package CFClient::UI::Menu; 2859package CFClient::UI::Menu;
2847 2860
2848our @ISA = CFClient::UI::FancyFrame::; 2861our @ISA = CFClient::UI::FancyFrame::;
2849 2862
2850use CFClient::OpenGL; 2863use CFClient::OpenGL;
… …
2881 2894
2882# popup given the event (must be a mouse button down event currently) 2895# popup given the event (must be a mouse button down event currently)
2883sub popup { 2896sub popup {
2884 my ($self, $ev) = @_; 2897 my ($self, $ev) = @_;
2885 2898
2886 $self->emit ("popdown"); 2899 $self->_emit ("popdown");
2887 2900
2888 # maybe save $GRAB? must be careful about events... 2901 # maybe save $GRAB? must be careful about events...
2889 $GRAB = $self; 2902 $GRAB = $self;
2890 $self->{button} = $ev->{button}; 2903 $self->{button} = $ev->{button};
2891 2904
2892 $self->show; 2905 $self->show;
2893 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2906 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2894} 2907}
2895 2908
2896sub mouse_motion { 2909sub mouse_motion {
2897 my ($self, $ev, $x, $y) = @_; 2910 my ($self, $ev, $x, $y) = @_;
2898 2911
2899 # TODO: should use vbox->find_widget or so 2912 # TODO: should use vbox->find_widget or so
2900 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 2913 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2901 $self->{hover} = $self->{item}{$HOVER}; 2914 $self->{hover} = $self->{item}{$HOVER};
2915
2916 0
2902} 2917}
2903 2918
2904sub button_up { 2919sub button_up {
2905 my ($self, $ev, $x, $y) = @_; 2920 my ($self, $ev, $x, $y) = @_;
2906 2921
2907 if ($ev->{button} == $self->{button}) { 2922 if ($ev->{button} == $self->{button}) {
2908 undef $GRAB; 2923 undef $GRAB;
2909 $self->hide; 2924 $self->hide;
2910 2925
2911 $self->emit ("popdown"); 2926 $self->_emit ("popdown");
2912 $self->{hover}[1]->() if $self->{hover}; 2927 $self->{hover}[1]->() if $self->{hover};
2928 } else {
2929 return 0
2930 }
2931
2913 } 2932 1
2914} 2933}
2915 2934
2916############################################################################# 2935#############################################################################
2917 2936
2918package CFClient::UI::Statusbox; 2937package CFClient::UI::Statusbox;
… …
2978sub add { 2997sub add {
2979 my ($self, $text, %arg) = @_; 2998 my ($self, $text, %arg) = @_;
2980 2999
2981 $text =~ s/^\s+//; 3000 $text =~ s/^\s+//;
2982 $text =~ s/\s+$//; 3001 $text =~ s/\s+$//;
3002
3003 return unless $text;
2983 3004
2984 my $timeout = time + ((delete $arg{timeout}) || 60); 3005 my $timeout = time + ((delete $arg{timeout}) || 60);
2985 3006
2986 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 3007 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2987 3008
… …
3021 $self->SUPER::reconfigure; 3042 $self->SUPER::reconfigure;
3022} 3043}
3023 3044
3024############################################################################# 3045#############################################################################
3025 3046
3026package CFClient::UI::Root; 3047package CFClient::UI::Inventory;
3027 3048
3028our @ISA = CFClient::UI::Container::; 3049our @ISA = CFClient::UI::ScrolledWindow::;
3029
3030use CFClient::OpenGL;
3031 3050
3032sub new { 3051sub new {
3033 my $class = shift; 3052 my $class = shift;
3034 3053
3035 $class->SUPER::new ( 3054 my $self = $class->SUPER::new (
3055 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3036 @_, 3056 @_,
3037 ) 3057 );
3038}
3039 3058
3040sub configure { 3059 $self
3060}
3061
3062sub set_items {
3063 my ($self, $items) = @_;
3064
3065 $self->{scrolled}->clear;
3066 return unless $items;
3067
3068 my @items = sort {
3069 ($a->{type} <=> $b->{type})
3070 or ($a->{name} cmp $b->{name})
3071 } @$items;
3072
3073 $self->{real_items} = \@items;
3074
3075 my $row = 0;
3076 for my $item (@items) {
3077 CFClient::Item::update_widgets $item;
3078
3079 $self->{scrolled}->add (0, $row, $item->{face_widget});
3080 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3081 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3082
3083 $row++;
3084 }
3085}
3086
3087#############################################################################
3088
3089package CFClient::UI::BindEditor;
3090
3091our @ISA = CFClient::UI::FancyFrame::;
3092
3093sub new {
3094 my $class = shift;
3095
3096 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3097
3098 $self->add (my $vb = new CFClient::UI::VBox);
3099
3100
3101 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3102 text => "start recording",
3103 tooltip => "Start/Stops recording of actions."
3104 ."All subsequent actions after the recording started will be captured."
3105 ."The actions are displayed after the record was stopped."
3106 ."To bind the action you have to click on the 'Bind' button",
3107 on_activate => sub {
3108 unless ($self->{recording}) {
3109 $self->start;
3110 } else {
3111 $self->stop;
3112 }
3113 });
3114
3115 $vb->add (new CFClient::UI::Label text => "Actions:");
3116 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3117
3118 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3119 $vb->add (my $hb = new CFClient::UI::HBox);
3120 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3121 $hb->add (new CFClient::UI::Button
3122 text => "bind",
3123 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3124 on_activate => sub {
3125 $self->ask_for_bind;
3126 });
3127
3128 $vb->add (my $hb = new CFClient::UI::HBox);
3129 $hb->add (new CFClient::UI::Button
3130 text => "ok",
3131 expand => 1,
3132 tooltip => "This closes the binding editor and saves the binding",
3133 on_activate => sub {
3134 $self->hide;
3135 $self->commit;
3136 });
3137
3138 $hb->add (new CFClient::UI::Button
3139 text => "cancel",
3140 expand => 1,
3141 tooltip => "This closes the binding editor without saving",
3142 on_activate => sub {
3143 $self->hide;
3144 $self->{binding_cancel}->()
3145 if $self->{binding_cancel};
3146 });
3147
3148 $self->update_binding_widgets;
3149
3150 $self
3151}
3152
3153sub commit {
3154 my ($self) = @_;
3155 my ($mod, $sym, $cmds) = $self->get_binding;
3156 if ($sym != 0 && @$cmds > 0) {
3157 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3158 ."'. Don't forget 'Save Config'!");
3159 $self->{binding_change}->($mod, $sym, $cmds)
3160 if $self->{binding_change};
3161 } else {
3162 $::STATUSBOX->add ("No action bound, no key or action specified!");
3163 $self->{binding_cancel}->()
3164 if $self->{binding_cancel};
3165 }
3166}
3167
3168sub start {
3169 my ($self) = @_;
3170
3171 $self->{rec_btn}->set_text ("stop recording");
3172 $self->{recording} = 1;
3173 $self->clear_command_list;
3174 $::CONN->start_record if $::CONN;
3175}
3176
3177sub stop {
3178 my ($self) = @_;
3179
3180 $self->{rec_btn}->set_text ("start recording");
3181 $self->{recording} = 0;
3182
3183 my $rec;
3184 $rec = $::CONN->stop_record if $::CONN;
3185 return unless ref $rec eq 'ARRAY';
3186 $self->set_command_list ($rec);
3187}
3188
3189
3190sub ask_for_bind_and_commit {
3191 my ($self) = @_;
3192 $self->ask_for_bind (1);
3193}
3194
3195sub ask_for_bind {
3196 my ($self, $commit) = @_;
3197
3198 CFClient::Binder::open_binding_dialog (sub {
3199 my ($mod, $sym) = @_;
3200 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3201 $self->update_binding_widgets;
3202 $self->commit if $commit;
3203 });
3204}
3205
3206# $mod and $sym are the modifiers and key symbol
3207# $cmds is a array ref of strings (the commands)
3208# $cb is the callback that is executed on OK
3209# $ccb is the callback that is executed on CANCEL and
3210# when the binding was unsuccessful on OK
3211sub set_binding {
3041 my ($self, $x, $y, $w, $h) = @_; 3212 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3042 3213
3043 $self->{w} = $w; 3214 $self->clear_command_list;
3044 $self->{h} = $h; 3215 $self->{recording} = 0;
3045} 3216 $self->{rec_btn}->set_text ("start recording");
3046 3217
3047sub check_size { 3218 $self->{binding} = [$mod, $sym];
3219 $self->{commands} = $cmds;
3220
3221 $self->{binding_change} = $cb;
3222 $self->{binding_cancel} = $ccb;
3223
3224 $self->update_binding_widgets;
3225}
3226
3227# this is a shortcut method that asks for a binding
3228# and then just binds it.
3229sub do_quick_binding {
3048 my ($self) = @_; 3230 my ($self, $cmds) = @_;
3231 $self->set_binding (undef, undef, $cmds, sub {
3232 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3233 });
3234 $self->ask_for_bind (1);
3235}
3049 3236
3050 $self->size_allocate ($self->{w}, $self->{h}) 3237sub update_binding_widgets {
3051 if $self->{w}; 3238 my ($self) = @_;
3239 my ($mod, $sym, $cmds) = $self->get_binding;
3240 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3241 $self->set_command_list ($cmds);
3242}
3243
3244sub get_binding {
3245 my ($self) = @_;
3246 return (
3247 $self->{binding}->[0],
3248 $self->{binding}->[1],
3249 [ grep { defined $_ } @{$self->{commands}} ]
3250 );
3251}
3252
3253sub clear_command_list {
3254 my ($self) = @_;
3255 $self->{cmdbox}->clear ();
3256}
3257
3258sub set_command_list {
3259 my ($self, $cmds) = @_;
3260
3261 $self->{cmdbox}->clear ();
3262 $self->{commands} = $cmds;
3263
3264 my $idx = 0;
3265
3266 for (@$cmds) {
3267 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3268
3269 my $i = $idx;
3270 $hb->add (new CFClient::UI::Label text => $_);
3271 $hb->add (new CFClient::UI::Button
3272 text => "delete",
3273 tooltip => "Deletes the action from the record",
3274 on_activate => sub {
3275 $self->{cmdbox}->remove ($hb);
3276 $cmds->[$i] = undef;
3277 });
3278
3279
3280 $idx++
3281 }
3282}
3283
3284#############################################################################
3285
3286package CFClient::UI::SpellList;
3287
3288our @ISA = CFClient::UI::FancyFrame::;
3289
3290sub new {
3291 my $class = shift;
3292
3293 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3294
3295 $self->add (new CFClient::UI::ScrolledWindow
3296 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3297
3298 $self;
3299}
3300
3301# XXX: Do sorting? Argl...
3302sub add_spell {
3303 my ($self, $spell) = @_;
3304 $self->{spells}->{$spell->{name}} = $spell;
3305
3306 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3307 face => $spell->{face},
3308 can_hover => 1,
3309 can_events => 1,
3310 tooltip => $spell->{message});
3311
3312 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3313 text => $spell->{name},
3314 can_hover => 1,
3315 can_events => 1,
3316 tooltip => $spell->{message},
3317 expand => 1);
3318
3319 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3320 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3321 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3322 expand => 1);
3323
3324 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3325 text => "bind to key",
3326 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3327}
3328
3329sub rebuild_spell_list {
3330 my ($self) = @_;
3331 $self->{tbl_idx} = 0;
3332 $self->add_spell ($_) for values %{$self->{spells}};
3333}
3334
3335sub remove_spell {
3336 my ($self, $spell) = @_;
3337 delete $self->{spells}->{$spell->{name}};
3338 $self->rebuild_spell_list;
3339}
3340
3341#############################################################################
3342
3343package CFClient::UI::Root;
3344
3345our @ISA = CFClient::UI::Container::;
3346
3347use CFClient::OpenGL;
3348
3349sub new {
3350 my $class = shift;
3351
3352 my $self = $class->SUPER::new (
3353 visible => 1,
3354 @_,
3355 );
3356
3357 Scalar::Util::weaken ($self->{root} = $self);
3358
3359 $self
3052} 3360}
3053 3361
3054sub size_request { 3362sub size_request {
3055 my ($self) = @_; 3363 my ($self) = @_;
3056 3364
3057 ($self->{w}, $self->{h}) 3365 ($self->{w}, $self->{h})
3366}
3367
3368sub _to_pixel {
3369 my ($coord, $size, $max) = @_;
3370
3371 $coord =
3372 $coord eq "center" ? ($max - $size) * 0.5
3373 : $coord eq "max" ? $max
3374 : $coord;
3375
3376 $coord = 0 if $coord < 0;
3377 $coord = $max - $size if $coord > $max - $size;
3378
3379 int $coord + 0.5
3058} 3380}
3059 3381
3060sub size_allocate { 3382sub size_allocate {
3061 my ($self, $w, $h) = @_; 3383 my ($self, $w, $h) = @_;
3062 3384
3063 for my $child ($self->children) { 3385 for my $child ($self->children) {
3064 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3386 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3065 3387
3066 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3388 $X = $child->{force_x} if exists $child->{force_x};
3067 if exists $child->{req_x}; 3389 $Y = $child->{force_y} if exists $child->{force_y};
3068 3390
3069 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3391 $X = _to_pixel $X, $W, $self->{w};
3070 if exists $child->{req_y}; 3392 $Y = _to_pixel $Y, $H, $self->{h};
3071
3072 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3073 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3074 3393
3075 $child->configure ($X, $Y, $W, $H); 3394 $child->configure ($X, $Y, $W, $H);
3076 } 3395 }
3077} 3396}
3078 3397
… …
3089} 3408}
3090 3409
3091sub update { 3410sub update {
3092 my ($self) = @_; 3411 my ($self) = @_;
3093 3412
3094 $self->check_size;
3095 $::WANT_REFRESH++; 3413 $::WANT_REFRESH++;
3096} 3414}
3097 3415
3098sub add { 3416sub add {
3099 my ($self, @children) = @_; 3417 my ($self, @children) = @_;
3100 3418
3101 for (my @widgets = @children; my $w = pop @widgets; ) {
3102 push @widgets, $w->children;
3103 $w->{root} = $self;
3104 $w->{visible} = 1;
3105 }
3106
3107 for my $child (@children) {
3108 $child->{is_toplevel} = 1; 3419 $_->{is_toplevel} = 1
3109 3420 for @children;
3110 # integerise window positions
3111 $child->{x} = int $child->{x};
3112 $child->{y} = int $child->{y};
3113 }
3114 3421
3115 $self->SUPER::add (@children); 3422 $self->SUPER::add (@children);
3116} 3423}
3117 3424
3118sub remove { 3425sub remove {
3119 my ($self, @children) = @_; 3426 my ($self, @children) = @_;
3120 3427
3121 $self->SUPER::remove (@children); 3428 $self->SUPER::remove (@children);
3429
3430 delete $self->{is_toplevel}
3431 for @children;
3122 3432
3123 while (@children) { 3433 while (@children) {
3124 my $w = pop @children; 3434 my $w = pop @children;
3125 push @children, $w->children; 3435 push @children, $w->children;
3126 delete $w->{visible}; 3436 $w->set_invisible;
3127 } 3437 }
3128} 3438}
3129 3439
3130sub on_refresh { 3440sub on_refresh {
3131 my ($self, $id, $cb) = @_; 3441 my ($self, $id, $cb) = @_;
… …
3145 while ($self->{refresh_hook}) { 3455 while ($self->{refresh_hook}) {
3146 $_->() 3456 $_->()
3147 for values %{delete $self->{refresh_hook}}; 3457 for values %{delete $self->{refresh_hook}};
3148 } 3458 }
3149 3459
3150 if ($self->{check_size}) { 3460 if ($self->{realloc}) {
3151 my @queue = ([], []); 3461 my %queue;
3462 my @queue;
3463 my $widget;
3152 3464
3153 for (;;) { 3465 outer:
3154 if ($self->{check_size}) { 3466 while () {
3155 # heuristic: check containers last 3467 if (my $realloc = delete $self->{realloc}) {
3156 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3468 for $widget (values %$realloc) {
3157 for values %{delete $self->{check_size}} 3469 $widget->{visible} or next; # do not resize invisible widgets
3470
3471 $queue{$widget+0}++ and next; # duplicates are common
3472
3473 push @{ $queue[$widget->{visible}] }, $widget;
3474 }
3158 } 3475 }
3159 3476
3160 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3477 while () {
3478 @queue or last outer;
3161 3479
3162 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3480 $widget = pop @{ $queue[-1] || [] }
3163 ? @$widget{qw(user_w user_h)} 3481 and last;
3164 : $widget->size_request;
3165
3166 if (delete $widget->{force_alloc}
3167 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3168 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3169 3482
3483 pop @queue;
3484 }
3485
3486 delete $queue{$widget+0};
3487
3488 my ($w, $h) = $widget->size_request;
3489
3490 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3491 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3492
3493 $w = $widget->{force_w} if exists $widget->{force_w};
3494 $h = $widget->{force_h} if exists $widget->{force_h};
3495
3496 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3497 || delete $widget->{force_realloc}) {
3170 $widget->{req_w} = $w; 3498 $widget->{req_w} = $w;
3171 $widget->{req_h} = $h; 3499 $widget->{req_h} = $h;
3172 3500
3173 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3501 $self->{size_alloc}{$widget+0} = $widget;
3174 3502
3175 $widget->{parent}->check_size
3176 if $widget->{parent}; 3503 if (my $parent = $widget->{parent}) {
3504 $self->{realloc}{$parent+0} = $parent
3505 unless $queue{$parent+0};
3506
3507 $parent->{force_size_alloc} = 1;
3508 $self->{size_alloc}{$parent+0} = $parent;
3509 }
3177 } 3510 }
3511
3512 delete $self->{realloc}{$widget+0};
3178 } 3513 }
3179 } 3514 }
3180 3515
3181 while ($self->{size_alloc}) { 3516 while (my $size_alloc = delete $self->{size_alloc}) {
3182 for (values %{delete $self->{size_alloc}}) { 3517 my @queue = sort { $b->{visible} <=> $a->{visible} }
3183 my ($widget, $w, $h) = @$_; 3518 values %$size_alloc;
3519
3520 while () {
3521 my $widget = pop @queue || last;
3522
3523 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3184 3524
3185 $w = 0 if $w < 0; 3525 $w = 0 if $w < 0;
3186 $h = 0 if $h < 0; 3526 $h = 0 if $h < 0;
3187 3527
3528 $w = int $w + 0.5;
3529 $h = int $h + 0.5;
3530
3531 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3532 $widget->{old_w} = $widget->{w};
3533 $widget->{old_h} = $widget->{h};
3534
3188 $widget->{w} = $w; 3535 $widget->{w} = $w;
3189 $widget->{h} = $h; 3536 $widget->{h} = $h;
3190 $widget->size_allocate ($w, $h); 3537
3191 $widget->emit (size_allocate => $w, $h); 3538 $widget->emit (size_allocate => $w, $h);
3539 }
3192 } 3540 }
3193 } 3541 }
3194 3542
3195 while ($self->{post_alloc_hook}) { 3543 while ($self->{post_alloc_hook}) {
3196 $_->() 3544 $_->()
3197 for values %{delete $self->{post_alloc_hook}}; 3545 for values %{delete $self->{post_alloc_hook}};
3198 } 3546 }
3547
3199 3548
3200 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3549 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3201 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3550 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3202 glClear GL_COLOR_BUFFER_BIT; 3551 glClear GL_COLOR_BUFFER_BIT;
3203 3552
… …
3205 glLoadIdentity; 3554 glLoadIdentity;
3206 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 3555 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3207 glMatrixMode GL_MODELVIEW; 3556 glMatrixMode GL_MODELVIEW;
3208 glLoadIdentity; 3557 glLoadIdentity;
3209 3558
3559 {
3560 package CFClient::UI::Base;
3561
3562 ($draw_x, $draw_y, $draw_w, $draw_h) =
3563 (0, 0, $self->{w}, $self->{h});
3564 }
3565
3210 $self->_draw; 3566 $self->_draw;
3211} 3567}
3212 3568
3213############################################################################# 3569#############################################################################
3214 3570

Diff Legend

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