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.222 by root, Mon May 22 03:59:51 2006 UTC vs.
Revision 1.265 by root, Thu Jun 1 02:59:46 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
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}
18 43
19sub check_tooltip { 44sub check_tooltip {
20 if (!$GRAB) { 45 if (!$GRAB) {
21 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 46 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
22 if (length $widget->{tooltip}) { 47 if (length $widget->{tooltip}) {
23 48
24 if ($TOOLTIP->{owner} != $widget) { 49 if ($TOOLTIP->{owner} != $widget) {
50 $TOOLTIP->hide;
51
25 $TOOLTIP->{owner} = $widget; 52 $TOOLTIP->{owner} = $widget;
26 53
27 my $tip = $widget->{tooltip}; 54 my $tip = $widget->{tooltip};
28 55
29 $tip = $tip->($widget) if CODE:: eq ref $tip; 56 $tip = $tip->($widget) if CODE:: eq ref $tip;
30 57
31 $TOOLTIP->set_tooltip_from ($widget); 58 $TOOLTIP->set_tooltip_from ($widget);
32 $TOOLTIP->show; 59 $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 } 60 }
43 61
44 return; 62 return;
45 } 63 }
46 } 64 }
… …
50 delete $TOOLTIP->{owner}; 68 delete $TOOLTIP->{owner};
51} 69}
52 70
53# class methods for events 71# class methods for events
54sub feed_sdl_key_down_event { 72sub feed_sdl_key_down_event {
55 $FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0]) 73 $FOCUS->emit (key_down => $_[0])
56 if $FOCUS; 74 if $FOCUS;
57} 75}
58 76
59sub feed_sdl_key_up_event { 77sub feed_sdl_key_up_event {
60 $FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0]) 78 $FOCUS->emit (key_up => $_[0])
61 if $FOCUS; 79 if $FOCUS;
62} 80}
63 81
64sub feed_sdl_button_down_event { 82sub feed_sdl_button_down_event {
65 my ($ev) = @_; 83 my ($ev) = @_;
… …
74 check_tooltip; 92 check_tooltip;
75 } 93 }
76 94
77 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 95 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
78 96
79 if ($GRAB) { 97 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
80 ($x, $y) = $GRAB->coord2local ($x, $y); 98 if $GRAB;
81 $GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
82 }
83} 99}
84 100
85sub feed_sdl_button_up_event { 101sub feed_sdl_button_up_event {
86 my ($ev) = @_; 102 my ($ev) = @_;
87 my ($x, $y) = ($ev->{x}, $ev->{y}); 103 my ($x, $y) = ($ev->{x}, $ev->{y});
88 104
89 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 105 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
90 106
91 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 107 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
92 108
93 if ($GRAB) { 109 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
94 ($x, $y) = $GRAB->coord2local ($x, $y); 110 if $GRAB;
95 $GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
96 }
97 111
98 if (!$BUTTON_STATE) { 112 if (!$BUTTON_STATE) {
99 my $grab = $GRAB; undef $GRAB; 113 my $grab = $GRAB; undef $GRAB;
100 $grab->update if $grab; 114 $grab->update if $grab;
101 $GRAB->update if $GRAB; 115 $GRAB->update if $GRAB;
… …
117 $HOVER->update if $HOVER && $HOVER->{can_hover}; 131 $HOVER->update if $HOVER && $HOVER->{can_hover};
118 132
119 check_tooltip; 133 check_tooltip;
120 } 134 }
121 135
122 if ($HOVER) {
123 ($x, $y) = $HOVER->coord2local ($x, $y);
124 $HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y); 136 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
125 } 137 if $HOVER;
126} 138}
127 139
128# convert position array to integers 140# convert position array to integers
129sub harmonize { 141sub harmonize {
130 my ($vals) = @_; 142 my ($vals) = @_;
… …
144 156
145 $_->update 157 $_->update
146 for @widgets; 158 for @widgets;
147} 159}
148 160
161sub reconfigure_widgets {
162 # make a copy, otherwise C<for> complains about freed values.
163 my @widgets = values %WIDGET;
164
165 $_->reconfigure
166 for @widgets;
167}
168
149# call when resolution changes etc. 169# call when resolution changes etc.
150sub rescale_widgets { 170sub rescale_widgets {
151 my ($sx, $sy) = @_; 171 my ($sx, $sy) = @_;
152 172
153 # make a copy, otherwise for complains about freed values.
154 my @widgets = values %WIDGET; 173 for my $widget (values %WIDGET) {
155
156 for my $widget (@widgets) {
157 if ($widget->{toplevel}) { 174 if ($widget->{is_toplevel}) {
175 $widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
176 $widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
177
158 $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x}; 178 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
159 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 179 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
160 $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w}; 180 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
161 $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
162 $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y}; 181 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
163 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 182 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
164 $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h}; 183 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
165 $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h}; 184
185 $widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
186 $widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
187
166 } 188 }
167
168 $widget->reconfigure;
169 } 189 }
190
191 reconfigure_widgets;
170} 192}
171 193
172############################################################################# 194#############################################################################
173 195
174package CFClient::UI::Base; 196package CFClient::UI::Base;
… …
179 201
180sub new { 202sub new {
181 my $class = shift; 203 my $class = shift;
182 204
183 my $self = bless { 205 my $self = bless {
184 x => 0, 206 x => "center",
185 y => 0, 207 y => "center",
186 z => 0, 208 z => 0,
209 w => undef,
210 h => undef,
187 can_events => 1, 211 can_events => 1,
188 @_ 212 @_
189 }, $class; 213 }, $class;
190 214
215 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
216
191 for (keys %$self) { 217 for (keys %$self) {
192 if (/^connect_(.*)$/) { 218 if (/^on_(.*)$/) {
193 $self->connect ($1 => delete $self->{$_}); 219 $self->connect ($1 => delete $self->{$_});
194 } 220 }
195 } 221 }
196 222
197 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 223 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
224 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
225 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
226 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
227 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
228
229 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
230 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
231
232 $self->show if $layout->{show};
233 }
198 234
199 $self 235 $self
200} 236}
201 237
202sub destroy { 238sub destroy {
… …
206 %$self = (); 242 %$self = ();
207} 243}
208 244
209sub show { 245sub show {
210 my ($self) = @_; 246 my ($self) = @_;
247
211 return if $self->{parent}; 248 return if $self->{parent};
212 249
213 $CFClient::UI::ROOT->add ($self); 250 $CFClient::UI::ROOT->add ($self);
214} 251}
215 252
216sub hide { 253sub set_visible {
217 my ($self) = @_; 254 my ($self) = @_;
255
256 return if $self->{visible};
257
258 $self->{root} = $self->{parent}{root};
259 $self->{visible} = $self->{parent}{visible} + 1;
260
261 $self->emit (visibility_change => 1);
262
263 $self->realloc if !exists $self->{req_w};
264
265 $_->set_visible for $self->children;
266}
267
268sub set_invisible {
269 my ($self) = @_;
270
271 return unless $self->{visible};
272
273 $_->set_invisible for $self->children;
274
275 delete $self->{root};
276 delete $self->{visible};
218 277
219 undef $GRAB if $GRAB == $self; 278 undef $GRAB if $GRAB == $self;
220 undef $HOVER if $HOVER == $self; 279 undef $HOVER if $HOVER == $self;
221 280
281 CFClient::UI::check_tooltip
282 if $TOOLTIP->{owner} == $self;
283
284 $self->focus_out;
285
286 $self->emit (visibility_change => 0);
287}
288
289sub set_visibility {
290 my ($self, $visible) = @_;
291
292 return if $self->{visible} == $visible;
293
294 $visible ? $self->hide
295 : $self->show;
296}
297
298sub toggle_visibility {
299 my ($self) = @_;
300
301 $self->{visible}
302 ? $self->hide
303 : $self->show;
304}
305
306sub hide {
307 my ($self) = @_;
308
309 $self->set_invisible;
310
222 $self->{parent}->remove ($self) 311 $self->{parent}->remove ($self)
223 if $self->{parent}; 312 if $self->{parent};
224} 313}
225 314
226sub move { 315sub move_abs {
227 my ($self, $x, $y, $z) = @_; 316 my ($self, $x, $y, $z) = @_;
228 317
229 $self->{x} = int $x; 318 $self->{x} = List::Util::max 0, int $x;
230 $self->{y} = int $y; 319 $self->{y} = List::Util::max 0, int $y;
231 $self->{z} = $z if defined $z; 320 $self->{z} = $z if defined $z;
232 321
233 $self->update; 322 $self->update;
234} 323}
235 324
236sub set_size { 325sub set_size {
237 my ($self, $w, $h) = @_; 326 my ($self, $w, $h) = @_;
238 327
239 $self->{user_w} = $w; 328 $self->{force_w} = $w;
240 $self->{user_h} = $h; 329 $self->{force_h} = $h;
241 330
242 $self->check_size; 331 $self->realloc;
243} 332}
244 333
245sub size_request { 334sub size_request {
246 require Carp; 335 require Carp;
247 Carp::confess "size_request is abstract"; 336 Carp::confess "size_request is abstract";
… …
249 338
250sub configure { 339sub configure {
251 my ($self, $x, $y, $w, $h) = @_; 340 my ($self, $x, $y, $w, $h) = @_;
252 341
253 if ($self->{aspect}) { 342 if ($self->{aspect}) {
343 my ($ow, $oh) = ($w, $h);
344
254 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 345 $w = List::Util::min $w, int $h * $self->{aspect};
255 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 346 $h = List::Util::min $h, int $w / $self->{aspect};
256 347
257 # use alignment to adjust x, y 348 # use alignment to adjust x, y
258 349
259 $x += int +($w - $w2) * 0.5; 350 $x += int 0.5 * ($ow - $w);
260 $y += int +($h - $h2) * 0.5; 351 $y += int 0.5 * ($oh - $h);
261
262 ($w, $h) = ($w2, $h2);
263 } 352 }
264 353
265 if ($self->{x} != $x || $self->{y} != $y) { 354 if ($self->{x} ne $x || $self->{y} ne $y) {
266 $self->{x} = $x; 355 $self->{x} = $x;
267 $self->{y} = $y; 356 $self->{y} = $y;
268 $self->update; 357 $self->update;
269 } 358 }
270 359
271 if ($self->{w} != $w || $self->{h} != $h) { 360 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
272 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h]; 361 return unless $self->{visible};
362
363 $self->{alloc_w} = $w;
364 $self->{alloc_h} = $h;
365
366 $self->{root}{size_alloc}{$self+0} = $self;
273 } 367 }
274} 368}
275 369
276sub size_allocate { 370sub size_allocate {
277 # nothing to be done 371 # nothing to be done
278} 372}
279 373
280sub reconfigure {
281 my ($self) = @_;
282
283 $self->check_size (1);
284 $self->update;
285}
286
287sub children { 374sub children {
288} 375}
289 376
290sub set_max_size { 377sub set_max_size {
291 my ($self, $w, $h) = @_; 378 my ($self, $w, $h) = @_;
… …
294 delete $self->{max_h}; $self->{max_h} = $h if $h; 381 delete $self->{max_h}; $self->{max_h} = $h if $h;
295} 382}
296 383
297sub set_tooltip { 384sub set_tooltip {
298 my ($self, $tooltip) = @_; 385 my ($self, $tooltip) = @_;
386
387 $tooltip =~ s/^\s+//;
388 $tooltip =~ s/\s+$//;
389
390 return if $self->{tooltip} eq $tooltip;
299 391
300 $self->{tooltip} = $tooltip; 392 $self->{tooltip} = $tooltip;
301 393
302 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 394 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
303 delete $CFClient::UI::TOOLTIP->{owner}; 395 delete $CFClient::UI::TOOLTIP->{owner};
… …
325 return if $FOCUS == $self; 417 return if $FOCUS == $self;
326 return unless $self->{can_focus}; 418 return unless $self->{can_focus};
327 419
328 my $focus = $FOCUS; $FOCUS = $self; 420 my $focus = $FOCUS; $FOCUS = $self;
329 421
330 $self->emit (focus_in => $focus); 422 $self->_emit (focus_in => $focus);
331 423
332 $focus->update if $focus; 424 $focus->update if $focus;
333 $FOCUS->update; 425 $FOCUS->update;
334} 426}
335 427
… …
338 430
339 return unless $FOCUS == $self; 431 return unless $FOCUS == $self;
340 432
341 my $focus = $FOCUS; undef $FOCUS; 433 my $focus = $FOCUS; undef $FOCUS;
342 434
343 $self->emit (focus_out => $focus); 435 $self->_emit (focus_out => $focus);
344 436
345 $focus->update if $focus; #? 437 $focus->update if $focus; #?
438
439 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
440 unless $FOCUS;
346} 441}
347 442
348sub mouse_motion { } 443sub mouse_motion { }
349sub button_up { } 444sub button_up { }
350sub key_down { } 445sub key_down { }
351sub key_up { } 446sub key_up { }
352 447
353sub button_down { 448sub button_down {
354 my ($self, $ev, $x, $y) = @_; 449 my ($self, $ev, $x, $y) = @_;
355 450
356 $self->focus_in; 451 $self->focus_in;
… …
359sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 454sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
360sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 455sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
361sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 456sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
362sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 457sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
363sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 458sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
459
460sub find_widget {
461 my ($self, $x, $y) = @_;
462
463 return () unless $self->{can_events};
464
465 return $self
466 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
467 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
468
469 ()
470}
471
472sub set_parent {
473 my ($self, $parent) = @_;
474
475 Scalar::Util::weaken ($self->{parent} = $parent);
476 $self->set_visible if $parent->{visible};
477}
478
479sub connect {
480 my ($self, $signal, $cb) = @_;
481
482 push @{ $self->{signal_cb}{$signal} }, $cb;
483}
484
485sub _emit {
486 my ($self, $signal, @args) = @_;
487
488 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
489}
490
491sub emit {
492 my ($self, $signal, @args) = @_;
493
494 $self->_emit ($signal, @args)
495 || $self->$signal (@args);
496}
497
498sub visibility_change {
499 #my ($self, $visible) = @_;
500}
501
502sub realloc {
503 my ($self) = @_;
504
505 if ($self->{visible}) {
506 return if $self->{root}{realloc}{$self+0};
507
508 $self->{root}{realloc}{$self+0} = $self;
509 $self->{root}->update;
510 } else {
511 delete $self->{req_w};
512 delete $self->{req_h};
513 }
514}
515
516sub update {
517 my ($self) = @_;
518
519 $self->{parent}->update
520 if $self->{parent};
521}
522
523sub reconfigure {
524 my ($self) = @_;
525
526 $self->realloc;
527 $self->update;
528}
364 529
365sub draw { 530sub draw {
366 my ($self) = @_; 531 my ($self) = @_;
367 532
368 return unless $self->{h} && $self->{w}; 533 return unless $self->{h} && $self->{w};
… …
385 glVertex $x , $y + $self->{h}; 550 glVertex $x , $y + $self->{h};
386 glEnd; 551 glEnd;
387 glDisable GL_BLEND; 552 glDisable GL_BLEND;
388 } 553 }
389 554
390 if ($ENV{PCLIENT_DEBUG}) { 555 if ($ENV{CFPLUS_DEBUG} & 1) {
391 glPushMatrix; 556 glPushMatrix;
392 glColor 1, 1, 0, 1; 557 glColor 1, 1, 0, 1;
393 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 558 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
394 glBegin GL_LINE_LOOP; 559 glBegin GL_LINE_LOOP;
395 glVertex 0 , 0; 560 glVertex 0 , 0;
396 glVertex $self->{w}, 0; 561 glVertex $self->{w} - 1, 0;
397 glVertex $self->{w}, $self->{h}; 562 glVertex $self->{w} - 1, $self->{h} - 1;
398 glVertex 0 , $self->{h}; 563 glVertex 0 , $self->{h} - 1;
399 glEnd; 564 glEnd;
400 glPopMatrix; 565 glPopMatrix;
401 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 566 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
402 } 567 }
403} 568}
404 569
405sub _draw { 570sub _draw {
406 my ($self) = @_; 571 my ($self) = @_;
407 572
408 warn "no draw defined for $self\n"; 573 warn "no draw defined for $self\n";
409}
410
411sub find_widget {
412 my ($self, $x, $y) = @_;
413
414 return () unless $self->{can_events};
415
416 return $self
417 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
418 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
419
420 ()
421}
422
423sub set_parent {
424 my ($self, $parent) = @_;
425
426 Scalar::Util::weaken ($self->{parent} = $parent);
427
428 # TODO: req_w _does_change after ->reconfigure
429 $self->check_size
430 unless exists $self->{req_w};
431
432 $self->show;
433}
434
435sub check_size {
436 my ($self, $forced) = @_;
437
438 $self->{force_alloc} = 1 if $forced;
439 $CFClient::UI::ROOT->{check_size}{$self} = $self;
440}
441
442sub update {
443 my ($self) = @_;
444
445 $self->{parent}->update
446 if $self->{parent};
447}
448
449sub connect {
450 my ($self, $signal, $cb) = @_;
451
452 push @{ $self->{signal_cb}{$signal} }, $cb;
453}
454
455sub emit {
456 my ($self, $signal, @args) = @_;
457
458 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
459} 574}
460 575
461sub DESTROY { 576sub DESTROY {
462 my ($self) = @_; 577 my ($self) = @_;
463 578
… …
521 my ($class, %arg) = @_; 636 my ($class, %arg) = @_;
522 $class->SUPER::new (can_events => 0, %arg); 637 $class->SUPER::new (can_events => 0, %arg);
523} 638}
524 639
525sub size_request { 640sub size_request {
526 (0, 0) 641 my ($self) = @_;
642
643 ($self->{w} + 0, $self->{h} + 0)
527} 644}
528 645
529sub draw { } 646sub draw { }
530 647
531############################################################################# 648#############################################################################
… …
560 $self->{children} = [ 677 $self->{children} = [
561 sort { $a->{z} <=> $b->{z} } 678 sort { $a->{z} <=> $b->{z} }
562 @{$self->{children}}, @widgets 679 @{$self->{children}}, @widgets
563 ]; 680 ];
564 681
565 $self->check_size (1); 682 $self->realloc;
566 $self->update;
567} 683}
568 684
569sub children { 685sub children {
570 @{ $_[0]{children} } 686 @{ $_[0]{children} }
571} 687}
… …
576 delete $child->{parent}; 692 delete $child->{parent};
577 $child->hide; 693 $child->hide;
578 694
579 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 695 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
580 696
581 $self->check_size; 697 $self->realloc;
582 $self->update;
583} 698}
584 699
585sub clear { 700sub clear {
586 my ($self) = @_; 701 my ($self) = @_;
587 702
… …
591 for (@$children) { 706 for (@$children) {
592 delete $_->{parent}; 707 delete $_->{parent};
593 $_->hide; 708 $_->hide;
594 } 709 }
595 710
596 $self->check_size; 711 $self->realloc;
597 $self->update;
598} 712}
599 713
600sub find_widget { 714sub find_widget {
601 my ($self, $x, $y) = @_; 715 my ($self, $x, $y) = @_;
602 716
… …
726 840
727package CFClient::UI::ViewPort; 841package CFClient::UI::ViewPort;
728 842
729our @ISA = CFClient::UI::Window::; 843our @ISA = CFClient::UI::Window::;
730 844
845sub new {
846 my $class = shift;
847
848 $class->SUPER::new (
849 scroll_x => 0,
850 scroll_y => 1,
851 @_,
852 )
853}
854
731sub size_request { 855sub size_request {
732 my ($self) = @_; 856 my ($self) = @_;
733 857
734 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 858 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
735 $self->child->configure (0, 0, @$self{qw(child_w child_h)});
736 859
737 @$self{qw(child_w child_h)} 860 $w = 10 if $self->{scroll_x};
861 $h = 10 if $self->{scroll_y};
862
863 ($w, $h)
738} 864}
739 865
740sub size_allocate { 866sub size_allocate {
741 my ($self, $w, $h) = @_; 867 my ($self, $w, $h) = @_;
742 868
869 my $child = $self->child;
870
871 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
872 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
873
874 $self->child->configure (0, 0, $w, $h);
743 $self->update; 875 $self->update;
744} 876}
745 877
746sub set_offset { 878sub set_offset {
747 my ($self, $x, $y) = @_; 879 my ($self, $x, $y) = @_;
… …
798 my $class = shift; 930 my $class = shift;
799 931
800 my $self; 932 my $self;
801 933
802 my $slider = new CFClient::UI::Slider 934 my $slider = new CFClient::UI::Slider
803 vertical => 1, 935 vertical => 1,
804 range => [0, 0, 1, 0.01], # HACK fix 936 range => [0, 0, 1, 0.01], # HACK fix
805 connect_changed => sub { 937 on_changed => sub {
806 $self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h})); 938 $self->{vp}->set_offset (0, $_[1]);
807 }, 939 },
808 ; 940 ;
809 941
810 $self = $class->SUPER::new ( 942 $self = $class->SUPER::new (
811 vp => (new CFClient::UI::ViewPort expand => 1), 943 vp => (new CFClient::UI::ViewPort expand => 1),
… …
816 $self->{vp}->add ($self->{scrolled}); 948 $self->{vp}->add ($self->{scrolled});
817 $self->add ($self->{vp}); 949 $self->add ($self->{vp});
818 $self->add ($self->{slider}); 950 $self->add ($self->{slider});
819 951
820 $self 952 $self
953}
954
955sub update {
956 my ($self) = @_;
957
958 $self->SUPER::update;
959
960 # todo: overwrite size_allocate of child
961 my $child = $self->{vp}->child;
962 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
963}
964
965sub size_allocate {
966 my ($self, $w, $h) = @_;
967
968 $self->SUPER::size_allocate ($w, $h);
969
970 my $child = $self->{vp}->child;
971 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
821} 972}
822 973
823#TODO# update range on size_allocate depending on child 974#TODO# update range on size_allocate depending on child
824# update viewport offset on scroll 975# update viewport offset on scroll
825 976
… …
869 1020
870our @ISA = CFClient::UI::Bin::; 1021our @ISA = CFClient::UI::Bin::;
871 1022
872use CFClient::OpenGL; 1023use CFClient::OpenGL;
873 1024
874my @tex = 1025my $bg =
1026 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1027 mipmap => 1, wrap => 1;
1028
1029my @border =
875 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1030 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
876 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1031 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
877 1032
878sub new { 1033sub new {
879 my $class = shift; 1034 my $class = shift;
880 1035
881 # TODO: user_x, user_y, overwrite moveto?
882
883 my $self = $class->SUPER::new ( 1036 my $self = $class->SUPER::new (
884 bg => [1, 1, 1, 1], 1037 bg => [1, 1, 1, 1],
885 border_bg => [1, 1, 1, 1], 1038 border_bg => [1, 1, 1, 1],
886 border => 0.6, 1039 border => 0.6,
887 toplevel => 1,
888 can_events => 1, 1040 can_events => 1,
1041 min_w => 16,
1042 min_h => 16,
889 @_ 1043 @_
890 ); 1044 );
891 1045
892 $self->{title} &&= new CFClient::UI::Label 1046 $self->{title} &&= new CFClient::UI::Label
893 align => 0, 1047 align => 0,
… …
946 my ($ev, $x, $y) = @_; 1100 my ($ev, $x, $y) = @_;
947 1101
948 my $dx = $ev->{x} - $ox; 1102 my $dx = $ev->{x} - $ox;
949 my $dy = $ev->{y} - $oy; 1103 my $dy = $ev->{y} - $oy;
950 1104
951 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1105 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
952 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1106 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1107
1108 $self->realloc;
953 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1109 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
954 $self->check_size;
955 }; 1110 };
956 1111
957 } elsif ($lr ^ $td) { 1112 } elsif ($lr ^ $td) {
958 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1113 my ($ox, $oy) = ($ev->{x}, $ev->{y});
959 my ($bx, $by) = ($self->{x}, $self->{y}); 1114 my ($bx, $by) = ($self->{x}, $self->{y});
… …
961 $self->{motion} = sub { 1116 $self->{motion} = sub {
962 my ($ev, $x, $y) = @_; 1117 my ($ev, $x, $y) = @_;
963 1118
964 ($x, $y) = ($ev->{x}, $ev->{y}); 1119 ($x, $y) = ($ev->{x}, $ev->{y});
965 1120
966 $self->move ($bx + $x - $ox, $by + $y - $oy); 1121 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
967 $self->update;
968 }; 1122 };
969 } 1123 }
970} 1124}
971 1125
972sub button_up { 1126sub button_up {
… …
991 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1145 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
992 1146
993 my $border = $self->border; 1147 my $border = $self->border;
994 1148
995 glColor @{ $self->{border_bg} }; 1149 glColor @{ $self->{border_bg} };
996 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1150 $border[0]->draw_quad_alpha (0, 0, $w, $border);
997 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1151 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
998 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1152 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
999 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1153 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1000 1154
1001 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1155 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1002 my $bg = $tex[0]; 1156 glColor @{ $self->{bg} };
1003 1157
1004 # TODO: repeat texture not scale 1158 # TODO: repeat texture not scale
1159 # solve this better(?)
1005 my $rep_x = $cw / $bg->{w}; 1160 $bg->{s} = $cw / $bg->{w};
1006 my $rep_y = $ch / $bg->{h}; 1161 $bg->{t} = $ch / $bg->{h};
1007
1008 glColor @{ $self->{bg} };
1009
1010 $bg->{s} = $rep_x;
1011 $bg->{t} = $rep_y;
1012 $bg->{wrap_mode} = 1;
1013 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1162 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1014 } 1163 }
1015 1164
1016 glDisable GL_TEXTURE_2D; 1165 glDisable GL_TEXTURE_2D;
1017 1166
… …
1033sub new { 1182sub new {
1034 my $class = shift; 1183 my $class = shift;
1035 1184
1036 $class->SUPER::new ( 1185 $class->SUPER::new (
1037 col_expand => [], 1186 col_expand => [],
1038 @_ 1187 @_,
1039 ) 1188 )
1189}
1190
1191sub children {
1192 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1040} 1193}
1041 1194
1042sub add { 1195sub add {
1043 my ($self, $x, $y, $child) = @_; 1196 my ($self, $x, $y, $child) = @_;
1044 1197
1045 $child->set_parent ($self); 1198 $child->set_parent ($self);
1046 $self->{children}[$y][$x] = $child; 1199 $self->{children}[$y][$x] = $child;
1047 1200
1048 $child->check_size; 1201 $self->realloc;
1049} 1202}
1050 1203
1051sub children {
1052 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1053}
1054
1055# TODO: move to container class maybe? send childs a signal on removal? 1204# TODO: move to container class maybe? send children a signal on removal?
1056sub clear { 1205sub clear {
1057 my ($self) = @_; 1206 my ($self) = @_;
1058 1207
1059 my @children = $self->children; 1208 my @children = $self->children;
1060 delete $self->{children}; 1209 delete $self->{children};
… …
1062 for (@children) { 1211 for (@children) {
1063 delete $_->{parent}; 1212 delete $_->{parent};
1064 $_->hide; 1213 $_->hide;
1065 } 1214 }
1066 1215
1067 $self->update; 1216 $self->realloc;
1068} 1217}
1069 1218
1070sub get_wh { 1219sub get_wh {
1071 my ($self) = @_; 1220 my ($self) = @_;
1072 1221
… …
1103sub size_allocate { 1252sub size_allocate {
1104 my ($self, $w, $h) = @_; 1253 my ($self, $w, $h) = @_;
1105 1254
1106 my ($ws, $hs) = $self->get_wh; 1255 my ($ws, $hs) = $self->get_wh;
1107 1256
1108 my $req_w = sum @$ws; 1257 my $req_w = (sum @$ws) || 1;
1109 my $req_h = sum @$hs; 1258 my $req_h = (sum @$hs) || 1;
1110 1259
1111 # TODO: nicer code && do row_expand 1260 # TODO: nicer code && do row_expand
1112 my @col_expand = @{$self->{col_expand}}; 1261 my @col_expand = @{$self->{col_expand}};
1113 @col_expand = (1) x @$ws unless @col_expand; 1262 @col_expand = (1) x @$ws unless @col_expand;
1114 my $col_expand = (sum @col_expand) || 1; 1263 my $col_expand = (sum @col_expand) || 1;
… …
1168 } 1317 }
1169} 1318}
1170 1319
1171############################################################################# 1320#############################################################################
1172 1321
1173package CFClient::UI::HBox; 1322package CFClient::UI::Box;
1174
1175# TODO: wrap into common Box base class
1176 1323
1177our @ISA = CFClient::UI::Container::; 1324our @ISA = CFClient::UI::Container::;
1178 1325
1179sub size_request { 1326sub size_request {
1180 my ($self) = @_; 1327 my ($self) = @_;
1181 1328
1182 my @alloc = map [$_->size_request], @{$self->{children}}; 1329 $self->{vertical}
1183 1330 ? (
1184 ( 1331 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1185 (List::Util::sum map $_->[0], @alloc), 1332 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1186 (List::Util::max map $_->[1], @alloc), 1333 )
1187 ) 1334 : (
1335 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1336 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1337 )
1188} 1338}
1189 1339
1190sub size_allocate { 1340sub size_allocate {
1191 my ($self, $w, $h) = @_; 1341 my ($self, $w, $h) = @_;
1192 1342
1193 ($h, $w) = ($w, $h); 1343 my $space = $self->{vertical} ? $h : $w;
1194
1195 my $children = $self->{children}; 1344 my $children = $self->{children};
1196 1345
1197 my @h = map $_->{req_w}, @$children; 1346 my @req;
1198 1347
1199 my $req_h = List::Util::sum @h; 1348 if ($self->{homogeneous}) {
1200 1349 @req = ($space / (@$children || 1)) x @$children;
1201 if ($req_h > $h) {
1202 # ah well, not enough space
1203 $_ *= $h / $req_h for @h;
1204 } else { 1350 } else {
1351 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1352 my $req = List::Util::sum @req;
1353
1354 if ($req > $space) {
1355 # ah well, not enough space
1356 $_ *= $space / $req for @req;
1357 } else {
1205 my $exp = List::Util::sum map $_->{expand}, @$children; 1358 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1206 $exp ||= 1;
1207 1359
1360 $space = ($space - $req) / $expand; # remaining space to give away
1361
1362 $req[$_] += $space * $children->[$_]{expand}
1208 for (0 .. $#$children) { 1363 for 0 .. $#$children;
1209 my $child = $children->[$_];
1210
1211 my $alloc_h = $h[$_];
1212 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1213 $h[$_] = $alloc_h;
1214 } 1364 }
1215 } 1365 }
1216 1366
1217 CFClient::UI::harmonize \@h; 1367 CFClient::UI::harmonize \@req;
1218 1368
1219 my $y = 0; 1369 my $pos = 0;
1220 for (0 .. $#$children) { 1370 for (0 .. $#$children) {
1221 my $child = $children->[$_];
1222 my $h = $h[$_]; 1371 my $alloc = $req[$_];
1223 $child->configure ($y, 0, $h, $w); 1372 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1224 1373
1225 $y += $h; 1374 $pos += $alloc;
1226 } 1375 }
1227 1376
1228 1 1377 1
1229} 1378}
1230 1379
1231############################################################################# 1380#############################################################################
1232 1381
1382package CFClient::UI::HBox;
1383
1384our @ISA = CFClient::UI::Box::;
1385
1386sub new {
1387 my $class = shift;
1388
1389 $class->SUPER::new (
1390 vertical => 0,
1391 @_,
1392 )
1393}
1394
1395#############################################################################
1396
1233package CFClient::UI::VBox; 1397package CFClient::UI::VBox;
1234 1398
1235# TODO: wrap into common Box base class
1236
1237our @ISA = CFClient::UI::Container::; 1399our @ISA = CFClient::UI::Box::;
1238 1400
1239sub size_request { 1401sub new {
1240 my ($self) = @_; 1402 my $class = shift;
1241 1403
1242 my @alloc = map [$_->size_request], @{$self->{children}}; 1404 $class->SUPER::new (
1243 1405 vertical => 1,
1244 ( 1406 @_,
1245 (List::Util::max map $_->[0], @alloc),
1246 (List::Util::sum map $_->[1], @alloc),
1247 ) 1407 )
1248}
1249
1250sub size_allocate {
1251 my ($self, $w, $h) = @_;
1252
1253 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1254
1255 my $children = $self->{children};
1256
1257 my @h = map $_->{req_h}, @$children;
1258
1259 my $req_h = List::Util::sum @h;
1260
1261 if ($req_h > $h) {
1262 # ah well, not enough space
1263 $_ *= $h / $req_h for @h;
1264 } else {
1265 my $exp = List::Util::sum map $_->{expand}, @$children;
1266 $exp ||= 1;
1267
1268 for (0 .. $#$children) {
1269 my $child = $children->[$_];
1270
1271 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1272 }
1273 }
1274
1275 CFClient::UI::harmonize \@h;
1276
1277 my $y = 0;
1278 for (0 .. $#$children) {
1279 my $child = $children->[$_];
1280 my $h = $h[$_];
1281 $child->configure (0, $y, $w, $h);
1282
1283 $y += $h;
1284 }
1285
1286 1
1287} 1408}
1288 1409
1289############################################################################# 1410#############################################################################
1290 1411
1291package CFClient::UI::Label; 1412package CFClient::UI::Label;
… …
1308 ellipsise => 3, # end 1429 ellipsise => 3, # end
1309 layout => (new CFClient::Layout), 1430 layout => (new CFClient::Layout),
1310 fontsize => 1, 1431 fontsize => 1,
1311 align => -1, 1432 align => -1,
1312 valign => -1, 1433 valign => -1,
1313 padding => 2, 1434 padding_x => 2,
1435 padding_y => 2,
1314 can_events => 0, 1436 can_events => 0,
1315 %arg 1437 %arg
1316 ); 1438 );
1317 1439
1318 if (exists $self->{template}) { 1440 if (exists $self->{template}) {
… …
1354 $self->{text} = "T$text"; 1476 $self->{text} = "T$text";
1355 1477
1356 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1478 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1357 $self->{layout}->set_text ($text); 1479 $self->{layout}->set_text ($text);
1358 1480
1481 $self->realloc;
1359 $self->update; 1482 $self->update;
1360 $self->check_size;
1361} 1483}
1362 1484
1363sub set_markup { 1485sub set_markup {
1364 my ($self, $markup) = @_; 1486 my ($self, $markup) = @_;
1365 1487
… …
1369 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1491 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1370 1492
1371 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1493 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1372 $self->{layout}->set_markup ($markup); 1494 $self->{layout}->set_markup ($markup);
1373 1495
1496 $self->realloc;
1374 $self->update; 1497 $self->update;
1375 $self->check_size;
1376} 1498}
1377 1499
1378sub size_request { 1500sub size_request {
1379 my ($self) = @_; 1501 my ($self) = @_;
1380 1502
… …
1394 1516
1395 $w = List::Util::max $w, $w2; 1517 $w = List::Util::max $w, $w2;
1396 $h = List::Util::max $h, $h2; 1518 $h = List::Util::max $h, $h2;
1397 } 1519 }
1398 1520
1399 ( 1521 ($w, $h)
1400 $w + $self->{padding} * 2,
1401 $h + $self->{padding} * 2,
1402 )
1403} 1522}
1404 1523
1405sub size_allocate { 1524sub size_allocate {
1406 my ($self, $w, $h) = @_; 1525 my ($self, $w, $h) = @_;
1407 1526
1408 delete $self->{texture}; 1527 delete $self->{texture}
1528 ;#d#
1409} 1529}
1410 1530
1411sub set_fontsize { 1531sub set_fontsize {
1412 my ($self, $fontsize) = @_; 1532 my ($self, $fontsize) = @_;
1413 1533
1414 $self->{fontsize} = $fontsize; 1534 $self->{fontsize} = $fontsize;
1415 delete $self->{texture}; 1535 delete $self->{texture};
1416 1536
1417 $self->update; 1537 $self->realloc;
1418 $self->check_size;
1419} 1538}
1420 1539
1421sub _draw { 1540sub _draw {
1422 my ($self) = @_; 1541 my ($self) = @_;
1423 1542
… …
1431 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1550 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1432 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1551 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1433 1552
1434 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1553 my $tex = new_from_layout CFClient::Texture $self->{layout};
1435 1554
1436 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1555 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1437 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1556 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1438 : ($self->{w} - $tex->{w}) * 0.5); 1557 : ($self->{w} - $tex->{w}) * 0.5);
1439 1558
1440 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1559 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1441 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1560 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1442 : ($self->{h} - $tex->{h}) * 0.5); 1561 : ($self->{h} - $tex->{h}) * 0.5);
1443 1562
1444 $tex 1563 $tex
1445 }; 1564 };
1446 1565
… …
1475 active_fg => [0, 0, 0], 1594 active_fg => [0, 0, 0],
1476 can_hover => 1, 1595 can_hover => 1,
1477 can_focus => 1, 1596 can_focus => 1,
1478 valign => 0, 1597 valign => 0,
1479 can_events => 1, 1598 can_events => 1,
1599 #text => ...
1480 @_ 1600 @_
1481 ) 1601 )
1482} 1602}
1483 1603
1484sub _set_text { 1604sub _set_text {
… …
1494 $self->{text} = $text; 1614 $self->{text} = $text;
1495 1615
1496 $text =~ s/./*/g if $self->{hidden}; 1616 $text =~ s/./*/g if $self->{hidden};
1497 $self->{layout}->set_text ("$text "); 1617 $self->{layout}->set_text ("$text ");
1498 1618
1499 $self->emit (changed => $self->{text}); 1619 $self->_emit (changed => $self->{text});
1500} 1620}
1501 1621
1502sub set_text { 1622sub set_text {
1503 my ($self, $text) = @_; 1623 my ($self, $text) = @_;
1504 1624
1505 $self->{cursor} = length $text; 1625 $self->{cursor} = length $text;
1506 $self->_set_text ($text); 1626 $self->_set_text ($text);
1507 $self->update; 1627
1508 $self->check_size; 1628 $self->realloc;
1509} 1629}
1510 1630
1511sub get_text { 1631sub get_text {
1512 $_[0]{text} 1632 $_[0]{text}
1513} 1633}
… …
1516 my ($self) = @_; 1636 my ($self) = @_;
1517 1637
1518 my ($w, $h) = $self->SUPER::size_request; 1638 my ($w, $h) = $self->SUPER::size_request;
1519 1639
1520 ($w + 1, $h) # add 1 for cursor 1640 ($w + 1, $h) # add 1 for cursor
1521}
1522
1523sub size_allocate {
1524 my ($self, $w, $h) = @_;
1525
1526 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1527} 1641}
1528 1642
1529sub key_down { 1643sub key_down {
1530 my ($self, $ev) = @_; 1644 my ($self, $ev) = @_;
1531 1645
… …
1546 } elsif ($sym == CFClient::SDLK_HOME) { 1660 } elsif ($sym == CFClient::SDLK_HOME) {
1547 $self->{cursor} = 0; 1661 $self->{cursor} = 0;
1548 } elsif ($sym == CFClient::SDLK_END) { 1662 } elsif ($sym == CFClient::SDLK_END) {
1549 $self->{cursor} = length $text; 1663 $self->{cursor} = length $text;
1550 } elsif ($uni == 27) { 1664 } elsif ($uni == 27) {
1551 $self->emit ('escape'); 1665 $self->_emit ('escape');
1552 } elsif ($uni) { 1666 } elsif ($uni) {
1553 substr $text, $self->{cursor}++, 0, chr $uni; 1667 substr $text, $self->{cursor}++, 0, chr $uni;
1554 } 1668 }
1555 1669
1556 $self->_set_text ($text); 1670 $self->_set_text ($text);
1557 $self->update; 1671
1558 $self->check_size; 1672 $self->realloc;
1559} 1673}
1560 1674
1561sub focus_in { 1675sub focus_in {
1562 my ($self) = @_; 1676 my ($self) = @_;
1563 1677
… …
1643 if ($sym == 13) { 1757 if ($sym == 13) {
1644 unshift @{$self->{history}}, 1758 unshift @{$self->{history}},
1645 my $txt = $self->get_text; 1759 my $txt = $self->get_text;
1646 $self->{history_pointer} = -1; 1760 $self->{history_pointer} = -1;
1647 $self->{history_saveback} = ''; 1761 $self->{history_saveback} = '';
1648 $self->emit (activate => $txt); 1762 $self->_emit (activate => $txt);
1649 $self->update; 1763 $self->update;
1650 1764
1651 } elsif ($sym == CFClient::SDLK_UP) { 1765 } elsif ($sym == CFClient::SDLK_UP) {
1652 if ($self->{history_pointer} < 0) { 1766 if ($self->{history_pointer} < 0) {
1653 $self->{history_saveback} = $self->get_text; 1767 $self->{history_saveback} = $self->get_text;
… …
1690 1804
1691sub new { 1805sub new {
1692 my $class = shift; 1806 my $class = shift;
1693 1807
1694 $class->SUPER::new ( 1808 $class->SUPER::new (
1695 padding => 4, 1809 padding_x => 4,
1810 padding_y => 4,
1696 fg => [1, 1, 1], 1811 fg => [1, 1, 1],
1697 active_fg => [0, 0, 1], 1812 active_fg => [0, 0, 1],
1698 can_hover => 1, 1813 can_hover => 1,
1699 align => 0, 1814 align => 0,
1700 valign => 0, 1815 valign => 0,
1701 can_events => 1, 1816 can_events => 1,
1702 @_ 1817 @_
1703 ) 1818 )
1704} 1819}
1705 1820
1821sub activate { }
1822
1706sub button_up { 1823sub button_up {
1707 my ($self, $ev, $x, $y) = @_; 1824 my ($self, $ev, $x, $y) = @_;
1708 1825
1826 $self->emit ("activate")
1709 if ($x >= 0 && $x < $self->{w} 1827 if $x >= 0 && $x < $self->{w}
1710 && $y >= 0 && $y < $self->{h}) { 1828 && $y >= 0 && $y < $self->{h};
1711 $self->emit ("activate");
1712 }
1713} 1829}
1714 1830
1715sub _draw { 1831sub _draw {
1716 my ($self) = @_; 1832 my ($self) = @_;
1717 1833
… …
1746 1862
1747sub new { 1863sub new {
1748 my $class = shift; 1864 my $class = shift;
1749 1865
1750 $class->SUPER::new ( 1866 $class->SUPER::new (
1751 padding => 2, 1867 padding_x => 2,
1868 padding_y => 2,
1752 fg => [1, 1, 1], 1869 fg => [1, 1, 1],
1753 active_fg => [1, 1, 0], 1870 active_fg => [1, 1, 0],
1754 bg => [0, 0, 0, 0.2], 1871 bg => [0, 0, 0, 0.2],
1755 active_bg => [1, 1, 1, 0.5], 1872 active_bg => [1, 1, 1, 0.5],
1756 state => 0, 1873 state => 0,
… …
1760} 1877}
1761 1878
1762sub size_request { 1879sub size_request {
1763 my ($self) = @_; 1880 my ($self) = @_;
1764 1881
1765 ($self->{padding} * 2 + 6) x 2 1882 (6) x 2
1766} 1883}
1767 1884
1768sub button_down { 1885sub button_down {
1769 my ($self, $ev, $x, $y) = @_; 1886 my ($self, $ev, $x, $y) = @_;
1770 1887
1771 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1888 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1772 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1889 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1773 $self->{state} = !$self->{state}; 1890 $self->{state} = !$self->{state};
1774 $self->emit (changed => $self->{state}); 1891 $self->_emit (changed => $self->{state});
1775 } 1892 }
1776} 1893}
1777 1894
1778sub _draw { 1895sub _draw {
1779 my ($self) = @_; 1896 my ($self) = @_;
1780 1897
1781 $self->SUPER::_draw; 1898 $self->SUPER::_draw;
1782 1899
1783 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1900 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1784 1901
1785 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1902 my ($w, $h) = @$self{qw(w h)};
1903
1904 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1786 1905
1787 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1906 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1788 1907
1789 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1908 my $tex = $self->{state} ? $tex[1] : $tex[0];
1790 1909
… …
2054 my $self = $class->SUPER::new ( 2173 my $self = $class->SUPER::new (
2055 fg => [1, 1, 1], 2174 fg => [1, 1, 1],
2056 active_fg => [0, 0, 0], 2175 active_fg => [0, 0, 0],
2057 bg => [0, 0, 0, 0.2], 2176 bg => [0, 0, 0, 0.2],
2058 active_bg => [1, 1, 1, 0.5], 2177 active_bg => [1, 1, 1, 0.5],
2059 range => [0, 0, 100, 10], 2178 range => [0, 0, 100, 10, 0],
2060 req_w => $::WIDTH / 80, 2179 min_w => $::WIDTH / 80,
2061 req_h => $::WIDTH / 80, 2180 min_h => $::WIDTH / 80,
2062 vertical => 0, 2181 vertical => 0,
2063 can_hover => 1, 2182 can_hover => 1,
2064 inner_pad => 0.02, 2183 inner_pad => 0.02,
2065 @_ 2184 @_
2066 ); 2185 );
… …
2069 $self->update; 2188 $self->update;
2070 2189
2071 $self 2190 $self
2072} 2191}
2073 2192
2193sub changed { }
2194
2195sub set_range {
2196 my ($self, $range) = @_;
2197
2198 ($range, $self->{range}) = ($self->{range}, $range);
2199
2200 $self->update
2201 if "@$range" ne "@{$self->{range}}";
2202}
2203
2074sub set_value { 2204sub set_value {
2075 my ($self, $value) = @_; 2205 my ($self, $value) = @_;
2076 2206
2077 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; 2207 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2078 2208
2079 $hi = $lo + 1 if $hi <= $lo; 2209 $hi = $lo + 1 if $hi <= $lo;
2080 2210
2211 $page = $hi - $lo if $page > $hi - $lo;
2212
2081 $value = $lo if $value < $lo; 2213 $value = $lo if $value < $lo;
2082 $value = $hi if $value > $hi; 2214 $value = $hi - $page if $value > $hi - $page;
2083 2215
2084 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit 2216 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2085 if $unit; 2217 if $unit;
2086 2218
2087 $page = $hi - $lo if $page > $hi - $lo;
2088
2089 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2219 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2090 2220
2091 if ($value != $old_value) { 2221 if ($value != $old_value) {
2092 $self->emit (changed => $value); 2222 $self->_emit (changed => $value);
2093 $self->update; 2223 $self->update;
2094 } 2224 }
2095} 2225}
2096 2226
2097sub size_request { 2227sub size_request {
2098 my ($self) = @_; 2228 my ($self) = @_;
2099 2229
2100 my $w = $self->{req_w}; 2230 ($self->{req_w}, $self->{req_h})
2101 my $h = $self->{req_h};
2102
2103 $self->{vertical} ? ($h, $w) : ($w, $h)
2104} 2231}
2105 2232
2106sub button_down { 2233sub button_down {
2107 my ($self, $ev, $x, $y) = @_; 2234 my ($self, $ev, $x, $y) = @_;
2108 2235
2109 $self->SUPER::button_down ($ev, $x, $y); 2236 $self->SUPER::button_down ($ev, $x, $y);
2237
2238 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2239
2110 $self->mouse_motion ($ev, $x, $y); 2240 $self->mouse_motion ($ev, $x, $y);
2111} 2241}
2112 2242
2113sub mouse_motion { 2243sub mouse_motion {
2114 my ($self, $ev, $x, $y) = @_; 2244 my ($self, $ev, $x, $y) = @_;
… …
2116 if ($GRAB == $self) { 2246 if ($GRAB == $self) {
2117 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2247 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2118 2248
2119 my (undef, $lo, $hi, $page) = @{$self->{range}}; 2249 my (undef, $lo, $hi, $page) = @{$self->{range}};
2120 2250
2121 $x = $x / ($w * (1 - 2 * $self->{inner_pad})) - $self->{inner_pad}; 2251 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2122 2252
2123 $self->set_value ($x * ($hi - $lo) + $lo); 2253 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2124 } 2254 }
2125} 2255}
2126 2256
2127sub update { 2257sub update {
2128 my ($self) = @_; 2258 my ($self) = @_;
2129 2259
2130 $CFClient::UI::ROOT->on_post_alloc ($self => sub { 2260 $CFClient::UI::ROOT->on_post_alloc ($self => sub {
2131 $self->set_value ($self->{range}[0]); 2261 $self->set_value ($self->{range}[0]);
2132 2262
2133 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2263 my ($value, $lo, $hi, $page) = @{$self->{range}};
2264 my $range = ($hi - $page - $lo) || 1e-100;
2134 2265
2135 my $inner_w = 1 - 2 * $self->{inner_pad}; 2266 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2136 2267
2137 $self->{scale} = ($inner_w / ($hi - $lo)) || 1; 2268 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2269 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2138 2270
2139 $page = $self->{scale} * $page || 10 / ($self->{w} || 1); 2271 $value = ($value - $lo) / $range;
2140 $value = $self->{scale} * ($value - $lo); 2272 $value = $value * $self->{scale} + $self->{offset};
2141 2273
2142 $value = $self->{inner_pad} + ($value - $page * 0.5);
2143
2144 $value = 0 if $value < 0;
2145 $page = 1 - $value if $value + $page > 1;
2146
2147 $self->{knob_x} = $value; 2274 $self->{knob_x} = $value - $knob_w * 0.5;
2148 $self->{knob_w} = $page; 2275 $self->{knob_w} = $knob_w;
2149 }); 2276 });
2150 2277
2151 $self->SUPER::update; 2278 $self->SUPER::update;
2152} 2279}
2153 2280
… …
2177 # draw handle 2304 # draw handle
2178 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1); 2305 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2179 2306
2180 glDisable GL_TEXTURE_2D; 2307 glDisable GL_TEXTURE_2D;
2181} 2308}
2309
2310#############################################################################
2311
2312package CFClient::UI::ValSlider;
2313
2314our @ISA = CFClient::UI::HBox::;
2315
2316sub new {
2317 my ($class, %arg) = @_;
2318
2319 my $range = delete $arg{range};
2320
2321 my $self = $class->SUPER::new (
2322 slider => (new CFClient::UI::Slider expand => 1, range => $range),
2323 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
2324 to_value => sub { shift },
2325 from_value => sub { shift },
2326 %arg,
2327 );
2328
2329 $self->{slider}->connect (changed => sub {
2330 my ($self, $value) = @_;
2331 $self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
2332 $self->{parent}->emit (changed => $value);
2333 });
2334
2335# $self->{entry}->connect (changed => sub {
2336# my ($self, $value) = @_;
2337# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
2338# $self->{parent}->emit (changed => $value);
2339# });
2340
2341 $self->add ($self->{slider}, $self->{entry});
2342
2343 $self->{slider}->emit (changed => $self->{slider}{range}[0]);
2344
2345 $self
2346}
2347
2348sub set_range { shift->{slider}->set_range (@_) }
2349sub set_value { shift->{slider}->set_value (@_) }
2182 2350
2183############################################################################# 2351#############################################################################
2184 2352
2185package CFClient::UI::TextView; 2353package CFClient::UI::TextView;
2186 2354
… …
2228 $self->{layout}->set_width ($self->{children}[0]{w}); 2396 $self->{layout}->set_width ($self->{children}[0]{w});
2229 2397
2230 $self->reflow; 2398 $self->reflow;
2231} 2399}
2232 2400
2233sub text_height { 2401sub text_size {
2234 my ($self, $text, $indent) = @_; 2402 my ($self, $text, $indent) = @_;
2235 2403
2236 my $layout = $self->{layout}; 2404 my $layout = $self->{layout};
2237 2405
2238 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2406 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2239 $layout->set_width ($self->{children}[0]{w} - $indent); 2407 $layout->set_width ($self->{children}[0]{w} - $indent);
2240 $layout->set_markup ($text); 2408 $layout->set_markup ($text);
2241 2409
2242 ($layout->size)[1] 2410 $layout->size
2243} 2411}
2244 2412
2245sub reflow { 2413sub reflow {
2246 my ($self) = @_; 2414 my ($self) = @_;
2247 2415
2248 $self->{need_reflow}++; 2416 $self->{need_reflow}++;
2249 $self->update; 2417 $self->update;
2250} 2418}
2251 2419
2420sub set_offset {
2421 my ($self, $offset) = @_;
2422
2423 # todo: base offset on lines or so, not on pixels
2424 $self->{children}[1]->set_value ($offset);
2425}
2426
2427sub clear {
2428 my ($self) = @_;
2429
2430 $self->{par} = [];
2431 $self->{height} = 0;
2432 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2433}
2434
2252sub add_paragraph { 2435sub add_paragraph {
2253 my ($self, $color, $text, $indent) = @_; 2436 my ($self, $color, $text, $indent) = @_;
2254 2437
2255 #TODO: intelligently "reformat" paragraph
2256
2257 for my $line (split /\n/, $text) { 2438 for my $line (split /\n/, $text) {
2258 my $height = $self->text_height ($line); 2439 my ($w, $h) = $self->text_size ($line);
2259 $self->{height} += $height; 2440 $self->{height} += $h;
2260 push @{$self->{par}}, [$height, $color, $indent, $line]; 2441 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2261 } 2442 }
2262 2443
2263 $self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}]; 2444 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2264 $self->{children}[1]->update;
2265} 2445}
2266 2446
2267sub update { 2447sub update {
2268 my ($self) = @_; 2448 my ($self) = @_;
2269 2449
… …
2272 return unless $self->{h} > 0; 2452 return unless $self->{h} > 0;
2273 2453
2274 delete $self->{texture}; 2454 delete $self->{texture};
2275 2455
2276 $ROOT->on_post_alloc ($self, sub { 2456 $ROOT->on_post_alloc ($self, sub {
2457 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2458
2277 if (delete $self->{need_reflow}) { 2459 if (delete $self->{need_reflow}) {
2278 my $height = 0; 2460 my $height = 0;
2279 2461
2280 $height += $_->[0] = $self->text_height ($_->[3], $_->[2]) 2462 my $layout = $self->{layout};
2463
2464 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2465
2281 for @{$self->{par}}; 2466 for (@{$self->{par}}) {
2467 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2468 $layout->set_width ($W - $_->[3]);
2469 $layout->set_markup ($_->[4]);
2470 my ($w, $h) = $layout->size;
2471 $_->[0] = $w + $_->[3];
2472 $_->[1] = $h;
2473 }
2474
2475 $height += $_->[1];
2476 }
2282 2477
2283 $self->{height} = $height; 2478 $self->{height} = $height;
2284 2479
2285 $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}]; 2480 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2286 $self->{children}[1]->update;
2287 2481
2288 delete $self->{texture}; 2482 delete $self->{texture};
2289 } 2483 }
2290 2484
2291 $self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub { 2485 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2292 glClearColor 0.5, 0.5, 0.5, 0; 2486 glClearColor 0.5, 0.5, 0.5, 0;
2293 glClear GL_COLOR_BUFFER_BIT; 2487 glClear GL_COLOR_BUFFER_BIT;
2294 2488
2295 my $top = int $self->{children}[1]{range}[0]; 2489 my $top = int $self->{children}[1]{range}[0];
2296 2490
2297 my $y0 = $top; 2491 my $y0 = $top;
2298 my $y1 = $top + $self->{h}; 2492 my $y1 = $top + $H;
2299 2493
2300 my $y = 0; 2494 my $y = 0;
2301 2495
2302 my $layout = $self->{layout}; 2496 my $layout = $self->{layout};
2303 2497
2304 $layout->set_font ($self->{font}) if $self->{font}; 2498 $layout->set_font ($self->{font}) if $self->{font};
2305 2499
2306 glEnable GL_BLEND; 2500 glEnable GL_BLEND;
2501 #TODO# not correct in windows where rgba is forced off
2307 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2502 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2308 2503
2309 for my $par (@{$self->{par}}) { 2504 for my $par (@{$self->{par}}) {
2310 my $h = $par->[0]; 2505 my $h = $par->[1];
2311 2506
2312 if ($y0 < $y + $h && $y < $y1) { 2507 if ($y0 < $y + $h && $y < $y1) {
2313 $layout->set_foreground (@{ $par->[1] }); 2508 $layout->set_foreground (@{ $par->[2] });
2314 $layout->set_width ($self->{w} - $par->[2]); 2509 $layout->set_width ($W - $par->[3]);
2315 $layout->set_markup ($par->[3]); 2510 $layout->set_markup ($par->[4]);
2316 2511
2317 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2512 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2318 2513
2319 glRasterPos $par->[2], $y - $y0; 2514 glRasterPos $par->[3], $y - $y0;
2320 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2515 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2321 } 2516 }
2322 2517
2323 $y += $h; 2518 $y += $h;
2324 } 2519 }
… …
2391 2586
2392sub new { 2587sub new {
2393 my $class = shift; 2588 my $class = shift;
2394 2589
2395 my $self = $class->SUPER::new ( 2590 my $self = $class->SUPER::new (
2396 state => 0, 2591 state => 0,
2397 connect_activate => \&toggle_flopper, 2592 on_activate => \&toggle_flopper,
2398 @_ 2593 @_
2399 ); 2594 );
2400 2595
2401 if ($self->{state}) {
2402 $self->{state} = 0;
2403 $self->toggle_flopper;
2404 }
2405
2406 $self 2596 $self
2407} 2597}
2408 2598
2409sub toggle_flopper { 2599sub toggle_flopper {
2410 my ($self) = @_; 2600 my ($self) = @_;
2411 2601
2412 # TODO: use animation 2602 $self->{other}->toggle_visibility;
2413 if ($self->{state} = !$self->{state}) {
2414 $CFClient::UI::ROOT->add ($self->{other});
2415 $self->{other}->move ($self->coord2global (0, $self->{h}));
2416 $self->emit ("open");
2417 } else {
2418 $CFClient::UI::ROOT->remove ($self->{other});
2419 $self->emit ("close");
2420 }
2421
2422 $self->emit (changed => $self->{state});
2423} 2603}
2424 2604
2425############################################################################# 2605#############################################################################
2426 2606
2427package CFClient::UI::Tooltip; 2607package CFClient::UI::Tooltip;
… …
2440} 2620}
2441 2621
2442sub set_tooltip_from { 2622sub set_tooltip_from {
2443 my ($self, $widget) = @_; 2623 my ($self, $widget) = @_;
2444 2624
2625 my $tooltip = $widget->{tooltip};
2626
2627 if ($ENV{CFPLUS_DEBUG} & 2) {
2628 $tooltip .= "\n\n" . (ref $widget) . "\n"
2629 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2630 . "req $widget->{req_w} $widget->{req_h}\n"
2631 . "visible $widget->{visible}";
2632 }
2633
2445 $self->add (new CFClient::UI::Label 2634 $self->add (new CFClient::UI::Label
2446 markup => $widget->{tooltip}, 2635 markup => $tooltip,
2447 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2636 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2448 fontsize => 0.8, 2637 fontsize => 0.8,
2449 fg => [0, 0, 0, 1], 2638 fg => [0, 0, 0, 1],
2450 ellipsise => 0, 2639 ellipsise => 0,
2451 font => ($widget->{tooltip_font} || $::FONT_PROP), 2640 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2462 2651
2463sub size_allocate { 2652sub size_allocate {
2464 my ($self, $w, $h) = @_; 2653 my ($self, $w, $h) = @_;
2465 2654
2466 $self->SUPER::size_allocate ($w - 4, $h - 4); 2655 $self->SUPER::size_allocate ($w - 4, $h - 4);
2656}
2657
2658sub visibility_change {
2659 my ($self, $visible) = @_;
2660
2661 return unless $visible;
2662
2663 $self->{root}->on_post_alloc ("move_$self" => sub {
2664 my $widget = $self->{owner}
2665 or return;
2666
2667 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2668
2669 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2670 if $x + $self->{w} > $::WIDTH;
2671
2672 $self->move_abs ($x, $y);
2673 });
2467} 2674}
2468 2675
2469sub _draw { 2676sub _draw {
2470 my ($self) = @_; 2677 my ($self) = @_;
2471 2678
… …
2488 glVertex $w, $h; 2695 glVertex $w, $h;
2489 glVertex $w, 0; 2696 glVertex $w, 0;
2490 glEnd; 2697 glEnd;
2491 2698
2492 glTranslate 2 - 0.375, 2 - 0.375; 2699 glTranslate 2 - 0.375, 2 - 0.375;
2700
2493 $self->SUPER::_draw; 2701 $self->SUPER::_draw;
2494} 2702}
2495 2703
2496############################################################################# 2704#############################################################################
2497 2705
… …
2503 2711
2504sub new { 2712sub new {
2505 my $class = shift; 2713 my $class = shift;
2506 2714
2507 my $self = $class->SUPER::new ( 2715 my $self = $class->SUPER::new (
2508 aspect => 1, 2716 aspect => 1,
2717 can_events => 0,
2509 @_, 2718 @_,
2510 ); 2719 );
2511 2720
2512 if ($self->{anim} && $self->{animspeed}) { 2721 if ($self->{anim} && $self->{animspeed}) {
2513 Scalar::Util::weaken (my $widget = $self); 2722 Scalar::Util::weaken (my $widget = $self);
… …
2539} 2748}
2540 2749
2541sub _draw { 2750sub _draw {
2542 my ($self) = @_; 2751 my ($self) = @_;
2543 2752
2544 return unless $::CONN;#d# manage and cache textures differently 2753 return unless $::CONN;
2545 2754
2546 my $face; 2755 my $face;
2547 2756
2548 if ($self->{frame}) { 2757 if ($self->{frame}) {
2549 my $anim = $::CONN->{anim}[$self->{anim}]; 2758 my $anim = $::CONN->{anim}[$self->{anim}];
… …
2568 2777
2569 $self->{timer}->cancel 2778 $self->{timer}->cancel
2570 if $self->{timer}; 2779 if $self->{timer};
2571 2780
2572 $self->SUPER::DESTROY; 2781 $self->SUPER::DESTROY;
2573}
2574
2575#############################################################################
2576
2577package CFClient::UI::InventoryItem;
2578
2579our @ISA = CFClient::UI::HBox::;
2580
2581sub _item_to_desc {
2582 my ($item) = @_;
2583
2584 my $desc =
2585 $item->{nrof} < 2
2586 ? $item->{name}
2587 : "$item->{nrof} × $item->{name_pl}";
2588
2589 $item->{flags} & Crossfire::Protocol::F_OPEN
2590 and $desc .= " (open)";
2591 $item->{flags} & Crossfire::Protocol::F_APPLIED
2592 and $desc .= " (applied)";
2593 $item->{flags} & Crossfire::Protocol::F_UNPAID
2594 and $desc .= " (unpaid)";
2595 $item->{flags} & Crossfire::Protocol::F_MAGIC
2596 and $desc .= " (magic)";
2597 $item->{flags} & Crossfire::Protocol::F_CURSED
2598 and $desc .= " (cursed)";
2599 $item->{flags} & Crossfire::Protocol::F_DAMNED
2600 and $desc .= " (damned)";
2601 $item->{flags} & Crossfire::Protocol::F_LOCKED
2602 and $desc .= " *";
2603
2604 $desc
2605}
2606
2607sub new {
2608 my $class = shift;
2609
2610 my %args = @_;
2611
2612 my $item = delete $args{item};
2613
2614 my $desc = _item_to_desc ($item);
2615
2616 my $self = $class->SUPER::new (
2617 can_hover => 1,
2618 can_events => 1,
2619 tooltip => ((CFClient::UI::Label::escape $desc)
2620 . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
2621 connect_button_down => sub {
2622 my ($self, $ev, $x, $y) = @_;
2623
2624 # todo: maybe put examine on 1? but should just be a tooltip :(
2625 if ($ev->{button} == 1) {
2626 my $targ = $::CONN->{player}{tag};
2627
2628 if ($item->{container} == $::CONN->{player}{tag}) {
2629 $targ = $main::OPENCONT;
2630 }
2631
2632 $::CONN->send ("move $targ $item->{tag} 0");
2633 } elsif ($ev->{button} == 2) {
2634 $::CONN->send ("apply $item->{tag}");
2635 } elsif ($ev->{button} == 3) {
2636 my @menu_items = (
2637 ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2638 ["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2639 ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2640 (
2641 $item->{flags} & Crossfire::Protocol::F_LOCKED
2642 ? (
2643 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2644 )
2645 : (
2646 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2647 ["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2648 )
2649 ),
2650 );
2651
2652 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2653 }
2654
2655 1
2656 },
2657 %args
2658 );
2659
2660
2661 $self->add (new CFClient::UI::Face
2662 can_events => 0,
2663 face => $item->{face},
2664 anim => $item->{anim},
2665 animspeed => $item->{animspeed},
2666 );
2667
2668 $self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2669
2670 $self->{item} = $item;
2671
2672 $self->update_item;
2673
2674 $self
2675}
2676
2677sub update_item {
2678 my ($self) = @_;
2679
2680 my $desc = _item_to_desc ($self->{item});
2681
2682 $self->{name_lbl}->set_text ($desc);
2683}
2684
2685#############################################################################
2686
2687package CFClient::UI::Inventory;
2688
2689our @ISA = CFClient::UI::ScrolledWindow::;
2690
2691sub new {
2692 my $class = shift;
2693
2694 my $self = $class->SUPER::new (
2695 scrolled => (new CFClient::UI::VBox),
2696 @_,
2697 );
2698
2699 $self
2700}
2701
2702sub set_items {
2703 my ($self, $items) = @_;
2704
2705 $self->{scrolled}->clear;
2706 return unless $items;
2707
2708 my @items = sort {
2709 ($a->{type} <=> $b->{type})
2710 or ($a->{name} cmp $b->{name})
2711 } @$items;
2712
2713 $self->{real_items} = \@items;
2714
2715 for my $item (@items) {
2716 $item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2717 $item->update_item ();
2718 }
2719
2720 $self->{scrolled}->add (@items);
2721
2722# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2723}
2724
2725sub size_request {
2726 my ($self) = @_;
2727 ($self->{req_w}, $self->{req_h});
2728} 2782}
2729 2783
2730############################################################################# 2784#############################################################################
2731 2785
2732package CFClient::UI::Menu; 2786package CFClient::UI::Menu;
… …
2767 2821
2768# popup given the event (must be a mouse button down event currently) 2822# popup given the event (must be a mouse button down event currently)
2769sub popup { 2823sub popup {
2770 my ($self, $ev) = @_; 2824 my ($self, $ev) = @_;
2771 2825
2772 $self->emit ("popdown"); 2826 $self->_emit ("popdown");
2773 2827
2774 # maybe save $GRAB? must be careful about events... 2828 # maybe save $GRAB? must be careful about events...
2775 $GRAB = $self; 2829 $GRAB = $self;
2776 $self->{button} = $ev->{button}; 2830 $self->{button} = $ev->{button};
2777 2831
2778 $self->show; 2832 $self->show;
2779 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2833 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2780} 2834}
2781 2835
2782sub mouse_motion { 2836sub mouse_motion {
2783 my ($self, $ev, $x, $y) = @_; 2837 my ($self, $ev, $x, $y) = @_;
2784 2838
… …
2792 2846
2793 if ($ev->{button} == $self->{button}) { 2847 if ($ev->{button} == $self->{button}) {
2794 undef $GRAB; 2848 undef $GRAB;
2795 $self->hide; 2849 $self->hide;
2796 2850
2797 $self->emit ("popdown"); 2851 $self->_emit ("popdown");
2798 $self->{hover}[1]->() if $self->{hover}; 2852 $self->{hover}[1]->() if $self->{hover};
2799 } 2853 }
2800} 2854}
2801 2855
2802############################################################################# 2856#############################################################################
… …
2864sub add { 2918sub add {
2865 my ($self, $text, %arg) = @_; 2919 my ($self, $text, %arg) = @_;
2866 2920
2867 $text =~ s/^\s+//; 2921 $text =~ s/^\s+//;
2868 $text =~ s/\s+$//; 2922 $text =~ s/\s+$//;
2923
2924 return unless $text;
2869 2925
2870 my $timeout = time + ((delete $arg{timeout}) || 60); 2926 my $timeout = time + ((delete $arg{timeout}) || 60);
2871 2927
2872 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 2928 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2873 2929
… …
2907 $self->SUPER::reconfigure; 2963 $self->SUPER::reconfigure;
2908} 2964}
2909 2965
2910############################################################################# 2966#############################################################################
2911 2967
2912package CFClient::UI::Root; 2968package CFClient::UI::Inventory;
2913 2969
2914our @ISA = CFClient::UI::Container::; 2970our @ISA = CFClient::UI::ScrolledWindow::;
2915
2916use CFClient::OpenGL;
2917 2971
2918sub new { 2972sub new {
2919 my $class = shift; 2973 my $class = shift;
2920 2974
2921 $class->SUPER::new ( 2975 my $self = $class->SUPER::new (
2976 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2922 @_, 2977 @_,
2923 ) 2978 );
2924}
2925 2979
2926sub configure { 2980 $self
2981}
2982
2983sub set_items {
2984 my ($self, $items) = @_;
2985
2986 $self->{scrolled}->clear;
2987 return unless $items;
2988
2989 my @items = sort {
2990 ($a->{type} <=> $b->{type})
2991 or ($a->{name} cmp $b->{name})
2992 } @$items;
2993
2994 $self->{real_items} = \@items;
2995
2996 my $row = 0;
2997 for my $item (@items) {
2998 CFClient::Item::update_widgets $item;
2999
3000 $self->{scrolled}->add (0, $row, $item->{face_widget});
3001 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3002 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3003
3004 $row++;
3005 }
3006}
3007
3008#############################################################################
3009
3010package CFClient::UI::BindEditor;
3011
3012our @ISA = CFClient::UI::FancyFrame::;
3013
3014sub new {
3015 my $class = shift;
3016
3017 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3018
3019 $self->add (my $vb = new CFClient::UI::VBox);
3020
3021
3022 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3023 text => "start recording",
3024 tooltip => "Start/Stops recording of actions."
3025 ."All subsequent actions after the recording started will be captured."
3026 ."The actions are displayed after the record was stopped."
3027 ."To bind the action you have to click on the 'Bind' button",
3028 on_activate => sub {
3029 unless ($self->{recording}) {
3030 $self->start;
3031 } else {
3032 $self->stop;
3033 }
3034 });
3035
3036 $vb->add (new CFClient::UI::Label text => "Actions:");
3037 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3038
3039 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3040 $vb->add (my $hb = new CFClient::UI::HBox);
3041 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3042 $hb->add (new CFClient::UI::Button
3043 text => "bind",
3044 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3045 on_activate => sub {
3046 $self->ask_for_bind;
3047 });
3048
3049 $vb->add (my $hb = new CFClient::UI::HBox);
3050 $hb->add (new CFClient::UI::Button
3051 text => "ok",
3052 expand => 1,
3053 tooltip => "This closes the binding editor and saves the binding",
3054 on_activate => sub {
3055 $self->hide;
3056 $self->commit;
3057 });
3058
3059 $hb->add (new CFClient::UI::Button
3060 text => "cancel",
3061 expand => 1,
3062 tooltip => "This closes the binding editor without saving",
3063 on_activate => sub {
3064 $self->hide;
3065 $self->{binding_cancel}->()
3066 if $self->{binding_cancel};
3067 });
3068
3069 $self->update_binding_widgets;
3070
3071 $self
3072}
3073
3074sub commit {
3075 my ($self) = @_;
3076 my ($mod, $sym, $cmds) = $self->get_binding;
3077 if ($sym != 0 && @$cmds > 0) {
3078 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3079 ."'. Don't forget 'Save Config'!");
3080 $self->{binding_change}->($mod, $sym, $cmds)
3081 if $self->{binding_change};
3082 } else {
3083 $::STATUSBOX->add ("No action bound, no key or action specified!");
3084 $self->{binding_cancel}->()
3085 if $self->{binding_cancel};
3086 }
3087}
3088
3089sub start {
3090 my ($self) = @_;
3091
3092 $self->{rec_btn}->set_text ("stop recording");
3093 $self->{recording} = 1;
3094 $self->clear_command_list;
3095 $::CONN->start_record if $::CONN;
3096}
3097
3098sub stop {
3099 my ($self) = @_;
3100
3101 $self->{rec_btn}->set_text ("start recording");
3102 $self->{recording} = 0;
3103
3104 my $rec;
3105 $rec = $::CONN->stop_record if $::CONN;
3106 return unless ref $rec eq 'ARRAY';
3107 $self->set_command_list ($rec);
3108}
3109
3110# if $commit is true, the binding will be set after the user entered a key combo
3111sub ask_for_bind {
3112 my ($self, $commit) = @_;
3113
3114 CFClient::Binder::open_binding_dialog (sub {
3115 my ($mod, $sym) = @_;
3116 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3117 $self->update_binding_widgets;
3118 $self->commit if $commit;
3119 });
3120}
3121
3122# $mod and $sym are the modifiers and key symbol
3123# $cmds is a array ref of strings (the commands)
3124# $cb is the callback that is executed on OK
3125# $ccb is the callback that is executed on CANCEL and
3126# when the binding was unsuccessful on OK
3127sub set_binding {
2927 my ($self, $x, $y, $w, $h) = @_; 3128 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
2928 3129
2929 $self->{w} = $w; 3130 $self->clear_command_list;
2930 $self->{h} = $h; 3131 $self->{recording} = 0;
2931} 3132 $self->{rec_btn}->set_text ("start recording");
2932 3133
2933sub check_size { 3134 $self->{binding} = [$mod, $sym];
3135 $self->{commands} = $cmds;
3136
3137 $self->{binding_change} = $cb;
3138 $self->{binding_cancel} = $ccb;
3139
3140 $self->update_binding_widgets;
3141}
3142
3143# this is a shortcut method that asks for a binding
3144# and then just binds it.
3145sub do_quick_binding {
2934 my ($self) = @_; 3146 my ($self, $cmds) = @_;
3147 $self->set_binding (undef, undef, $cmds, sub {
3148 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3149 });
3150 $self->ask_for_bind (1);
3151}
2935 3152
2936 $self->size_allocate ($self->{w}, $self->{h}) 3153sub update_binding_widgets {
2937 if $self->{w}; 3154 my ($self) = @_;
3155 my ($mod, $sym, $cmds) = $self->get_binding;
3156 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3157 $self->set_command_list ($cmds);
3158}
3159
3160sub get_binding {
3161 my ($self) = @_;
3162 return (
3163 $self->{binding}->[0],
3164 $self->{binding}->[1],
3165 [ grep { defined $_ } @{$self->{commands}} ]
3166 );
3167}
3168
3169sub clear_command_list {
3170 my ($self) = @_;
3171 $self->{cmdbox}->clear ();
3172}
3173
3174sub set_command_list {
3175 my ($self, $cmds) = @_;
3176
3177 $self->{cmdbox}->clear ();
3178 $self->{commands} = $cmds;
3179
3180 my $idx = 0;
3181
3182 for (@$cmds) {
3183 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3184
3185 my $i = $idx;
3186 $hb->add (new CFClient::UI::Label text => $_);
3187 $hb->add (new CFClient::UI::Button
3188 text => "delete",
3189 tooltip => "Deletes the action from the record",
3190 on_activate => sub {
3191 $self->{cmdbox}->remove ($hb);
3192 $cmds->[$i] = undef;
3193 });
3194
3195
3196 $idx++
3197 }
3198}
3199
3200#############################################################################
3201
3202package CFClient::UI::SpellList;
3203
3204our @ISA = CFClient::UI::FancyFrame::;
3205
3206sub new {
3207 my $class = shift;
3208
3209 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3210
3211 $self->add (new CFClient::UI::ScrolledWindow
3212 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3213
3214 $self;
3215}
3216
3217# XXX: Do sorting? Argl...
3218sub add_spell {
3219 my ($self, $spell) = @_;
3220 $self->{spells}->{$spell->{name}} = $spell;
3221
3222 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3223 face => $spell->{face},
3224 can_hover => 1,
3225 can_events => 1,
3226 tooltip => $spell->{message});
3227
3228 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3229 text => $spell->{name},
3230 can_hover => 1,
3231 can_events => 1,
3232 tooltip => $spell->{message},
3233 expand => 1);
3234
3235 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3236 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3237 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3238 expand => 1);
3239
3240 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3241 text => "bind to key",
3242 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3243}
3244
3245sub rebuild_spell_list {
3246 my ($self) = @_;
3247 $self->{tbl_idx} = 0;
3248 $self->add_spell ($_) for values %{$self->{spells}};
3249}
3250
3251sub remove_spell {
3252 my ($self, $spell) = @_;
3253 delete $self->{spells}->{$spell->{name}};
3254 $self->rebuild_spell_list;
3255}
3256
3257#############################################################################
3258
3259package CFClient::UI::Root;
3260
3261our @ISA = CFClient::UI::Container::;
3262
3263use CFClient::OpenGL;
3264
3265sub new {
3266 my $class = shift;
3267
3268 my $self = $class->SUPER::new (
3269 visible => 1,
3270 @_,
3271 );
3272
3273 Scalar::Util::weaken ($self->{root} = $self);
3274
3275 $self
2938} 3276}
2939 3277
2940sub size_request { 3278sub size_request {
2941 my ($self) = @_; 3279 my ($self) = @_;
2942 3280
2943 ($self->{w}, $self->{h}) 3281 ($self->{w}, $self->{h})
3282}
3283
3284sub _to_pixel {
3285 my ($coord, $size, $max) = @_;
3286
3287 $coord =
3288 $coord eq "center" ? ($max - $size) * 0.5
3289 : $coord eq "max" ? $max
3290 : $coord;
3291
3292 $coord = 0 if $coord < 0;
3293 $coord = $max - $size if $coord > $max - $size;
3294
3295 int $coord + 0.5
2944} 3296}
2945 3297
2946sub size_allocate { 3298sub size_allocate {
2947 my ($self, $w, $h) = @_; 3299 my ($self, $w, $h) = @_;
2948 3300
2949 my $old_w = $self->{old_w}; $self->{old_w} = $w;
2950 my $old_h = $self->{old_h}; $self->{old_h} = $h;
2951
2952 CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
2953 if $old_w && $old_h && ($old_w != $w || $old_h != $h);
2954
2955 for my $child ($self->children) { 3301 for my $child ($self->children) {
2956 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3302 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2957 3303
2958 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3304 $X = $child->{force_x} if exists $child->{force_x};
2959 if exists $child->{req_x}; 3305 $Y = $child->{force_y} if exists $child->{force_y};
2960 3306
2961 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3307 $X = _to_pixel $X, $W, $self->{w};
2962 if exists $child->{req_y}; 3308 $Y = _to_pixel $Y, $H, $self->{h};
2963
2964 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
2965 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
2966 3309
2967 $child->configure ($X, $Y, $W, $H); 3310 $child->configure ($X, $Y, $W, $H);
2968 } 3311 }
2969} 3312}
2970 3313
… …
2981} 3324}
2982 3325
2983sub update { 3326sub update {
2984 my ($self) = @_; 3327 my ($self) = @_;
2985 3328
2986 $self->check_size;
2987 $::WANT_REFRESH++; 3329 $::WANT_REFRESH++;
2988} 3330}
2989 3331
2990sub add { 3332sub add {
2991 my ($self, @children) = @_; 3333 my ($self, @children) = @_;
2992 3334
2993 for my $child (@children) {
2994 $child->{toplevel} = 1; 3335 $_->{is_toplevel} = 1
2995 3336 for @children;
2996 # integerise window positions
2997 $child->{x} = int $child->{x};
2998 $child->{y} = int $child->{y};
2999 }
3000 3337
3001 $self->SUPER::add (@children); 3338 $self->SUPER::add (@children);
3339}
3340
3341sub remove {
3342 my ($self, @children) = @_;
3343
3344 $self->SUPER::remove (@children);
3345
3346 delete $self->{is_toplevel}
3347 for @children;
3002 3348
3003 while (@children) { 3349 while (@children) {
3004 my $w = pop @children; 3350 my $w = pop @children;
3005 push @children, $w->children; 3351 push @children, $w->children;
3006 $w->{visible} = 1; 3352 $w->set_invisible;
3007 }
3008}
3009
3010sub remove {
3011 my ($self, @children) = @_;
3012
3013 $self->SUPER::remove (@children);
3014
3015 while (@children) {
3016 my $w = pop @children;
3017 push @children, $w->children;
3018 delete $w->{visible};
3019 } 3353 }
3020} 3354}
3021 3355
3022sub on_refresh { 3356sub on_refresh {
3023 my ($self, $id, $cb) = @_; 3357 my ($self, $id, $cb) = @_;
… …
3037 while ($self->{refresh_hook}) { 3371 while ($self->{refresh_hook}) {
3038 $_->() 3372 $_->()
3039 for values %{delete $self->{refresh_hook}}; 3373 for values %{delete $self->{refresh_hook}};
3040 } 3374 }
3041 3375
3042 if ($self->{check_size}) { 3376 if ($self->{realloc}) {
3043 my @queue = ([], []); 3377 my @queue;
3044 3378
3045 for (;;) { 3379 while () {
3046 if ($self->{check_size}) { 3380 if ($self->{realloc}) {
3047 # heuristic: check containers last 3381 #TODO use array-of-depth approach
3048 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3382
3049 for values %{delete $self->{check_size}} 3383 use sort 'stable';
3384
3385 @queue = sort { $a->{visible} <=> $b->{visible} }
3386 @queue, values %{delete $self->{realloc}};
3050 } 3387 }
3051 3388
3052 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3389 my $widget = pop @queue || last;
3053 3390
3054 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3391 $widget->{visible} or last; # do not resize invisible widgets
3055 ? @$widget{qw(user_w user_h)} 3392
3056 : $widget->size_request; 3393 my ($w, $h) = $widget->size_request;
3057 3394
3395 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3396 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3397
3398 $w = $widget->{force_w} if exists $widget->{force_w};
3399 $h = $widget->{force_h} if exists $widget->{force_h};
3400
3401 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3058 if (delete $widget->{force_alloc} 3402 || delete $widget->{force_realloc}) {
3059 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3060 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3061
3062 $widget->{req_w} = $w; 3403 $widget->{req_w} = $w;
3063 $widget->{req_h} = $h; 3404 $widget->{req_h} = $h;
3064 3405
3065 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3406 $self->{size_alloc}{$widget+0} = $widget;
3066 3407
3067 $widget->{parent}->check_size
3068 if $widget->{parent}; 3408 if (my $parent = $widget->{parent}) {
3409 $self->{realloc}{$parent+0} = $parent;
3410 #unshift @queue, $parent;
3411 $parent->{force_size_alloc} = 1;
3412 $self->{size_alloc}{$parent+0} = $parent;
3413 }
3069 } 3414 }
3415
3416 delete $self->{realloc}{$widget+0};
3070 } 3417 }
3071 } 3418 }
3072 3419
3073 while ($self->{size_alloc}) { 3420 while (my $size_alloc = delete $self->{size_alloc}) {
3074 for (values %{delete $self->{size_alloc}}) { 3421 my @queue = sort { $b->{visible} <=> $a->{visible} }
3075 my ($widget, $w, $h) = @$_; 3422 values %$size_alloc;
3423
3424 while () {
3425 my $widget = pop @queue || last;
3426
3427 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3076 3428
3077 $w = 0 if $w < 0; 3429 $w = 0 if $w < 0;
3078 $h = 0 if $h < 0; 3430 $h = 0 if $h < 0;
3079 3431
3432 $w = int $w + 0.5;
3433 $h = int $h + 0.5;
3434
3435 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3080 $widget->{w} = $w; 3436 $widget->{w} = $w;
3081 $widget->{h} = $h; 3437 $widget->{h} = $h;
3082 $widget->size_allocate ($w, $h); 3438
3083 $widget->emit (size_allocate => $w, $h); 3439 $widget->emit (size_allocate => $w, $h);
3440 }
3084 } 3441 }
3085 } 3442 }
3086 3443
3087 while ($self->{post_alloc_hook}) { 3444 while ($self->{post_alloc_hook}) {
3088 $_->() 3445 $_->()
3089 for values %{delete $self->{post_alloc_hook}}; 3446 for values %{delete $self->{post_alloc_hook}};
3090 } 3447 }
3448
3091 3449
3092 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3450 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3093 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3451 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3094 glClear GL_COLOR_BUFFER_BIT; 3452 glClear GL_COLOR_BUFFER_BIT;
3095 3453

Diff Legend

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