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.226 by root, Tue May 23 23:14:46 2006 UTC vs.
Revision 1.267 by root, Thu Jun 1 04:10:29 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) = @_;
… …
144 157
145 $_->update 158 $_->update
146 for @widgets; 159 for @widgets;
147} 160}
148 161
162sub reconfigure_widgets {
163 # make a copy, otherwise C<for> complains about freed values.
164 my @widgets = values %WIDGET;
165
166 $_->reconfigure
167 for @widgets;
168}
169
149# call when resolution changes etc. 170# call when resolution changes etc.
150sub rescale_widgets { 171sub rescale_widgets {
151 my ($sx, $sy) = @_; 172 my ($sx, $sy) = @_;
152 173
153 # make a copy, otherwise for complains about freed values.
154 my @widgets = values %WIDGET; 174 for my $widget (values %WIDGET) {
155
156 for my $widget (@widgets) {
157 if ($widget->{toplevel}) { 175 if ($widget->{is_toplevel}) {
176 $widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
177 $widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
178
158 $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.]+$/;
159 $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};
160 $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};
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}; 182 $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}; 183 $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}; 184 $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}; 185
186 $widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
187 $widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
188
166 } 189 }
167
168 $widget->reconfigure;
169 } 190 }
191
192 reconfigure_widgets;
170} 193}
171 194
172############################################################################# 195#############################################################################
173 196
174package CFClient::UI::Base; 197package CFClient::UI::Base;
… …
179 202
180sub new { 203sub new {
181 my $class = shift; 204 my $class = shift;
182 205
183 my $self = bless { 206 my $self = bless {
184 x => 0, 207 x => "center",
185 y => 0, 208 y => "center",
186 z => 0, 209 z => 0,
210 w => undef,
211 h => undef,
187 can_events => 1, 212 can_events => 1,
188 @_ 213 @_
189 }, $class; 214 }, $class;
190 215
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
191 for (keys %$self) { 218 for (keys %$self) {
192 if (/^connect_(.*)$/) { 219 if (/^on_(.*)$/) {
193 $self->connect ($1 => delete $self->{$_}); 220 $self->connect ($1 => delete $self->{$_});
194 } 221 }
195 } 222 }
196 223
197 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 }
198 235
199 $self 236 $self
200} 237}
201 238
202sub destroy { 239sub destroy {
… …
206 %$self = (); 243 %$self = ();
207} 244}
208 245
209sub show { 246sub show {
210 my ($self) = @_; 247 my ($self) = @_;
248
211 return if $self->{parent}; 249 return if $self->{parent};
212 250
213 $CFClient::UI::ROOT->add ($self); 251 $CFClient::UI::ROOT->add ($self);
214} 252}
215 253
216sub show_centered { 254sub set_visible {
217 my ($self) = @_; 255 my ($self) = @_;
256
218 return if $self->{parent}; 257 return if $self->{visible};
219 258
220 $self->show; 259 $self->{root} = $self->{parent}{root};
260 $self->{visible} = $self->{parent}{visible} + 1;
221 261
222 $CFClient::UI::ROOT->on_post_alloc ( 262 $self->emit (visibility_change => 1);
223 "centered $self" => sub {
224 $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);
225 },
226 );
227}
228 263
229sub hide { 264 $self->realloc if !exists $self->{req_w};
265
266 $_->set_visible for $self->children;
267}
268
269sub set_invisible {
230 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};
231 278
232 undef $GRAB if $GRAB == $self; 279 undef $GRAB if $GRAB == $self;
233 undef $HOVER if $HOVER == $self; 280 undef $HOVER if $HOVER == $self;
234 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
235 $self->{parent}->remove ($self) 312 $self->{parent}->remove ($self)
236 if $self->{parent}; 313 if $self->{parent};
237} 314}
238 315
239sub move { 316sub move_abs {
240 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
241 318
242 $self->{x} = int $x; 319 $self->{x} = List::Util::max 0, int $x;
243 $self->{y} = int $y; 320 $self->{y} = List::Util::max 0, int $y;
244 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
245 322
246 $self->update; 323 $self->update;
247} 324}
248 325
249sub set_size { 326sub set_size {
250 my ($self, $w, $h) = @_; 327 my ($self, $w, $h) = @_;
251 328
252 $self->{user_w} = $w; 329 $self->{force_w} = $w;
253 $self->{user_h} = $h; 330 $self->{force_h} = $h;
254 331
255 $self->check_size; 332 $self->realloc;
256} 333}
257 334
258sub size_request { 335sub size_request {
259 require Carp; 336 require Carp;
260 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
… …
262 339
263sub configure { 340sub configure {
264 my ($self, $x, $y, $w, $h) = @_; 341 my ($self, $x, $y, $w, $h) = @_;
265 342
266 if ($self->{aspect}) { 343 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h);
345
267 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 346 $w = List::Util::min $w, int $h * $self->{aspect};
268 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 347 $h = List::Util::min $h, int $w / $self->{aspect};
269 348
270 # use alignment to adjust x, y 349 # use alignment to adjust x, y
271 350
272 $x += int +($w - $w2) * 0.5; 351 $x += int 0.5 * ($ow - $w);
273 $y += int +($h - $h2) * 0.5; 352 $y += int 0.5 * ($oh - $h);
274
275 ($w, $h) = ($w2, $h2);
276 } 353 }
277 354
278 if ($self->{x} != $x || $self->{y} != $y) { 355 if ($self->{x} ne $x || $self->{y} ne $y) {
279 $self->{x} = $x; 356 $self->{x} = $x;
280 $self->{y} = $y; 357 $self->{y} = $y;
281 $self->update; 358 $self->update;
282 } 359 }
283 360
284 if ($self->{w} != $w || $self->{h} != $h) { 361 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
285 $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;
286 } 368 }
287} 369}
288 370
289sub size_allocate { 371sub size_allocate {
290 # nothing to be done 372 # nothing to be done
291} 373}
292 374
293sub reconfigure {
294 my ($self) = @_;
295
296 $self->check_size (1);
297 $self->update;
298}
299
300sub children { 375sub children {
301} 376}
302 377
303sub set_max_size { 378sub set_max_size {
304 my ($self, $w, $h) = @_; 379 my ($self, $w, $h) = @_;
… …
307 delete $self->{max_h}; $self->{max_h} = $h if $h; 382 delete $self->{max_h}; $self->{max_h} = $h if $h;
308} 383}
309 384
310sub set_tooltip { 385sub set_tooltip {
311 my ($self, $tooltip) = @_; 386 my ($self, $tooltip) = @_;
387
388 $tooltip =~ s/^\s+//;
389 $tooltip =~ s/\s+$//;
390
391 return if $self->{tooltip} eq $tooltip;
312 392
313 $self->{tooltip} = $tooltip; 393 $self->{tooltip} = $tooltip;
314 394
315 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 395 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
316 delete $CFClient::UI::TOOLTIP->{owner}; 396 delete $CFClient::UI::TOOLTIP->{owner};
… …
338 return if $FOCUS == $self; 418 return if $FOCUS == $self;
339 return unless $self->{can_focus}; 419 return unless $self->{can_focus};
340 420
341 my $focus = $FOCUS; $FOCUS = $self; 421 my $focus = $FOCUS; $FOCUS = $self;
342 422
343 $self->emit (focus_in => $focus); 423 $self->_emit (focus_in => $focus);
344 424
345 $focus->update if $focus; 425 $focus->update if $focus;
346 $FOCUS->update; 426 $FOCUS->update;
347} 427}
348 428
… …
351 431
352 return unless $FOCUS == $self; 432 return unless $FOCUS == $self;
353 433
354 my $focus = $FOCUS; undef $FOCUS; 434 my $focus = $FOCUS; undef $FOCUS;
355 435
356 $self->emit (focus_out => $focus); 436 $self->_emit (focus_out => $focus);
357 437
358 $focus->update if $focus; #? 438 $focus->update if $focus; #?
439
440 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
441 unless $FOCUS;
359} 442}
360 443
361sub mouse_motion { } 444sub mouse_motion { }
362sub button_up { } 445sub button_up { }
363sub key_down { } 446sub key_down { }
364sub key_up { } 447sub key_up { }
365 448
366sub button_down { 449sub button_down {
367 my ($self, $ev, $x, $y) = @_; 450 my ($self, $ev, $x, $y) = @_;
368 451
369 $self->focus_in; 452 $self->focus_in;
370} 453}
371 454
372sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 455sub find_widget {
373sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 456 my ($self, $x, $y) = @_;
374sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 457
375sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 458 return () unless $self->{can_events};
376sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 459
460 return $self
461 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
462 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
463
464 ()
465}
466
467sub set_parent {
468 my ($self, $parent) = @_;
469
470 Scalar::Util::weaken ($self->{parent} = $parent);
471 $self->set_visible if $parent->{visible};
472}
473
474sub connect {
475 my ($self, $signal, $cb) = @_;
476
477 push @{ $self->{signal_cb}{$signal} }, $cb;
478}
479
480sub _emit {
481 my ($self, $signal, @args) = @_;
482
483 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
484}
485
486sub emit {
487 my ($self, $signal, @args) = @_;
488
489 $self->_emit ($signal, @args)
490 || $self->$signal (@args);
491}
492
493sub visibility_change {
494 #my ($self, $visible) = @_;
495}
496
497sub realloc {
498 my ($self) = @_;
499
500 if ($self->{visible}) {
501 return if $self->{root}{realloc}{$self+0};
502
503 $self->{root}{realloc}{$self+0} = $self;
504 $self->{root}->update;
505 } else {
506 delete $self->{req_w};
507 delete $self->{req_h};
508 }
509}
510
511sub update {
512 my ($self) = @_;
513
514 $self->{parent}->update
515 if $self->{parent};
516}
517
518sub reconfigure {
519 my ($self) = @_;
520
521 $self->realloc;
522 $self->update;
523}
524
525# using global variables seems a bit hacky, but passing through all drawing
526# functions seems pointless.
527our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
377 528
378sub draw { 529sub draw {
379 my ($self) = @_; 530 my ($self) = @_;
380 531
381 return unless $self->{h} && $self->{w}; 532 return unless $self->{h} && $self->{w};
533
534 local $draw_x = $draw_x + $self->{x};
535 local $draw_y = $draw_y + $self->{y};
536
537 return if $draw_x + $self->{w} < 0;
538 return if $draw_x >= $draw_w;
539 return if $draw_y + $self->{h} < 0;
540 return if $draw_y >= $draw_h;
382 541
383 glPushMatrix; 542 glPushMatrix;
384 glTranslate $self->{x}, $self->{y}, 0; 543 glTranslate $self->{x}, $self->{y}, 0;
385 $self->_draw; 544 $self->_draw;
386 glPopMatrix; 545 glPopMatrix;
… …
398 glVertex $x , $y + $self->{h}; 557 glVertex $x , $y + $self->{h};
399 glEnd; 558 glEnd;
400 glDisable GL_BLEND; 559 glDisable GL_BLEND;
401 } 560 }
402 561
403 if ($ENV{PCLIENT_DEBUG}) { 562 if ($ENV{CFPLUS_DEBUG} & 1) {
404 glPushMatrix; 563 glPushMatrix;
405 glColor 1, 1, 0, 1; 564 glColor 1, 1, 0, 1;
406 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 565 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
407 glBegin GL_LINE_LOOP; 566 glBegin GL_LINE_LOOP;
408 glVertex 0 , 0; 567 glVertex 0 , 0;
409 glVertex $self->{w}, 0; 568 glVertex $self->{w} - 1, 0;
410 glVertex $self->{w}, $self->{h}; 569 glVertex $self->{w} - 1, $self->{h} - 1;
411 glVertex 0 , $self->{h}; 570 glVertex 0 , $self->{h} - 1;
412 glEnd; 571 glEnd;
413 glPopMatrix; 572 glPopMatrix;
414 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 573 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
415 } 574 }
416} 575}
417 576
418sub _draw { 577sub _draw {
419 my ($self) = @_; 578 my ($self) = @_;
420 579
421 warn "no draw defined for $self\n"; 580 warn "no draw defined for $self\n";
422}
423
424sub find_widget {
425 my ($self, $x, $y) = @_;
426
427 return () unless $self->{can_events};
428
429 return $self
430 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
431 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
432
433 ()
434}
435
436sub set_parent {
437 my ($self, $parent) = @_;
438
439 Scalar::Util::weaken ($self->{parent} = $parent);
440
441 # TODO: req_w _does_change after ->reconfigure
442 $self->check_size
443 unless exists $self->{req_w};
444
445 $self->show;
446}
447
448sub check_size {
449 my ($self, $forced) = @_;
450
451 $self->{force_alloc} = 1 if $forced;
452 $CFClient::UI::ROOT->{check_size}{$self} = $self;
453}
454
455sub update {
456 my ($self) = @_;
457
458 $self->{parent}->update
459 if $self->{parent};
460}
461
462sub connect {
463 my ($self, $signal, $cb) = @_;
464
465 push @{ $self->{signal_cb}{$signal} }, $cb;
466}
467
468sub emit {
469 my ($self, $signal, @args) = @_;
470
471 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
472} 581}
473 582
474sub DESTROY { 583sub DESTROY {
475 my ($self) = @_; 584 my ($self) = @_;
476 585
… …
534 my ($class, %arg) = @_; 643 my ($class, %arg) = @_;
535 $class->SUPER::new (can_events => 0, %arg); 644 $class->SUPER::new (can_events => 0, %arg);
536} 645}
537 646
538sub size_request { 647sub size_request {
539 (0, 0) 648 my ($self) = @_;
649
650 ($self->{w} + 0, $self->{h} + 0)
540} 651}
541 652
542sub draw { } 653sub draw { }
543 654
544############################################################################# 655#############################################################################
… …
573 $self->{children} = [ 684 $self->{children} = [
574 sort { $a->{z} <=> $b->{z} } 685 sort { $a->{z} <=> $b->{z} }
575 @{$self->{children}}, @widgets 686 @{$self->{children}}, @widgets
576 ]; 687 ];
577 688
578 $self->check_size (1); 689 $self->realloc;
579 $self->update;
580} 690}
581 691
582sub children { 692sub children {
583 @{ $_[0]{children} } 693 @{ $_[0]{children} }
584} 694}
… …
589 delete $child->{parent}; 699 delete $child->{parent};
590 $child->hide; 700 $child->hide;
591 701
592 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 702 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
593 703
594 $self->check_size; 704 $self->realloc;
595 $self->update;
596} 705}
597 706
598sub clear { 707sub clear {
599 my ($self) = @_; 708 my ($self) = @_;
600 709
… …
604 for (@$children) { 713 for (@$children) {
605 delete $_->{parent}; 714 delete $_->{parent};
606 $_->hide; 715 $_->hide;
607 } 716 }
608 717
609 $self->check_size; 718 $self->realloc;
610 $self->update;
611} 719}
612 720
613sub find_widget { 721sub find_widget {
614 my ($self, $x, $y) = @_; 722 my ($self, $x, $y) = @_;
615 723
… …
702 $self->SUPER::size_allocate ($w, $h); 810 $self->SUPER::size_allocate ($w, $h);
703 $self->update; 811 $self->update;
704} 812}
705 813
706sub _render { 814sub _render {
815 my ($self) = @_;
816
707 $_[0]{children}[0]->draw; 817 $self->{children}[0]->draw;
708} 818}
709 819
710sub render_child { 820sub render_child {
711 my ($self) = @_; 821 my ($self) = @_;
712 822
713 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 823 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
714 glClearColor 0, 0, 0, 0; 824 glClearColor 0, 0, 0, 0;
715 glClear GL_COLOR_BUFFER_BIT; 825 glClear GL_COLOR_BUFFER_BIT;
716 826
827 {
828 package CFClient::UI::Base;
829
830 ($draw_x, $draw_y, $draw_w, $draw_h) =
831 (0, 0, $self->{w}, $self->{h});
832 }
833
717 $self->_render; 834 $self->_render;
718 }; 835 };
719} 836}
720 837
721sub _draw { 838sub _draw {
722 my ($self) = @_; 839 my ($self) = @_;
723 840
724 my ($w, $h) = ($self->w, $self->h); 841 my ($w, $h) = @$self{qw(w h)};
725 842
726 my $tex = $self->{texture} 843 my $tex = $self->{texture}
727 or return; 844 or return;
728 845
729 glEnable GL_TEXTURE_2D; 846 glEnable GL_TEXTURE_2D;
… …
739 856
740package CFClient::UI::ViewPort; 857package CFClient::UI::ViewPort;
741 858
742our @ISA = CFClient::UI::Window::; 859our @ISA = CFClient::UI::Window::;
743 860
861sub new {
862 my $class = shift;
863
864 $class->SUPER::new (
865 scroll_x => 0,
866 scroll_y => 1,
867 @_,
868 )
869}
870
744sub size_request { 871sub size_request {
745 my ($self) = @_; 872 my ($self) = @_;
746 873
747 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 874 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
748 875
749 @$self{qw(child_w child_h)} 876 $w = 10 if $self->{scroll_x};
877 $h = 10 if $self->{scroll_y};
878
879 ($w, $h)
750} 880}
751 881
752sub size_allocate { 882sub size_allocate {
753 my ($self, $w, $h) = @_; 883 my ($self, $w, $h) = @_;
754 884
755 my ($cw, $ch) = @$self{qw(child_w child_h)}; 885 my $child = $self->child;
756# $w = $self->{w}; 886
887 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
888 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
889
757 $self->child->configure (0, 0, $cw, $ch); 890 $self->child->configure (0, 0, $w, $h);
758 $self->update; 891 $self->update;
759} 892}
760 893
761sub set_offset { 894sub set_offset {
762 my ($self, $x, $y) = @_; 895 my ($self, $x, $y) = @_;
… …
796} 929}
797 930
798sub _render { 931sub _render {
799 my ($self) = @_; 932 my ($self) = @_;
800 933
934 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
935 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
936
801 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 937 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
802 938
803 $self->SUPER::_render; 939 $self->SUPER::_render;
804} 940}
805 941
… …
813 my $class = shift; 949 my $class = shift;
814 950
815 my $self; 951 my $self;
816 952
817 my $slider = new CFClient::UI::Slider 953 my $slider = new CFClient::UI::Slider
818 vertical => 1, 954 vertical => 1,
819 range => [0, 0, 1, 0.01], # HACK fix 955 range => [0, 0, 1, 0.01], # HACK fix
820 connect_changed => sub { 956 on_changed => sub {
821 $self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h})); 957 $self->{vp}->set_offset (0, $_[1]);
822 }, 958 },
823 ; 959 ;
824 960
825 $self = $class->SUPER::new ( 961 $self = $class->SUPER::new (
826 vp => (new CFClient::UI::ViewPort expand => 1), 962 vp => (new CFClient::UI::ViewPort expand => 1),
… …
831 $self->{vp}->add ($self->{scrolled}); 967 $self->{vp}->add ($self->{scrolled});
832 $self->add ($self->{vp}); 968 $self->add ($self->{vp});
833 $self->add ($self->{slider}); 969 $self->add ($self->{slider});
834 970
835 $self 971 $self
972}
973
974sub update {
975 my ($self) = @_;
976
977 $self->SUPER::update;
978
979 # todo: overwrite size_allocate of child
980 my $child = $self->{vp}->child;
981 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
982}
983
984sub size_allocate {
985 my ($self, $w, $h) = @_;
986
987 $self->SUPER::size_allocate ($w, $h);
988
989 my $child = $self->{vp}->child;
990 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
836} 991}
837 992
838#TODO# update range on size_allocate depending on child 993#TODO# update range on size_allocate depending on child
839# update viewport offset on scroll 994# update viewport offset on scroll
840 995
… …
884 1039
885our @ISA = CFClient::UI::Bin::; 1040our @ISA = CFClient::UI::Bin::;
886 1041
887use CFClient::OpenGL; 1042use CFClient::OpenGL;
888 1043
889my @tex = 1044my $bg =
1045 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1046 mipmap => 1, wrap => 1;
1047
1048my @border =
890 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1049 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
891 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1050 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
892 1051
893sub new { 1052sub new {
894 my $class = shift; 1053 my $class = shift;
895 1054
896 # TODO: user_x, user_y, overwrite moveto?
897
898 my $self = $class->SUPER::new ( 1055 my $self = $class->SUPER::new (
899 bg => [1, 1, 1, 1], 1056 bg => [1, 1, 1, 1],
900 border_bg => [1, 1, 1, 1], 1057 border_bg => [1, 1, 1, 1],
901 border => 0.6, 1058 border => 0.6,
902 toplevel => 1,
903 can_events => 1, 1059 can_events => 1,
1060 min_w => 16,
1061 min_h => 16,
904 @_ 1062 @_
905 ); 1063 );
906 1064
907 $self->{title} &&= new CFClient::UI::Label 1065 $self->{title} &&= new CFClient::UI::Label
908 align => 0, 1066 align => 0,
… …
961 my ($ev, $x, $y) = @_; 1119 my ($ev, $x, $y) = @_;
962 1120
963 my $dx = $ev->{x} - $ox; 1121 my $dx = $ev->{x} - $ox;
964 my $dy = $ev->{y} - $oy; 1122 my $dy = $ev->{y} - $oy;
965 1123
966 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1124 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
967 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1125 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1126
1127 $self->realloc;
968 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1128 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
969 $self->check_size;
970 }; 1129 };
971 1130
972 } elsif ($lr ^ $td) { 1131 } elsif ($lr ^ $td) {
973 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1132 my ($ox, $oy) = ($ev->{x}, $ev->{y});
974 my ($bx, $by) = ($self->{x}, $self->{y}); 1133 my ($bx, $by) = ($self->{x}, $self->{y});
… …
976 $self->{motion} = sub { 1135 $self->{motion} = sub {
977 my ($ev, $x, $y) = @_; 1136 my ($ev, $x, $y) = @_;
978 1137
979 ($x, $y) = ($ev->{x}, $ev->{y}); 1138 ($x, $y) = ($ev->{x}, $ev->{y});
980 1139
981 $self->move ($bx + $x - $ox, $by + $y - $oy); 1140 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
982 $self->update;
983 }; 1141 };
984 } 1142 }
985} 1143}
986 1144
987sub button_up { 1145sub button_up {
… …
1006 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1164 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1007 1165
1008 my $border = $self->border; 1166 my $border = $self->border;
1009 1167
1010 glColor @{ $self->{border_bg} }; 1168 glColor @{ $self->{border_bg} };
1011 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1169 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1012 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1170 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1013 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1171 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1014 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1172 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1015 1173
1016 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1174 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1017 my $bg = $tex[0]; 1175 glColor @{ $self->{bg} };
1018 1176
1019 # TODO: repeat texture not scale 1177 # TODO: repeat texture not scale
1178 # solve this better(?)
1020 my $rep_x = $cw / $bg->{w}; 1179 $bg->{s} = $cw / $bg->{w};
1021 my $rep_y = $ch / $bg->{h}; 1180 $bg->{t} = $ch / $bg->{h};
1022
1023 glColor @{ $self->{bg} };
1024
1025 $bg->{s} = $rep_x;
1026 $bg->{t} = $rep_y;
1027 $bg->{wrap_mode} = 1;
1028 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1181 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1029 } 1182 }
1030 1183
1031 glDisable GL_TEXTURE_2D; 1184 glDisable GL_TEXTURE_2D;
1032 1185
… …
1048sub new { 1201sub new {
1049 my $class = shift; 1202 my $class = shift;
1050 1203
1051 $class->SUPER::new ( 1204 $class->SUPER::new (
1052 col_expand => [], 1205 col_expand => [],
1053 @_ 1206 @_,
1054 ) 1207 )
1208}
1209
1210sub children {
1211 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1055} 1212}
1056 1213
1057sub add { 1214sub add {
1058 my ($self, $x, $y, $child) = @_; 1215 my ($self, $x, $y, $child) = @_;
1059 1216
1060 $child->set_parent ($self); 1217 $child->set_parent ($self);
1061 $self->{children}[$y][$x] = $child; 1218 $self->{children}[$y][$x] = $child;
1062 1219
1063 $child->check_size; 1220 $self->realloc;
1064} 1221}
1065 1222
1066sub children {
1067 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1068}
1069
1070# TODO: move to container class maybe? send childs a signal on removal? 1223# TODO: move to container class maybe? send children a signal on removal?
1071sub clear { 1224sub clear {
1072 my ($self) = @_; 1225 my ($self) = @_;
1073 1226
1074 my @children = $self->children; 1227 my @children = $self->children;
1075 delete $self->{children}; 1228 delete $self->{children};
… …
1077 for (@children) { 1230 for (@children) {
1078 delete $_->{parent}; 1231 delete $_->{parent};
1079 $_->hide; 1232 $_->hide;
1080 } 1233 }
1081 1234
1082 $self->update; 1235 $self->realloc;
1083} 1236}
1084 1237
1085sub get_wh { 1238sub get_wh {
1086 my ($self) = @_; 1239 my ($self) = @_;
1087 1240
… …
1118sub size_allocate { 1271sub size_allocate {
1119 my ($self, $w, $h) = @_; 1272 my ($self, $w, $h) = @_;
1120 1273
1121 my ($ws, $hs) = $self->get_wh; 1274 my ($ws, $hs) = $self->get_wh;
1122 1275
1123 my $req_w = sum @$ws; 1276 my $req_w = (sum @$ws) || 1;
1124 my $req_h = sum @$hs; 1277 my $req_h = (sum @$hs) || 1;
1125 1278
1126 # TODO: nicer code && do row_expand 1279 # TODO: nicer code && do row_expand
1127 my @col_expand = @{$self->{col_expand}}; 1280 my @col_expand = @{$self->{col_expand}};
1128 @col_expand = (1) x @$ws unless @col_expand; 1281 @col_expand = (1) x @$ws unless @col_expand;
1129 my $col_expand = (sum @col_expand) || 1; 1282 my $col_expand = (sum @col_expand) || 1;
… …
1183 } 1336 }
1184} 1337}
1185 1338
1186############################################################################# 1339#############################################################################
1187 1340
1188package CFClient::UI::HBox; 1341package CFClient::UI::Box;
1189
1190# TODO: wrap into common Box base class
1191 1342
1192our @ISA = CFClient::UI::Container::; 1343our @ISA = CFClient::UI::Container::;
1193 1344
1194sub size_request { 1345sub size_request {
1195 my ($self) = @_; 1346 my ($self) = @_;
1196 1347
1197 my @alloc = map [$_->size_request], @{$self->{children}}; 1348 $self->{vertical}
1198 1349 ? (
1199 ( 1350 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1200 (List::Util::sum map $_->[0], @alloc), 1351 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1201 (List::Util::max map $_->[1], @alloc), 1352 )
1202 ) 1353 : (
1354 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1355 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1356 )
1203} 1357}
1204 1358
1205sub size_allocate { 1359sub size_allocate {
1206 my ($self, $w, $h) = @_; 1360 my ($self, $w, $h) = @_;
1207 1361
1208 ($h, $w) = ($w, $h); 1362 my $space = $self->{vertical} ? $h : $w;
1209
1210 my $children = $self->{children}; 1363 my $children = $self->{children};
1211 1364
1212 my @h = map $_->{req_w}, @$children; 1365 my @req;
1213 1366
1214 my $req_h = List::Util::sum @h; 1367 if ($self->{homogeneous}) {
1215 1368 @req = ($space / (@$children || 1)) x @$children;
1216 if ($req_h > $h) {
1217 # ah well, not enough space
1218 $_ *= $h / $req_h for @h;
1219 } else { 1369 } else {
1370 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1371 my $req = List::Util::sum @req;
1372
1373 if ($req > $space) {
1374 # ah well, not enough space
1375 $_ *= $space / $req for @req;
1376 } else {
1220 my $exp = List::Util::sum map $_->{expand}, @$children; 1377 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1221 $exp ||= 1;
1222 1378
1379 $space = ($space - $req) / $expand; # remaining space to give away
1380
1381 $req[$_] += $space * $children->[$_]{expand}
1223 for (0 .. $#$children) { 1382 for 0 .. $#$children;
1224 my $child = $children->[$_];
1225
1226 my $alloc_h = $h[$_];
1227 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1228 $h[$_] = $alloc_h;
1229 } 1383 }
1230 } 1384 }
1231 1385
1232 CFClient::UI::harmonize \@h; 1386 CFClient::UI::harmonize \@req;
1233 1387
1234 my $y = 0; 1388 my $pos = 0;
1235 for (0 .. $#$children) { 1389 for (0 .. $#$children) {
1236 my $child = $children->[$_];
1237 my $h = $h[$_]; 1390 my $alloc = $req[$_];
1238 $child->configure ($y, 0, $h, $w); 1391 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1239 1392
1240 $y += $h; 1393 $pos += $alloc;
1241 } 1394 }
1242 1395
1243 1 1396 1
1244} 1397}
1245 1398
1246############################################################################# 1399#############################################################################
1247 1400
1401package CFClient::UI::HBox;
1402
1403our @ISA = CFClient::UI::Box::;
1404
1405sub new {
1406 my $class = shift;
1407
1408 $class->SUPER::new (
1409 vertical => 0,
1410 @_,
1411 )
1412}
1413
1414#############################################################################
1415
1248package CFClient::UI::VBox; 1416package CFClient::UI::VBox;
1249 1417
1250# TODO: wrap into common Box base class
1251
1252our @ISA = CFClient::UI::Container::; 1418our @ISA = CFClient::UI::Box::;
1253 1419
1254sub size_request { 1420sub new {
1255 my ($self) = @_; 1421 my $class = shift;
1256 1422
1257 my @alloc = map [$_->size_request], @{$self->{children}}; 1423 $class->SUPER::new (
1258 1424 vertical => 1,
1259 ( 1425 @_,
1260 (List::Util::max map $_->[0], @alloc),
1261 (List::Util::sum map $_->[1], @alloc),
1262 ) 1426 )
1263}
1264
1265sub size_allocate {
1266 my ($self, $w, $h) = @_;
1267
1268 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1269
1270 my $children = $self->{children};
1271
1272 my @h = map $_->{req_h}, @$children;
1273
1274 my $req_h = List::Util::sum @h;
1275
1276 if ($req_h > $h) {
1277 # ah well, not enough space
1278 $_ *= $h / $req_h for @h;
1279 } else {
1280 my $exp = List::Util::sum map $_->{expand}, @$children;
1281 $exp ||= 1;
1282
1283 for (0 .. $#$children) {
1284 my $child = $children->[$_];
1285
1286 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1287 }
1288 }
1289
1290 CFClient::UI::harmonize \@h;
1291
1292 my $y = 0;
1293 for (0 .. $#$children) {
1294 my $child = $children->[$_];
1295 my $h = $h[$_];
1296 $child->configure (0, $y, $w, $h);
1297
1298 $y += $h;
1299 }
1300
1301 1
1302} 1427}
1303 1428
1304############################################################################# 1429#############################################################################
1305 1430
1306package CFClient::UI::Label; 1431package CFClient::UI::Label;
… …
1323 ellipsise => 3, # end 1448 ellipsise => 3, # end
1324 layout => (new CFClient::Layout), 1449 layout => (new CFClient::Layout),
1325 fontsize => 1, 1450 fontsize => 1,
1326 align => -1, 1451 align => -1,
1327 valign => -1, 1452 valign => -1,
1328 padding => 2, 1453 padding_x => 2,
1454 padding_y => 2,
1329 can_events => 0, 1455 can_events => 0,
1330 %arg 1456 %arg
1331 ); 1457 );
1332 1458
1333 if (exists $self->{template}) { 1459 if (exists $self->{template}) {
… …
1369 $self->{text} = "T$text"; 1495 $self->{text} = "T$text";
1370 1496
1371 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1497 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1372 $self->{layout}->set_text ($text); 1498 $self->{layout}->set_text ($text);
1373 1499
1500 $self->realloc;
1374 $self->update; 1501 $self->update;
1375 $self->check_size;
1376} 1502}
1377 1503
1378sub set_markup { 1504sub set_markup {
1379 my ($self, $markup) = @_; 1505 my ($self, $markup) = @_;
1380 1506
… …
1384 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1510 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1385 1511
1386 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1512 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1387 $self->{layout}->set_markup ($markup); 1513 $self->{layout}->set_markup ($markup);
1388 1514
1515 $self->realloc;
1389 $self->update; 1516 $self->update;
1390 $self->check_size;
1391} 1517}
1392 1518
1393sub size_request { 1519sub size_request {
1394 my ($self) = @_; 1520 my ($self) = @_;
1395 1521
… …
1409 1535
1410 $w = List::Util::max $w, $w2; 1536 $w = List::Util::max $w, $w2;
1411 $h = List::Util::max $h, $h2; 1537 $h = List::Util::max $h, $h2;
1412 } 1538 }
1413 1539
1414 ( 1540 ($w, $h)
1415 $w + $self->{padding} * 2,
1416 $h + $self->{padding} * 2,
1417 )
1418} 1541}
1419 1542
1420sub size_allocate { 1543sub size_allocate {
1421 my ($self, $w, $h) = @_; 1544 my ($self, $w, $h) = @_;
1422 1545
1423 delete $self->{texture}; 1546 delete $self->{texture}
1547 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1424} 1548}
1425 1549
1426sub set_fontsize { 1550sub set_fontsize {
1427 my ($self, $fontsize) = @_; 1551 my ($self, $fontsize) = @_;
1428 1552
1429 $self->{fontsize} = $fontsize; 1553 $self->{fontsize} = $fontsize;
1430 delete $self->{texture}; 1554 delete $self->{texture};
1431 1555
1432 $self->update; 1556 $self->realloc;
1433 $self->check_size;
1434} 1557}
1435 1558
1436sub _draw { 1559sub _draw {
1437 my ($self) = @_; 1560 my ($self) = @_;
1438 1561
… …
1446 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1569 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1447 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1570 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1448 1571
1449 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1572 my $tex = new_from_layout CFClient::Texture $self->{layout};
1450 1573
1451 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1574 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1452 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1575 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1453 : ($self->{w} - $tex->{w}) * 0.5); 1576 : ($self->{w} - $tex->{w}) * 0.5);
1454 1577
1455 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1578 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1456 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1579 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1457 : ($self->{h} - $tex->{h}) * 0.5); 1580 : ($self->{h} - $tex->{h}) * 0.5);
1458 1581
1459 $tex 1582 $tex
1460 }; 1583 };
1461 1584
… …
1510 $self->{text} = $text; 1633 $self->{text} = $text;
1511 1634
1512 $text =~ s/./*/g if $self->{hidden}; 1635 $text =~ s/./*/g if $self->{hidden};
1513 $self->{layout}->set_text ("$text "); 1636 $self->{layout}->set_text ("$text ");
1514 1637
1515 $self->emit (changed => $self->{text}); 1638 $self->_emit (changed => $self->{text});
1516} 1639}
1517 1640
1518sub set_text { 1641sub set_text {
1519 my ($self, $text) = @_; 1642 my ($self, $text) = @_;
1520 1643
1521 $self->{cursor} = length $text; 1644 $self->{cursor} = length $text;
1522 $self->_set_text ($text); 1645 $self->_set_text ($text);
1523 $self->update; 1646
1524 $self->check_size; 1647 $self->realloc;
1525} 1648}
1526 1649
1527sub get_text { 1650sub get_text {
1528 $_[0]{text} 1651 $_[0]{text}
1529} 1652}
… …
1532 my ($self) = @_; 1655 my ($self) = @_;
1533 1656
1534 my ($w, $h) = $self->SUPER::size_request; 1657 my ($w, $h) = $self->SUPER::size_request;
1535 1658
1536 ($w + 1, $h) # add 1 for cursor 1659 ($w + 1, $h) # add 1 for cursor
1537}
1538
1539sub size_allocate {
1540 my ($self, $w, $h) = @_;
1541
1542 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1543} 1660}
1544 1661
1545sub key_down { 1662sub key_down {
1546 my ($self, $ev) = @_; 1663 my ($self, $ev) = @_;
1547 1664
… …
1562 } elsif ($sym == CFClient::SDLK_HOME) { 1679 } elsif ($sym == CFClient::SDLK_HOME) {
1563 $self->{cursor} = 0; 1680 $self->{cursor} = 0;
1564 } elsif ($sym == CFClient::SDLK_END) { 1681 } elsif ($sym == CFClient::SDLK_END) {
1565 $self->{cursor} = length $text; 1682 $self->{cursor} = length $text;
1566 } elsif ($uni == 27) { 1683 } elsif ($uni == 27) {
1567 $self->emit ('escape'); 1684 $self->_emit ('escape');
1568 } elsif ($uni) { 1685 } elsif ($uni) {
1569 substr $text, $self->{cursor}++, 0, chr $uni; 1686 substr $text, $self->{cursor}++, 0, chr $uni;
1570 } 1687 }
1571 1688
1572 $self->_set_text ($text); 1689 $self->_set_text ($text);
1573 $self->update; 1690
1574 $self->check_size; 1691 $self->realloc;
1575} 1692}
1576 1693
1577sub focus_in { 1694sub focus_in {
1578 my ($self) = @_; 1695 my ($self) = @_;
1579 1696
… …
1659 if ($sym == 13) { 1776 if ($sym == 13) {
1660 unshift @{$self->{history}}, 1777 unshift @{$self->{history}},
1661 my $txt = $self->get_text; 1778 my $txt = $self->get_text;
1662 $self->{history_pointer} = -1; 1779 $self->{history_pointer} = -1;
1663 $self->{history_saveback} = ''; 1780 $self->{history_saveback} = '';
1664 $self->emit (activate => $txt); 1781 $self->_emit (activate => $txt);
1665 $self->update; 1782 $self->update;
1666 1783
1667 } elsif ($sym == CFClient::SDLK_UP) { 1784 } elsif ($sym == CFClient::SDLK_UP) {
1668 if ($self->{history_pointer} < 0) { 1785 if ($self->{history_pointer} < 0) {
1669 $self->{history_saveback} = $self->get_text; 1786 $self->{history_saveback} = $self->get_text;
… …
1706 1823
1707sub new { 1824sub new {
1708 my $class = shift; 1825 my $class = shift;
1709 1826
1710 $class->SUPER::new ( 1827 $class->SUPER::new (
1711 padding => 4, 1828 padding_x => 4,
1829 padding_y => 4,
1712 fg => [1, 1, 1], 1830 fg => [1, 1, 1],
1713 active_fg => [0, 0, 1], 1831 active_fg => [0, 0, 1],
1714 can_hover => 1, 1832 can_hover => 1,
1715 align => 0, 1833 align => 0,
1716 valign => 0, 1834 valign => 0,
1717 can_events => 1, 1835 can_events => 1,
1718 @_ 1836 @_
1719 ) 1837 )
1720} 1838}
1721 1839
1840sub activate { }
1841
1722sub button_up { 1842sub button_up {
1723 my ($self, $ev, $x, $y) = @_; 1843 my ($self, $ev, $x, $y) = @_;
1724 1844
1845 $self->emit ("activate")
1725 if ($x >= 0 && $x < $self->{w} 1846 if $x >= 0 && $x < $self->{w}
1726 && $y >= 0 && $y < $self->{h}) { 1847 && $y >= 0 && $y < $self->{h};
1727 $self->emit ("activate");
1728 }
1729} 1848}
1730 1849
1731sub _draw { 1850sub _draw {
1732 my ($self) = @_; 1851 my ($self) = @_;
1733 1852
… …
1762 1881
1763sub new { 1882sub new {
1764 my $class = shift; 1883 my $class = shift;
1765 1884
1766 $class->SUPER::new ( 1885 $class->SUPER::new (
1767 padding => 2, 1886 padding_x => 2,
1887 padding_y => 2,
1768 fg => [1, 1, 1], 1888 fg => [1, 1, 1],
1769 active_fg => [1, 1, 0], 1889 active_fg => [1, 1, 0],
1770 bg => [0, 0, 0, 0.2], 1890 bg => [0, 0, 0, 0.2],
1771 active_bg => [1, 1, 1, 0.5], 1891 active_bg => [1, 1, 1, 0.5],
1772 state => 0, 1892 state => 0,
… …
1776} 1896}
1777 1897
1778sub size_request { 1898sub size_request {
1779 my ($self) = @_; 1899 my ($self) = @_;
1780 1900
1781 ($self->{padding} * 2 + 6) x 2 1901 (6) x 2
1782} 1902}
1783 1903
1784sub button_down { 1904sub button_down {
1785 my ($self, $ev, $x, $y) = @_; 1905 my ($self, $ev, $x, $y) = @_;
1786 1906
1787 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1907 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1788 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1908 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1789 $self->{state} = !$self->{state}; 1909 $self->{state} = !$self->{state};
1790 $self->emit (changed => $self->{state}); 1910 $self->_emit (changed => $self->{state});
1791 } 1911 }
1792} 1912}
1793 1913
1794sub _draw { 1914sub _draw {
1795 my ($self) = @_; 1915 my ($self) = @_;
1796 1916
1797 $self->SUPER::_draw; 1917 $self->SUPER::_draw;
1798 1918
1799 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1919 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1800 1920
1801 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1921 my ($w, $h) = @$self{qw(w h)};
1922
1923 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1802 1924
1803 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1925 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1804 1926
1805 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1927 my $tex = $self->{state} ? $tex[1] : $tex[0];
1806 1928
… …
2070 my $self = $class->SUPER::new ( 2192 my $self = $class->SUPER::new (
2071 fg => [1, 1, 1], 2193 fg => [1, 1, 1],
2072 active_fg => [0, 0, 0], 2194 active_fg => [0, 0, 0],
2073 bg => [0, 0, 0, 0.2], 2195 bg => [0, 0, 0, 0.2],
2074 active_bg => [1, 1, 1, 0.5], 2196 active_bg => [1, 1, 1, 0.5],
2075 range => [0, 0, 100, 10], 2197 range => [0, 0, 100, 10, 0],
2076 req_w => $::WIDTH / 80, 2198 min_w => $::WIDTH / 80,
2077 req_h => $::WIDTH / 80, 2199 min_h => $::WIDTH / 80,
2078 vertical => 0, 2200 vertical => 0,
2079 can_hover => 1, 2201 can_hover => 1,
2080 inner_pad => 0.02, 2202 inner_pad => 0.02,
2081 @_ 2203 @_
2082 ); 2204 );
… …
2085 $self->update; 2207 $self->update;
2086 2208
2087 $self 2209 $self
2088} 2210}
2089 2211
2212sub changed { }
2213
2090sub set_range { 2214sub set_range {
2091 my ($self, $range) = @_; 2215 my ($self, $range) = @_;
2092 2216
2093 $self->{range} = $range; 2217 ($range, $self->{range}) = ($self->{range}, $range);
2094 2218
2095 $self->update; 2219 $self->update
2220 if "@$range" ne "@{$self->{range}}";
2096} 2221}
2097 2222
2098sub set_value { 2223sub set_value {
2099 my ($self, $value) = @_; 2224 my ($self, $value) = @_;
2100 2225
2101 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; 2226 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2102 2227
2103 $hi = $lo + 1 if $hi <= $lo; 2228 $hi = $lo + 1 if $hi <= $lo;
2104 2229
2230 $page = $hi - $lo if $page > $hi - $lo;
2231
2105 $value = $lo if $value < $lo; 2232 $value = $lo if $value < $lo;
2106 $value = $hi if $value > $hi; 2233 $value = $hi - $page if $value > $hi - $page;
2107 2234
2108 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit 2235 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2109 if $unit; 2236 if $unit;
2110 2237
2111 $page = $hi - $lo if $page > $hi - $lo;
2112
2113 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2238 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2114 2239
2115 if ($value != $old_value) { 2240 if ($value != $old_value) {
2116 $self->emit (changed => $value); 2241 $self->_emit (changed => $value);
2117 $self->update; 2242 $self->update;
2118 } 2243 }
2119} 2244}
2120 2245
2121sub size_request { 2246sub size_request {
2122 my ($self) = @_; 2247 my ($self) = @_;
2123 2248
2124 my $w = $self->{req_w}; 2249 ($self->{req_w}, $self->{req_h})
2125 my $h = $self->{req_h};
2126
2127 $self->{vertical} ? ($h, $w) : ($w, $h)
2128} 2250}
2129 2251
2130sub button_down { 2252sub button_down {
2131 my ($self, $ev, $x, $y) = @_; 2253 my ($self, $ev, $x, $y) = @_;
2132 2254
2133 $self->SUPER::button_down ($ev, $x, $y); 2255 $self->SUPER::button_down ($ev, $x, $y);
2256
2257 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2258
2134 $self->mouse_motion ($ev, $x, $y); 2259 $self->mouse_motion ($ev, $x, $y);
2135} 2260}
2136 2261
2137sub mouse_motion { 2262sub mouse_motion {
2138 my ($self, $ev, $x, $y) = @_; 2263 my ($self, $ev, $x, $y) = @_;
… …
2140 if ($GRAB == $self) { 2265 if ($GRAB == $self) {
2141 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2266 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2142 2267
2143 my (undef, $lo, $hi, $page) = @{$self->{range}}; 2268 my (undef, $lo, $hi, $page) = @{$self->{range}};
2144 2269
2145 $x = $x / ($w * (1 - 2 * $self->{inner_pad})) - $self->{inner_pad}; 2270 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2146 2271
2147 $self->set_value ($x * ($hi - $lo) + $lo); 2272 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2148 } 2273 }
2149} 2274}
2150 2275
2151sub update { 2276sub update {
2152 my ($self) = @_; 2277 my ($self) = @_;
2153 2278
2154 $CFClient::UI::ROOT->on_post_alloc ($self => sub { 2279 $CFClient::UI::ROOT->on_post_alloc ($self => sub {
2155 $self->set_value ($self->{range}[0]); 2280 $self->set_value ($self->{range}[0]);
2156 2281
2157 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2282 my ($value, $lo, $hi, $page) = @{$self->{range}};
2283 my $range = ($hi - $page - $lo) || 1e-100;
2158 2284
2159 my $inner_w = 1 - 2 * $self->{inner_pad}; 2285 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2160 2286
2161 $self->{scale} = ($inner_w / ($hi - $lo)) || 1; 2287 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2288 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2162 2289
2163 $page = $self->{scale} * $page || 10 / ($self->{w} || 1); 2290 $value = ($value - $lo) / $range;
2164 $value = $self->{scale} * ($value - $lo); 2291 $value = $value * $self->{scale} + $self->{offset};
2165 2292
2166 $value = $self->{inner_pad} + ($value - $page * 0.5);
2167
2168 $value = 0 if $value < 0;
2169 $page = 1 - $value if $value + $page > 1;
2170
2171 $self->{knob_x} = $value; 2293 $self->{knob_x} = $value - $knob_w * 0.5;
2172 $self->{knob_w} = $page; 2294 $self->{knob_w} = $knob_w;
2173 }); 2295 });
2174 2296
2175 $self->SUPER::update; 2297 $self->SUPER::update;
2176} 2298}
2177 2299
… …
2293 $self->{layout}->set_width ($self->{children}[0]{w}); 2415 $self->{layout}->set_width ($self->{children}[0]{w});
2294 2416
2295 $self->reflow; 2417 $self->reflow;
2296} 2418}
2297 2419
2298sub text_height { 2420sub text_size {
2299 my ($self, $text, $indent) = @_; 2421 my ($self, $text, $indent) = @_;
2300 2422
2301 my $layout = $self->{layout}; 2423 my $layout = $self->{layout};
2302 2424
2303 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2425 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2304 $layout->set_width ($self->{children}[0]{w} - $indent); 2426 $layout->set_width ($self->{children}[0]{w} - $indent);
2305 $layout->set_markup ($text); 2427 $layout->set_markup ($text);
2306 2428
2307 ($layout->size)[1] 2429 $layout->size
2308} 2430}
2309 2431
2310sub reflow { 2432sub reflow {
2311 my ($self) = @_; 2433 my ($self) = @_;
2312 2434
2313 $self->{need_reflow}++; 2435 $self->{need_reflow}++;
2314 $self->update; 2436 $self->update;
2315} 2437}
2316 2438
2439sub set_offset {
2440 my ($self, $offset) = @_;
2441
2442 # todo: base offset on lines or so, not on pixels
2443 $self->{children}[1]->set_value ($offset);
2444}
2445
2317sub clear { 2446sub clear {
2318 my ($self) = @_; 2447 my ($self) = @_;
2319 2448
2320 $self->{par} = []; 2449 $self->{par} = [];
2321 $self->{height} = 0; 2450 $self->{height} = 0;
2322 2451 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2323 $self->reflow;
2324} 2452}
2325 2453
2326sub add_paragraph { 2454sub add_paragraph {
2327 my ($self, $color, $text, $indent) = @_; 2455 my ($self, $color, $text, $indent) = @_;
2328 2456
2329 for my $line (split /\n/, $text) { 2457 for my $line (split /\n/, $text) {
2330 my $height = $self->text_height ($line); 2458 my ($w, $h) = $self->text_size ($line);
2331 $self->{height} += $height; 2459 $self->{height} += $h;
2332 push @{$self->{par}}, [$height, $color, $indent, $line]; 2460 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2333 } 2461 }
2334 2462
2335 $self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}]; 2463 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2336 $self->{children}[1]->update;
2337} 2464}
2338 2465
2339sub update { 2466sub update {
2340 my ($self) = @_; 2467 my ($self) = @_;
2341 2468
… …
2344 return unless $self->{h} > 0; 2471 return unless $self->{h} > 0;
2345 2472
2346 delete $self->{texture}; 2473 delete $self->{texture};
2347 2474
2348 $ROOT->on_post_alloc ($self, sub { 2475 $ROOT->on_post_alloc ($self, sub {
2476 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2477
2349 if (delete $self->{need_reflow}) { 2478 if (delete $self->{need_reflow}) {
2350 my $height = 0; 2479 my $height = 0;
2351 2480
2352 $height += $_->[0] = $self->text_height ($_->[3], $_->[2]) 2481 my $layout = $self->{layout};
2482
2483 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2484
2353 for @{$self->{par}}; 2485 for (@{$self->{par}}) {
2486 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2487 $layout->set_width ($W - $_->[3]);
2488 $layout->set_markup ($_->[4]);
2489 my ($w, $h) = $layout->size;
2490 $_->[0] = $w + $_->[3];
2491 $_->[1] = $h;
2492 }
2493
2494 $height += $_->[1];
2495 }
2354 2496
2355 $self->{height} = $height; 2497 $self->{height} = $height;
2356 2498
2357 $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}]; 2499 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2358 $self->{children}[1]->update;
2359 2500
2360 delete $self->{texture}; 2501 delete $self->{texture};
2361 } 2502 }
2362 2503
2363 $self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub { 2504 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2364 glClearColor 0.5, 0.5, 0.5, 0; 2505 glClearColor 0.5, 0.5, 0.5, 0;
2365 glClear GL_COLOR_BUFFER_BIT; 2506 glClear GL_COLOR_BUFFER_BIT;
2366 2507
2367 my $top = int $self->{children}[1]{range}[0]; 2508 my $top = int $self->{children}[1]{range}[0];
2368 2509
2369 my $y0 = $top; 2510 my $y0 = $top;
2370 my $y1 = $top + $self->{h}; 2511 my $y1 = $top + $H;
2371 2512
2372 my $y = 0; 2513 my $y = 0;
2373 2514
2374 my $layout = $self->{layout}; 2515 my $layout = $self->{layout};
2375 2516
2376 $layout->set_font ($self->{font}) if $self->{font}; 2517 $layout->set_font ($self->{font}) if $self->{font};
2377 2518
2378 glEnable GL_BLEND; 2519 glEnable GL_BLEND;
2520 #TODO# not correct in windows where rgba is forced off
2379 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2521 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2380 2522
2381 for my $par (@{$self->{par}}) { 2523 for my $par (@{$self->{par}}) {
2382 my $h = $par->[0]; 2524 my $h = $par->[1];
2383 2525
2384 if ($y0 < $y + $h && $y < $y1) { 2526 if ($y0 < $y + $h && $y < $y1) {
2385 $layout->set_foreground (@{ $par->[1] }); 2527 $layout->set_foreground (@{ $par->[2] });
2386 $layout->set_width ($self->{w} - $par->[2]); 2528 $layout->set_width ($W - $par->[3]);
2387 $layout->set_markup ($par->[3]); 2529 $layout->set_markup ($par->[4]);
2388 2530
2389 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2531 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2390 2532
2391 glRasterPos $par->[2], $y - $y0; 2533 glRasterPos $par->[3], $y - $y0;
2392 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2534 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2393 } 2535 }
2394 2536
2395 $y += $h; 2537 $y += $h;
2396 } 2538 }
… …
2463 2605
2464sub new { 2606sub new {
2465 my $class = shift; 2607 my $class = shift;
2466 2608
2467 my $self = $class->SUPER::new ( 2609 my $self = $class->SUPER::new (
2468 state => 0, 2610 state => 0,
2469 connect_activate => \&toggle_flopper, 2611 on_activate => \&toggle_flopper,
2470 @_ 2612 @_
2471 ); 2613 );
2472 2614
2473 if ($self->{state}) {
2474 $self->{state} = 0;
2475 $self->toggle_flopper;
2476 }
2477
2478 $self 2615 $self
2479} 2616}
2480 2617
2481sub toggle_flopper { 2618sub toggle_flopper {
2482 my ($self) = @_; 2619 my ($self) = @_;
2483 2620
2484 # TODO: use animation 2621 $self->{other}->toggle_visibility;
2485 if ($self->{state} = !$self->{state}) {
2486 $CFClient::UI::ROOT->add ($self->{other});
2487 $self->{other}->move ($self->coord2global (0, $self->{h}));
2488 $self->emit ("open");
2489 } else {
2490 $CFClient::UI::ROOT->remove ($self->{other});
2491 $self->emit ("close");
2492 }
2493
2494 $self->emit (changed => $self->{state});
2495} 2622}
2496 2623
2497############################################################################# 2624#############################################################################
2498 2625
2499package CFClient::UI::Tooltip; 2626package CFClient::UI::Tooltip;
… …
2512} 2639}
2513 2640
2514sub set_tooltip_from { 2641sub set_tooltip_from {
2515 my ($self, $widget) = @_; 2642 my ($self, $widget) = @_;
2516 2643
2644 my $tooltip = $widget->{tooltip};
2645
2646 if ($ENV{CFPLUS_DEBUG} & 2) {
2647 $tooltip .= "\n\n" . (ref $widget) . "\n"
2648 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2649 . "req $widget->{req_w} $widget->{req_h}\n"
2650 . "visible $widget->{visible}";
2651 }
2652
2517 $self->add (new CFClient::UI::Label 2653 $self->add (new CFClient::UI::Label
2518 markup => $widget->{tooltip}, 2654 markup => $tooltip,
2519 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2655 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2520 fontsize => 0.8, 2656 fontsize => 0.8,
2521 fg => [0, 0, 0, 1], 2657 fg => [0, 0, 0, 1],
2522 ellipsise => 0, 2658 ellipsise => 0,
2523 font => ($widget->{tooltip_font} || $::FONT_PROP), 2659 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2534 2670
2535sub size_allocate { 2671sub size_allocate {
2536 my ($self, $w, $h) = @_; 2672 my ($self, $w, $h) = @_;
2537 2673
2538 $self->SUPER::size_allocate ($w - 4, $h - 4); 2674 $self->SUPER::size_allocate ($w - 4, $h - 4);
2675}
2676
2677sub visibility_change {
2678 my ($self, $visible) = @_;
2679
2680 return unless $visible;
2681
2682 $self->{root}->on_post_alloc ("move_$self" => sub {
2683 my $widget = $self->{owner}
2684 or return;
2685
2686 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2687
2688 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2689 if $x + $self->{w} > $::WIDTH;
2690
2691 $self->move_abs ($x, $y);
2692 });
2539} 2693}
2540 2694
2541sub _draw { 2695sub _draw {
2542 my ($self) = @_; 2696 my ($self) = @_;
2543 2697
… …
2560 glVertex $w, $h; 2714 glVertex $w, $h;
2561 glVertex $w, 0; 2715 glVertex $w, 0;
2562 glEnd; 2716 glEnd;
2563 2717
2564 glTranslate 2 - 0.375, 2 - 0.375; 2718 glTranslate 2 - 0.375, 2 - 0.375;
2719
2565 $self->SUPER::_draw; 2720 $self->SUPER::_draw;
2566} 2721}
2567 2722
2568############################################################################# 2723#############################################################################
2569 2724
… …
2575 2730
2576sub new { 2731sub new {
2577 my $class = shift; 2732 my $class = shift;
2578 2733
2579 my $self = $class->SUPER::new ( 2734 my $self = $class->SUPER::new (
2580 aspect => 1, 2735 aspect => 1,
2736 can_events => 0,
2581 @_, 2737 @_,
2582 ); 2738 );
2583 2739
2584 if ($self->{anim} && $self->{animspeed}) { 2740 if ($self->{anim} && $self->{animspeed}) {
2585 Scalar::Util::weaken (my $widget = $self); 2741 Scalar::Util::weaken (my $widget = $self);
… …
2611} 2767}
2612 2768
2613sub _draw { 2769sub _draw {
2614 my ($self) = @_; 2770 my ($self) = @_;
2615 2771
2616 return unless $::CONN;#d# manage and cache textures differently 2772 return unless $::CONN;
2617 2773
2618 my $face; 2774 my $face;
2619 2775
2620 if ($self->{frame}) { 2776 if ($self->{frame}) {
2621 my $anim = $::CONN->{anim}[$self->{anim}]; 2777 my $anim = $::CONN->{anim}[$self->{anim}];
… …
2640 2796
2641 $self->{timer}->cancel 2797 $self->{timer}->cancel
2642 if $self->{timer}; 2798 if $self->{timer};
2643 2799
2644 $self->SUPER::DESTROY; 2800 $self->SUPER::DESTROY;
2645}
2646
2647#############################################################################
2648
2649package CFClient::UI::InventoryItem;
2650
2651our @ISA = CFClient::UI::HBox::;
2652
2653sub _item_to_desc {
2654 my ($item) = @_;
2655
2656 my $desc =
2657 $item->{nrof} < 2
2658 ? $item->{name}
2659 : "$item->{nrof} × $item->{name_pl}";
2660
2661 $item->{flags} & Crossfire::Protocol::F_OPEN
2662 and $desc .= " (open)";
2663 $item->{flags} & Crossfire::Protocol::F_APPLIED
2664 and $desc .= " (applied)";
2665 $item->{flags} & Crossfire::Protocol::F_UNPAID
2666 and $desc .= " (unpaid)";
2667 $item->{flags} & Crossfire::Protocol::F_MAGIC
2668 and $desc .= " (magic)";
2669 $item->{flags} & Crossfire::Protocol::F_CURSED
2670 and $desc .= " (cursed)";
2671 $item->{flags} & Crossfire::Protocol::F_DAMNED
2672 and $desc .= " (damned)";
2673 $item->{flags} & Crossfire::Protocol::F_LOCKED
2674 and $desc .= " *";
2675
2676 $desc
2677}
2678
2679sub new {
2680 my $class = shift;
2681
2682 my %args = @_;
2683
2684 my $item = delete $args{item};
2685
2686 my $desc = _item_to_desc ($item);
2687
2688 my $self = $class->SUPER::new (
2689 can_hover => 1,
2690 can_events => 1,
2691 tooltip => ((CFClient::UI::Label::escape $desc)
2692 . "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2693 connect_button_down => sub {
2694 my ($self, $ev, $x, $y) = @_;
2695
2696 # todo: maybe put examine on 1? but should just be a tooltip :(
2697 if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2698 my $targ = $::CONN->{player}{tag};
2699
2700 if ($item->{container} == $::CONN->{player}{tag}) {
2701 $targ = $main::OPENCONT;
2702 }
2703
2704 $::CONN->send ("move $targ $item->{tag} 0");
2705 } elsif ($ev->{button} == 1) {
2706 $::CONN->send ("examine $item->{tag}");
2707 } elsif ($ev->{button} == 2) {
2708 $::CONN->send ("apply $item->{tag}");
2709 } elsif ($ev->{button} == 3) {
2710 my @menu_items = (
2711 ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2712 ["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2713 ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2714 (
2715 $item->{flags} & Crossfire::Protocol::F_LOCKED
2716 ? (
2717 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2718 )
2719 : (
2720 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2721 ["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2722 )
2723 ),
2724 );
2725
2726 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2727 }
2728
2729 1
2730 },
2731 %args
2732 );
2733
2734
2735 $self->add (new CFClient::UI::Face
2736 can_events => 0,
2737 face => $item->{face},
2738 anim => $item->{anim},
2739 animspeed => $item->{animspeed},
2740 );
2741
2742 $self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2743
2744 $self->{item} = $item;
2745
2746 $self->update_item;
2747
2748 $self
2749}
2750
2751sub update_item {
2752 my ($self) = @_;
2753
2754 my $desc = _item_to_desc ($self->{item});
2755
2756 $self->{name_lbl}->set_text ($desc);
2757}
2758
2759#############################################################################
2760
2761package CFClient::UI::Inventory;
2762
2763our @ISA = CFClient::UI::ScrolledWindow::;
2764
2765sub new {
2766 my $class = shift;
2767
2768 my $self = $class->SUPER::new (
2769 scrolled => (new CFClient::UI::Table),
2770 @_,
2771 );
2772
2773 $self
2774}
2775
2776sub set_items {
2777 my ($self, $items) = @_;
2778
2779 $self->{scrolled}->clear;
2780 return unless $items;
2781
2782 my @items = sort {
2783 ($a->{type} <=> $b->{type})
2784 or ($a->{name} cmp $b->{name})
2785 } @$items;
2786
2787 $self->{real_items} = \@items;
2788
2789 for my $item (@items) {
2790 $item->{item} = $item;
2791 $item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2792 $item->update_item ();
2793 }
2794
2795 my $i = 0;
2796 for (@items) {
2797 $self->{scrolled}->add (0, $i, $_);
2798 my $nrof = $_->{item}->{nrof} || 1;
2799 $self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2800 }
2801
2802# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2803}
2804
2805sub size_request {
2806 my ($self) = @_;
2807 ($self->{req_w}, $self->{req_h});
2808} 2801}
2809 2802
2810############################################################################# 2803#############################################################################
2811 2804
2812package CFClient::UI::Menu; 2805package CFClient::UI::Menu;
… …
2847 2840
2848# popup given the event (must be a mouse button down event currently) 2841# popup given the event (must be a mouse button down event currently)
2849sub popup { 2842sub popup {
2850 my ($self, $ev) = @_; 2843 my ($self, $ev) = @_;
2851 2844
2852 $self->emit ("popdown"); 2845 $self->_emit ("popdown");
2853 2846
2854 # maybe save $GRAB? must be careful about events... 2847 # maybe save $GRAB? must be careful about events...
2855 $GRAB = $self; 2848 $GRAB = $self;
2856 $self->{button} = $ev->{button}; 2849 $self->{button} = $ev->{button};
2857 2850
2858 $self->show; 2851 $self->show;
2859 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2852 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2860} 2853}
2861 2854
2862sub mouse_motion { 2855sub mouse_motion {
2863 my ($self, $ev, $x, $y) = @_; 2856 my ($self, $ev, $x, $y) = @_;
2864 2857
… …
2872 2865
2873 if ($ev->{button} == $self->{button}) { 2866 if ($ev->{button} == $self->{button}) {
2874 undef $GRAB; 2867 undef $GRAB;
2875 $self->hide; 2868 $self->hide;
2876 2869
2877 $self->emit ("popdown"); 2870 $self->_emit ("popdown");
2878 $self->{hover}[1]->() if $self->{hover}; 2871 $self->{hover}[1]->() if $self->{hover};
2879 } 2872 }
2880} 2873}
2881 2874
2882############################################################################# 2875#############################################################################
… …
2944sub add { 2937sub add {
2945 my ($self, $text, %arg) = @_; 2938 my ($self, $text, %arg) = @_;
2946 2939
2947 $text =~ s/^\s+//; 2940 $text =~ s/^\s+//;
2948 $text =~ s/\s+$//; 2941 $text =~ s/\s+$//;
2942
2943 return unless $text;
2949 2944
2950 my $timeout = time + ((delete $arg{timeout}) || 60); 2945 my $timeout = time + ((delete $arg{timeout}) || 60);
2951 2946
2952 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 2947 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2953 2948
… …
2987 $self->SUPER::reconfigure; 2982 $self->SUPER::reconfigure;
2988} 2983}
2989 2984
2990############################################################################# 2985#############################################################################
2991 2986
2992package CFClient::UI::Root; 2987package CFClient::UI::Inventory;
2993 2988
2994our @ISA = CFClient::UI::Container::; 2989our @ISA = CFClient::UI::ScrolledWindow::;
2995
2996use CFClient::OpenGL;
2997 2990
2998sub new { 2991sub new {
2999 my $class = shift; 2992 my $class = shift;
3000 2993
3001 $class->SUPER::new ( 2994 my $self = $class->SUPER::new (
2995 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3002 @_, 2996 @_,
3003 ) 2997 );
3004}
3005 2998
3006sub configure { 2999 $self
3000}
3001
3002sub set_items {
3003 my ($self, $items) = @_;
3004
3005 $self->{scrolled}->clear;
3006 return unless $items;
3007
3008 my @items = sort {
3009 ($a->{type} <=> $b->{type})
3010 or ($a->{name} cmp $b->{name})
3011 } @$items;
3012
3013 $self->{real_items} = \@items;
3014
3015 my $row = 0;
3016 for my $item (@items) {
3017 CFClient::Item::update_widgets $item;
3018
3019 $self->{scrolled}->add (0, $row, $item->{face_widget});
3020 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3021 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3022
3023 $row++;
3024 }
3025}
3026
3027#############################################################################
3028
3029package CFClient::UI::BindEditor;
3030
3031our @ISA = CFClient::UI::FancyFrame::;
3032
3033sub new {
3034 my $class = shift;
3035
3036 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3037
3038 $self->add (my $vb = new CFClient::UI::VBox);
3039
3040
3041 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3042 text => "start recording",
3043 tooltip => "Start/Stops recording of actions."
3044 ."All subsequent actions after the recording started will be captured."
3045 ."The actions are displayed after the record was stopped."
3046 ."To bind the action you have to click on the 'Bind' button",
3047 on_activate => sub {
3048 unless ($self->{recording}) {
3049 $self->start;
3050 } else {
3051 $self->stop;
3052 }
3053 });
3054
3055 $vb->add (new CFClient::UI::Label text => "Actions:");
3056 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3057
3058 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3059 $vb->add (my $hb = new CFClient::UI::HBox);
3060 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3061 $hb->add (new CFClient::UI::Button
3062 text => "bind",
3063 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3064 on_activate => sub {
3065 $self->ask_for_bind;
3066 });
3067
3068 $vb->add (my $hb = new CFClient::UI::HBox);
3069 $hb->add (new CFClient::UI::Button
3070 text => "ok",
3071 expand => 1,
3072 tooltip => "This closes the binding editor and saves the binding",
3073 on_activate => sub {
3074 $self->hide;
3075 $self->commit;
3076 });
3077
3078 $hb->add (new CFClient::UI::Button
3079 text => "cancel",
3080 expand => 1,
3081 tooltip => "This closes the binding editor without saving",
3082 on_activate => sub {
3083 $self->hide;
3084 $self->{binding_cancel}->()
3085 if $self->{binding_cancel};
3086 });
3087
3088 $self->update_binding_widgets;
3089
3090 $self
3091}
3092
3093sub commit {
3094 my ($self) = @_;
3095 my ($mod, $sym, $cmds) = $self->get_binding;
3096 if ($sym != 0 && @$cmds > 0) {
3097 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3098 ."'. Don't forget 'Save Config'!");
3099 $self->{binding_change}->($mod, $sym, $cmds)
3100 if $self->{binding_change};
3101 } else {
3102 $::STATUSBOX->add ("No action bound, no key or action specified!");
3103 $self->{binding_cancel}->()
3104 if $self->{binding_cancel};
3105 }
3106}
3107
3108sub start {
3109 my ($self) = @_;
3110
3111 $self->{rec_btn}->set_text ("stop recording");
3112 $self->{recording} = 1;
3113 $self->clear_command_list;
3114 $::CONN->start_record if $::CONN;
3115}
3116
3117sub stop {
3118 my ($self) = @_;
3119
3120 $self->{rec_btn}->set_text ("start recording");
3121 $self->{recording} = 0;
3122
3123 my $rec;
3124 $rec = $::CONN->stop_record if $::CONN;
3125 return unless ref $rec eq 'ARRAY';
3126 $self->set_command_list ($rec);
3127}
3128
3129# if $commit is true, the binding will be set after the user entered a key combo
3130sub ask_for_bind {
3131 my ($self, $commit) = @_;
3132
3133 CFClient::Binder::open_binding_dialog (sub {
3134 my ($mod, $sym) = @_;
3135 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3136 $self->update_binding_widgets;
3137 $self->commit if $commit;
3138 });
3139}
3140
3141# $mod and $sym are the modifiers and key symbol
3142# $cmds is a array ref of strings (the commands)
3143# $cb is the callback that is executed on OK
3144# $ccb is the callback that is executed on CANCEL and
3145# when the binding was unsuccessful on OK
3146sub set_binding {
3007 my ($self, $x, $y, $w, $h) = @_; 3147 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3008 3148
3009 $self->{w} = $w; 3149 $self->clear_command_list;
3010 $self->{h} = $h; 3150 $self->{recording} = 0;
3011} 3151 $self->{rec_btn}->set_text ("start recording");
3012 3152
3013sub check_size { 3153 $self->{binding} = [$mod, $sym];
3154 $self->{commands} = $cmds;
3155
3156 $self->{binding_change} = $cb;
3157 $self->{binding_cancel} = $ccb;
3158
3159 $self->update_binding_widgets;
3160}
3161
3162# this is a shortcut method that asks for a binding
3163# and then just binds it.
3164sub do_quick_binding {
3014 my ($self) = @_; 3165 my ($self, $cmds) = @_;
3166 $self->set_binding (undef, undef, $cmds, sub {
3167 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3168 });
3169 $self->ask_for_bind (1);
3170}
3015 3171
3016 $self->size_allocate ($self->{w}, $self->{h}) 3172sub update_binding_widgets {
3017 if $self->{w}; 3173 my ($self) = @_;
3174 my ($mod, $sym, $cmds) = $self->get_binding;
3175 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3176 $self->set_command_list ($cmds);
3177}
3178
3179sub get_binding {
3180 my ($self) = @_;
3181 return (
3182 $self->{binding}->[0],
3183 $self->{binding}->[1],
3184 [ grep { defined $_ } @{$self->{commands}} ]
3185 );
3186}
3187
3188sub clear_command_list {
3189 my ($self) = @_;
3190 $self->{cmdbox}->clear ();
3191}
3192
3193sub set_command_list {
3194 my ($self, $cmds) = @_;
3195
3196 $self->{cmdbox}->clear ();
3197 $self->{commands} = $cmds;
3198
3199 my $idx = 0;
3200
3201 for (@$cmds) {
3202 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3203
3204 my $i = $idx;
3205 $hb->add (new CFClient::UI::Label text => $_);
3206 $hb->add (new CFClient::UI::Button
3207 text => "delete",
3208 tooltip => "Deletes the action from the record",
3209 on_activate => sub {
3210 $self->{cmdbox}->remove ($hb);
3211 $cmds->[$i] = undef;
3212 });
3213
3214
3215 $idx++
3216 }
3217}
3218
3219#############################################################################
3220
3221package CFClient::UI::SpellList;
3222
3223our @ISA = CFClient::UI::FancyFrame::;
3224
3225sub new {
3226 my $class = shift;
3227
3228 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3229
3230 $self->add (new CFClient::UI::ScrolledWindow
3231 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3232
3233 $self;
3234}
3235
3236# XXX: Do sorting? Argl...
3237sub add_spell {
3238 my ($self, $spell) = @_;
3239 $self->{spells}->{$spell->{name}} = $spell;
3240
3241 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3242 face => $spell->{face},
3243 can_hover => 1,
3244 can_events => 1,
3245 tooltip => $spell->{message});
3246
3247 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3248 text => $spell->{name},
3249 can_hover => 1,
3250 can_events => 1,
3251 tooltip => $spell->{message},
3252 expand => 1);
3253
3254 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3255 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3256 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3257 expand => 1);
3258
3259 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3260 text => "bind to key",
3261 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3262}
3263
3264sub rebuild_spell_list {
3265 my ($self) = @_;
3266 $self->{tbl_idx} = 0;
3267 $self->add_spell ($_) for values %{$self->{spells}};
3268}
3269
3270sub remove_spell {
3271 my ($self, $spell) = @_;
3272 delete $self->{spells}->{$spell->{name}};
3273 $self->rebuild_spell_list;
3274}
3275
3276#############################################################################
3277
3278package CFClient::UI::Root;
3279
3280our @ISA = CFClient::UI::Container::;
3281
3282use CFClient::OpenGL;
3283
3284sub new {
3285 my $class = shift;
3286
3287 my $self = $class->SUPER::new (
3288 visible => 1,
3289 @_,
3290 );
3291
3292 Scalar::Util::weaken ($self->{root} = $self);
3293
3294 $self
3018} 3295}
3019 3296
3020sub size_request { 3297sub size_request {
3021 my ($self) = @_; 3298 my ($self) = @_;
3022 3299
3023 ($self->{w}, $self->{h}) 3300 ($self->{w}, $self->{h})
3301}
3302
3303sub _to_pixel {
3304 my ($coord, $size, $max) = @_;
3305
3306 $coord =
3307 $coord eq "center" ? ($max - $size) * 0.5
3308 : $coord eq "max" ? $max
3309 : $coord;
3310
3311 $coord = 0 if $coord < 0;
3312 $coord = $max - $size if $coord > $max - $size;
3313
3314 int $coord + 0.5
3024} 3315}
3025 3316
3026sub size_allocate { 3317sub size_allocate {
3027 my ($self, $w, $h) = @_; 3318 my ($self, $w, $h) = @_;
3028 3319
3029 my $old_w = $self->{old_w}; $self->{old_w} = $w;
3030 my $old_h = $self->{old_h}; $self->{old_h} = $h;
3031
3032 CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
3033 if $old_w && $old_h && ($old_w != $w || $old_h != $h);
3034
3035 for my $child ($self->children) { 3320 for my $child ($self->children) {
3036 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3321 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3037 3322
3038 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3323 $X = $child->{force_x} if exists $child->{force_x};
3039 if exists $child->{req_x}; 3324 $Y = $child->{force_y} if exists $child->{force_y};
3040 3325
3041 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3326 $X = _to_pixel $X, $W, $self->{w};
3042 if exists $child->{req_y}; 3327 $Y = _to_pixel $Y, $H, $self->{h};
3043
3044 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3045 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3046 3328
3047 $child->configure ($X, $Y, $W, $H); 3329 $child->configure ($X, $Y, $W, $H);
3048 } 3330 }
3049} 3331}
3050 3332
… …
3061} 3343}
3062 3344
3063sub update { 3345sub update {
3064 my ($self) = @_; 3346 my ($self) = @_;
3065 3347
3066 $self->check_size;
3067 $::WANT_REFRESH++; 3348 $::WANT_REFRESH++;
3068} 3349}
3069 3350
3070sub add { 3351sub add {
3071 my ($self, @children) = @_; 3352 my ($self, @children) = @_;
3072 3353
3073 for my $child (@children) {
3074 $child->{toplevel} = 1; 3354 $_->{is_toplevel} = 1
3075 3355 for @children;
3076 # integerise window positions
3077 $child->{x} = int $child->{x};
3078 $child->{y} = int $child->{y};
3079 }
3080 3356
3081 $self->SUPER::add (@children); 3357 $self->SUPER::add (@children);
3358}
3359
3360sub remove {
3361 my ($self, @children) = @_;
3362
3363 $self->SUPER::remove (@children);
3364
3365 delete $self->{is_toplevel}
3366 for @children;
3082 3367
3083 while (@children) { 3368 while (@children) {
3084 my $w = pop @children; 3369 my $w = pop @children;
3085 push @children, $w->children; 3370 push @children, $w->children;
3086 $w->{visible} = 1; 3371 $w->set_invisible;
3087 }
3088}
3089
3090sub remove {
3091 my ($self, @children) = @_;
3092
3093 $self->SUPER::remove (@children);
3094
3095 while (@children) {
3096 my $w = pop @children;
3097 push @children, $w->children;
3098 delete $w->{visible};
3099 } 3372 }
3100} 3373}
3101 3374
3102sub on_refresh { 3375sub on_refresh {
3103 my ($self, $id, $cb) = @_; 3376 my ($self, $id, $cb) = @_;
… …
3117 while ($self->{refresh_hook}) { 3390 while ($self->{refresh_hook}) {
3118 $_->() 3391 $_->()
3119 for values %{delete $self->{refresh_hook}}; 3392 for values %{delete $self->{refresh_hook}};
3120 } 3393 }
3121 3394
3122 if ($self->{check_size}) { 3395 if ($self->{realloc}) {
3123 my @queue = ([], []); 3396 my %queue;
3397 my @queue;
3398 my $widget;
3124 3399
3125 for (;;) { 3400 outer:
3126 if ($self->{check_size}) { 3401 while () {
3127 # heuristic: check containers last 3402 if (my $realloc = delete $self->{realloc}) {
3128 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3403 for $widget (values %$realloc) {
3129 for values %{delete $self->{check_size}} 3404 $widget->{visible} or next; # do not resize invisible widgets
3405
3406 $queue{$widget+0}++ and next; # duplicates are common
3407
3408 push @{ $queue[$widget->{visible}] }, $widget;
3409 }
3130 } 3410 }
3131 3411
3132 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3412 while () {
3413 @queue or last outer;
3133 3414
3134 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3415 $widget = pop @{ $queue[-1] || [] }
3135 ? @$widget{qw(user_w user_h)} 3416 and last;
3136 : $widget->size_request;
3137
3138 if (delete $widget->{force_alloc}
3139 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3140 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3141 3417
3418 pop @queue;
3419 }
3420
3421 delete $queue{$widget+0};
3422
3423 my ($w, $h) = $widget->size_request;
3424
3425 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3426 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3427
3428 $w = $widget->{force_w} if exists $widget->{force_w};
3429 $h = $widget->{force_h} if exists $widget->{force_h};
3430
3431 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3432 || delete $widget->{force_realloc}) {
3142 $widget->{req_w} = $w; 3433 $widget->{req_w} = $w;
3143 $widget->{req_h} = $h; 3434 $widget->{req_h} = $h;
3144 3435
3145 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3436 $self->{size_alloc}{$widget+0} = $widget;
3146 3437
3147 $widget->{parent}->check_size
3148 if $widget->{parent}; 3438 if (my $parent = $widget->{parent}) {
3439 $self->{realloc}{$parent+0} = $parent
3440 unless $queue{$parent+0};
3441
3442 $parent->{force_size_alloc} = 1;
3443 $self->{size_alloc}{$parent+0} = $parent;
3444 }
3149 } 3445 }
3446
3447 delete $self->{realloc}{$widget+0};
3150 } 3448 }
3151 } 3449 }
3152 3450
3153 while ($self->{size_alloc}) { 3451 while (my $size_alloc = delete $self->{size_alloc}) {
3154 for (values %{delete $self->{size_alloc}}) { 3452 my @queue = sort { $b->{visible} <=> $a->{visible} }
3155 my ($widget, $w, $h) = @$_; 3453 values %$size_alloc;
3454
3455 while () {
3456 my $widget = pop @queue || last;
3457
3458 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3156 3459
3157 $w = 0 if $w < 0; 3460 $w = 0 if $w < 0;
3158 $h = 0 if $h < 0; 3461 $h = 0 if $h < 0;
3159 3462
3463 $w = int $w + 0.5;
3464 $h = int $h + 0.5;
3465
3466 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3467 $widget->{old_w} = $widget->{w};
3468 $widget->{old_h} = $widget->{h};
3469
3160 $widget->{w} = $w; 3470 $widget->{w} = $w;
3161 $widget->{h} = $h; 3471 $widget->{h} = $h;
3162 $widget->size_allocate ($w, $h); 3472
3163 $widget->emit (size_allocate => $w, $h); 3473 $widget->emit (size_allocate => $w, $h);
3474 }
3164 } 3475 }
3165 } 3476 }
3166 3477
3167 while ($self->{post_alloc_hook}) { 3478 while ($self->{post_alloc_hook}) {
3168 $_->() 3479 $_->()
3169 for values %{delete $self->{post_alloc_hook}}; 3480 for values %{delete $self->{post_alloc_hook}};
3170 } 3481 }
3482
3171 3483
3172 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3484 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3173 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3485 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3174 glClear GL_COLOR_BUFFER_BIT; 3486 glClear GL_COLOR_BUFFER_BIT;
3175 3487
… …
3177 glLoadIdentity; 3489 glLoadIdentity;
3178 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 3490 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3179 glMatrixMode GL_MODELVIEW; 3491 glMatrixMode GL_MODELVIEW;
3180 glLoadIdentity; 3492 glLoadIdentity;
3181 3493
3494 {
3495 package CFClient::UI::Base;
3496
3497 ($draw_x, $draw_y, $draw_w, $draw_h) =
3498 (0, 0, $self->{w}, $self->{h});
3499 }
3500
3182 $self->_draw; 3501 $self->_draw;
3183} 3502}
3184 3503
3185############################################################################# 3504#############################################################################
3186 3505

Diff Legend

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