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.195 by root, Thu May 11 23:54:31 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
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}
43
17sub check_tooltip { 44sub check_tooltip {
45 return if $ENV{CFPLUS_DEBUG} & 8;
46
18 if (!$GRAB) { 47 if (!$GRAB) {
19 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 48 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
20 if (length $widget->{tooltip}) { 49 if (length $widget->{tooltip}) {
21
22 if ($TOOLTIP->{owner} != $widget) { 50 if ($TOOLTIP->{owner} != $widget) {
51 $TOOLTIP->hide;
52
23 $TOOLTIP->{owner} = $widget; 53 $TOOLTIP->{owner} = $widget;
24 54
25 my $tip = $widget->{tooltip}; 55 my $tip = $widget->{tooltip};
26 56
27 $tip = $tip->($widget) if CODE:: eq ref $tip; 57 $tip = $tip->($widget) if CODE:: eq ref $tip;
28 58
29 $TOOLTIP->set_markup ($widget->{tooltip}, $widget->{tooltip_font}); 59 $TOOLTIP->set_tooltip_from ($widget);
30
31 $TOOLTIP->show; 60 $TOOLTIP->show;
32
33 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
34
35 if ($x + $TOOLTIP->{w} > $::WIDTH) {
36 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0);
37 }
38
39 $TOOLTIP->move ($x, $y);
40 } 61 }
41 62
42 return; 63 return;
43 } 64 }
44 } 65 }
… …
48 delete $TOOLTIP->{owner}; 69 delete $TOOLTIP->{owner};
49} 70}
50 71
51# class methods for events 72# class methods for events
52sub feed_sdl_key_down_event { 73sub feed_sdl_key_down_event {
53 $FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0]) 74 $FOCUS->emit (key_down => $_[0])
54 if $FOCUS; 75 if $FOCUS;
55} 76}
56 77
57sub feed_sdl_key_up_event { 78sub feed_sdl_key_up_event {
58 $FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0]) 79 $FOCUS->emit (key_up => $_[0])
59 if $FOCUS; 80 if $FOCUS;
60} 81}
61 82
62sub feed_sdl_button_down_event { 83sub feed_sdl_button_down_event {
63 my ($ev) = @_; 84 my ($ev) = @_;
… …
72 check_tooltip; 93 check_tooltip;
73 } 94 }
74 95
75 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 96 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
76 97
77 if ($GRAB) { 98 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
78 ($x, $y) = $GRAB->coord2local ($x, $y); 99 if $GRAB;
79 $GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
80 }
81} 100}
82 101
83sub feed_sdl_button_up_event { 102sub feed_sdl_button_up_event {
84 my ($ev) = @_; 103 my ($ev) = @_;
85 my ($x, $y) = ($ev->{x}, $ev->{y}); 104 my ($x, $y) = ($ev->{x}, $ev->{y});
86 105
87 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 106 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
88 107
89 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 108 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
90 109
91 if ($GRAB) { 110 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
92 ($x, $y) = $GRAB->coord2local ($x, $y); 111 if $GRAB;
93 $GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
94 }
95 112
96 if (!$BUTTON_STATE) { 113 if (!$BUTTON_STATE) {
97 my $grab = $GRAB; undef $GRAB; 114 my $grab = $GRAB; undef $GRAB;
98 $grab->update if $grab; 115 $grab->update if $grab;
99 $GRAB->update if $GRAB; 116 $GRAB->update if $GRAB;
… …
115 $HOVER->update if $HOVER && $HOVER->{can_hover}; 132 $HOVER->update if $HOVER && $HOVER->{can_hover};
116 133
117 check_tooltip; 134 check_tooltip;
118 } 135 }
119 136
120 if ($HOVER) {
121 ($x, $y) = $HOVER->coord2local ($x, $y);
122 $HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y); 137 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
123 } 138 if $HOVER;
124} 139}
125 140
126# convert position array to integers 141# convert position array to integers
127sub harmonize { 142sub harmonize {
128 my ($vals) = @_; 143 my ($vals) = @_;
… …
134 $rem += $_ - $i; 149 $rem += $_ - $i;
135 $_ = $i; 150 $_ = $i;
136 } 151 }
137} 152}
138 153
154sub full_refresh {
155 # make a copy, otherwise for complains about freed values.
156 my @widgets = values %WIDGET;
157
158 $_->update
159 for @widgets;
160}
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
170# call when resolution changes etc.
171sub rescale_widgets {
172 my ($sx, $sy) = @_;
173
174 for my $widget (values %WIDGET) {
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
179 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
180 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
181 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
182 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
183 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
184 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_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
189 }
190 }
191
192 reconfigure_widgets;
193}
194
139############################################################################# 195#############################################################################
140 196
141package CFClient::UI::Base; 197package CFClient::UI::Base;
142 198
143use strict; 199use strict;
… …
146 202
147sub new { 203sub new {
148 my $class = shift; 204 my $class = shift;
149 205
150 my $self = bless { 206 my $self = bless {
151 x => 0, 207 x => "center",
152 y => 0, 208 y => "center",
153 z => 0, 209 z => 0,
210 w => undef,
211 h => undef,
154 can_events => 1, 212 can_events => 1,
155 @_ 213 @_
156 }, $class; 214 }, $class;
157 215
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
158 for (keys %$self) { 218 for (keys %$self) {
159 if (/^connect_(.*)$/) { 219 if (/^on_(.*)$/) {
160 $self->connect ($1 => delete $self->{$_}); 220 $self->connect ($1 => delete $self->{$_});
161 } 221 }
162 } 222 }
163 223
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 }
235
164 $self 236 $self
165} 237}
166 238
167sub destroy { 239sub destroy {
168 my ($self) = @_; 240 my ($self) = @_;
… …
177 return if $self->{parent}; 249 return if $self->{parent};
178 250
179 $CFClient::UI::ROOT->add ($self); 251 $CFClient::UI::ROOT->add ($self);
180} 252}
181 253
182sub hide { 254sub set_visible {
183 my ($self) = @_; 255 my ($self) = @_;
256
257 return if $self->{visible};
258
259 $self->{root} = $self->{parent}{root};
260 $self->{visible} = $self->{parent}{visible} + 1;
261
262 $self->emit (visibility_change => 1);
263
264 $self->realloc if !exists $self->{req_w};
265
266 $_->set_visible for $self->children;
267}
268
269sub set_invisible {
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};
184 278
185 undef $GRAB if $GRAB == $self; 279 undef $GRAB if $GRAB == $self;
186 undef $HOVER if $HOVER == $self; 280 undef $HOVER if $HOVER == $self;
187 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
188 $self->{parent}->remove ($self) 312 $self->{parent}->remove ($self)
189 if $self->{parent}; 313 if $self->{parent};
190} 314}
191 315
192sub move { 316sub move_abs {
193 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
194 318
195 $self->{x} = int $x; 319 $self->{x} = List::Util::max 0, int $x;
196 $self->{y} = int $y; 320 $self->{y} = List::Util::max 0, int $y;
197 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
198 322
199 $self->update; 323 $self->update;
200} 324}
201 325
202sub set_size { 326sub set_size {
203 my ($self, $w, $h) = @_; 327 my ($self, $w, $h) = @_;
204 328
205 $self->{user_w} = $w; 329 $self->{force_w} = $w;
206 $self->{user_h} = $h; 330 $self->{force_h} = $h;
207 331
208 $self->check_size; 332 $self->realloc;
209} 333}
210 334
211sub size_request { 335sub size_request {
212 require Carp; 336 require Carp;
213 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
… …
215 339
216sub configure { 340sub configure {
217 my ($self, $x, $y, $w, $h) = @_; 341 my ($self, $x, $y, $w, $h) = @_;
218 342
219 if ($self->{aspect}) { 343 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h);
345
220 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 346 $w = List::Util::min $w, int $h * $self->{aspect};
221 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 347 $h = List::Util::min $h, int $w / $self->{aspect};
222 348
223 # use alignment to adjust x, y 349 # use alignment to adjust x, y
224 350
225 $x += int +($w - $w2) * 0.5; 351 $x += int 0.5 * ($ow - $w);
226 $y += int +($h - $h2) * 0.5; 352 $y += int 0.5 * ($oh - $h);
227
228 ($w, $h) = ($w2, $h2);
229 } 353 }
230 354
231 if ($self->{x} != $x || $self->{y} != $y) { 355 if ($self->{x} ne $x || $self->{y} ne $y) {
232 $self->{x} = $x; 356 $self->{x} = $x;
233 $self->{y} = $y; 357 $self->{y} = $y;
234 $self->update; 358 $self->update;
235 } 359 }
236 360
237 if ($self->{w} != $w || $self->{h} != $h) { 361 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
238 $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;
239 } 368 }
240} 369}
241 370
242sub size_allocate { 371sub size_allocate {
243 # nothing to be done 372 # nothing to be done
244} 373}
245 374
246sub children { 375sub children {
247} 376}
248 377
249# call when resolution changes etc.
250sub reconfigure {
251 my ($self) = @_;
252
253 $_->reconfigure
254 for $self->children;
255
256 $self->check_size;
257 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $self->{w}, $self->{h}];
258 $self->update;
259}
260
261sub set_max_size { 378sub set_max_size {
262 my ($self, $w, $h) = @_; 379 my ($self, $w, $h) = @_;
263 380
264 delete $self->{max_w}; $self->{max_w} = $w if $w; 381 delete $self->{max_w}; $self->{max_w} = $w if $w;
265 delete $self->{max_h}; $self->{max_h} = $h if $h; 382 delete $self->{max_h}; $self->{max_h} = $h if $h;
383}
384
385sub set_tooltip {
386 my ($self, $tooltip) = @_;
387
388 $tooltip =~ s/^\s+//;
389 $tooltip =~ s/\s+$//;
390
391 return if $self->{tooltip} eq $tooltip;
392
393 $self->{tooltip} = $tooltip;
394
395 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
396 delete $CFClient::UI::TOOLTIP->{owner};
397 CFClient::UI::check_tooltip;
398 }
266} 399}
267 400
268# translate global coordinates to local coordinate system 401# translate global coordinates to local coordinate system
269sub coord2local { 402sub coord2local {
270 my ($self, $x, $y) = @_; 403 my ($self, $x, $y) = @_;
… …
285 return if $FOCUS == $self; 418 return if $FOCUS == $self;
286 return unless $self->{can_focus}; 419 return unless $self->{can_focus};
287 420
288 my $focus = $FOCUS; $FOCUS = $self; 421 my $focus = $FOCUS; $FOCUS = $self;
289 422
290 $self->emit (focus_in => $focus); 423 $self->_emit (focus_in => $focus);
291 424
292 $focus->update if $focus; 425 $focus->update if $focus;
293 $FOCUS->update; 426 $FOCUS->update;
294} 427}
295 428
… …
298 431
299 return unless $FOCUS == $self; 432 return unless $FOCUS == $self;
300 433
301 my $focus = $FOCUS; undef $FOCUS; 434 my $focus = $FOCUS; undef $FOCUS;
302 435
303 $self->emit (focus_out => $focus); 436 $self->_emit (focus_out => $focus);
304 437
305 $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;
306} 442}
307 443
308sub mouse_motion { } 444sub mouse_motion { }
309sub button_up { } 445sub button_up { }
310sub key_down { } 446sub key_down { }
311sub key_up { } 447sub key_up { }
312 448
313sub button_down { 449sub button_down {
314 my ($self, $ev, $x, $y) = @_; 450 my ($self, $ev, $x, $y) = @_;
315 451
316 $self->focus_in; 452 $self->focus_in;
317} 453}
318 454
319sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 455sub find_widget {
320sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 456 my ($self, $x, $y) = @_;
321sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 457
322sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 458 return () unless $self->{can_events};
323sub 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
324 528
325sub draw { 529sub draw {
326 my ($self) = @_; 530 my ($self) = @_;
327 531
328 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;
329 541
330 glPushMatrix; 542 glPushMatrix;
331 glTranslate $self->{x}, $self->{y}, 0; 543 glTranslate $self->{x}, $self->{y}, 0;
332 $self->_draw; 544 $self->_draw;
333 glPopMatrix; 545 glPopMatrix;
… …
345 glVertex $x , $y + $self->{h}; 557 glVertex $x , $y + $self->{h};
346 glEnd; 558 glEnd;
347 glDisable GL_BLEND; 559 glDisable GL_BLEND;
348 } 560 }
349 561
350 if ($ENV{PCLIENT_DEBUG}) { 562 if ($ENV{CFPLUS_DEBUG} & 1) {
351 glPushMatrix; 563 glPushMatrix;
352 glColor 1, 1, 0, 1; 564 glColor 1, 1, 0, 1;
353 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 565 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
354 glBegin GL_LINE_LOOP; 566 glBegin GL_LINE_LOOP;
355 glVertex 0 , 0; 567 glVertex 0 , 0;
356 glVertex $self->{w}, 0; 568 glVertex $self->{w} - 1, 0;
357 glVertex $self->{w}, $self->{h}; 569 glVertex $self->{w} - 1, $self->{h} - 1;
358 glVertex 0 , $self->{h}; 570 glVertex 0 , $self->{h} - 1;
359 glEnd; 571 glEnd;
360 glPopMatrix; 572 glPopMatrix;
361 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;
362 } 574 }
363} 575}
364 576
365sub _draw { 577sub _draw {
366 my ($self) = @_; 578 my ($self) = @_;
367 579
368 warn "no draw defined for $self\n"; 580 warn "no draw defined for $self\n";
369} 581}
370 582
371sub find_widget {
372 my ($self, $x, $y) = @_;
373
374 return () unless $self->{can_events};
375
376 return $self
377 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
378 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
379
380 ()
381}
382
383sub set_parent {
384 my ($self, $parent) = @_;
385
386 Scalar::Util::weaken ($self->{parent} = $parent);
387
388 $self->check_size
389 unless exists $self->{req_w};
390}
391
392sub check_size {
393 my ($self) = @_;
394
395 $CFClient::UI::ROOT->{check_size}{$self} = $self;
396}
397
398sub update {
399 my ($self) = @_;
400
401 $self->{parent}->update
402 if $self->{parent};
403}
404
405sub connect {
406 my ($self, $signal, $cb) = @_;
407
408 push @{ $self->{signal_cb}{$signal} }, $cb;
409}
410
411sub emit {
412 my ($self, $signal, @args) = @_;
413
414 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
415}
416
417sub DESTROY { 583sub DESTROY {
418 my ($self) = @_; 584 my ($self) = @_;
419 585
586 delete $WIDGET{$self+0};
420 #$self->deactivate; 587 #$self->deactivate;
421} 588}
422 589
423############################################################################# 590#############################################################################
424 591
… …
433 my $class = shift; 600 my $class = shift;
434 601
435 # range [value, low, high, page] 602 # range [value, low, high, page]
436 603
437 $class->SUPER::new ( 604 $class->SUPER::new (
438 bg => [0, 0, 0, 0.2], 605 #bg => [0, 0, 0, 0.2],
439 active_bg => [1, 1, 1, 0.5], 606 #active_bg => [1, 1, 1, 0.5],
440 @_ 607 @_
441 ) 608 )
442} 609}
443 610
444sub _draw { 611sub _draw {
445 my ($self) = @_; 612 my ($self) = @_;
446 613
614 my $color = $FOCUS == $self && $self->{active_bg}
615 ? $self->{active_bg}
616 : $self->{bg};
617
618 if ($color && (@$color < 4 || $color->[3])) {
447 my ($w, $h) = @$self{qw(w h)}; 619 my ($w, $h) = @$self{qw(w h)};
448 620
449 glEnable GL_BLEND; 621 glEnable GL_BLEND;
450 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 622 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
451 glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} }; 623 glColor @$color;
452 624
453 glBegin GL_QUADS; 625 glBegin GL_QUADS;
454 glVertex 0 , 0; 626 glVertex 0 , 0;
455 glVertex 0 , $h; 627 glVertex 0 , $h;
456 glVertex $w, $h; 628 glVertex $w, $h;
457 glVertex $w, 0; 629 glVertex $w, 0;
458 glEnd; 630 glEnd;
459 631
460 glDisable GL_BLEND; 632 glDisable GL_BLEND;
633 }
461} 634}
462 635
463############################################################################# 636#############################################################################
464 637
465package CFClient::UI::Empty; 638package CFClient::UI::Empty;
… …
470 my ($class, %arg) = @_; 643 my ($class, %arg) = @_;
471 $class->SUPER::new (can_events => 0, %arg); 644 $class->SUPER::new (can_events => 0, %arg);
472} 645}
473 646
474sub size_request { 647sub size_request {
475 (0, 0) 648 my ($self) = @_;
649
650 ($self->{w} + 0, $self->{h} + 0)
476} 651}
477 652
478sub draw { } 653sub draw { }
479 654
480############################################################################# 655#############################################################################
… …
509 $self->{children} = [ 684 $self->{children} = [
510 sort { $a->{z} <=> $b->{z} } 685 sort { $a->{z} <=> $b->{z} }
511 @{$self->{children}}, @widgets 686 @{$self->{children}}, @widgets
512 ]; 687 ];
513 688
514 $self->check_size; 689 $self->realloc;
515 $self->update;
516} 690}
517 691
518sub children { 692sub children {
519 @{ $_[0]{children} } 693 @{ $_[0]{children} }
520} 694}
… …
525 delete $child->{parent}; 699 delete $child->{parent};
526 $child->hide; 700 $child->hide;
527 701
528 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 702 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
529 703
530 $self->check_size; 704 $self->realloc;
531 $self->update;
532} 705}
533 706
534sub clear { 707sub clear {
535 my ($self) = @_; 708 my ($self) = @_;
536 709
… …
540 for (@$children) { 713 for (@$children) {
541 delete $_->{parent}; 714 delete $_->{parent};
542 $_->hide; 715 $_->hide;
543 } 716 }
544 717
545 $self->check_size; 718 $self->realloc;
546 $self->update;
547} 719}
548 720
549sub find_widget { 721sub find_widget {
550 my ($self, $x, $y) = @_; 722 my ($self, $x, $y) = @_;
551 723
… …
626} 798}
627 799
628sub update { 800sub update {
629 my ($self) = @_; 801 my ($self) = @_;
630 802
631 $ROOT->on_refresh ($self => sub { $self->render_child }); 803 $ROOT->on_post_alloc ($self => sub { $self->render_child });
632 $self->SUPER::update; 804 $self->SUPER::update;
633} 805}
634 806
635sub size_allocate { 807sub size_allocate {
636 my ($self, $w, $h) = @_; 808 my ($self, $w, $h) = @_;
… …
638 $self->SUPER::size_allocate ($w, $h); 810 $self->SUPER::size_allocate ($w, $h);
639 $self->update; 811 $self->update;
640} 812}
641 813
642sub _render { 814sub _render {
815 my ($self) = @_;
816
643 $_[0]{children}[0]->draw; 817 $self->{children}[0]->draw;
644} 818}
645 819
646sub render_child { 820sub render_child {
647 my ($self) = @_; 821 my ($self) = @_;
648 822
649 $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 {
650 glClearColor 0, 0, 0, 0; 824 glClearColor 0, 0, 0, 0;
651 glClear GL_COLOR_BUFFER_BIT; 825 glClear GL_COLOR_BUFFER_BIT;
652 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
653 $self->_render; 834 $self->_render;
654# glColorMask 1, 1, 1, 0;
655# glEnable GL_BLEND;
656# glBlendFunc GL_SRC_ALPHA, GL_ZERO;
657# glRasterPos 0, 0;
658# glCopyPixels 0, 0, $self->{w}, $self->{h};
659# glDisable GL_BLEND;
660# glColorMask 1, 1, 1, 1;
661 }; 835 };
662} 836}
663 837
664sub _draw { 838sub _draw {
665 my ($self) = @_; 839 my ($self) = @_;
666 840
667 my ($w, $h) = ($self->w, $self->h); 841 my ($w, $h) = @$self{qw(w h)};
668 842
669 my $tex = $self->{texture} 843 my $tex = $self->{texture}
670 or return; 844 or return;
671 845
672 glEnable GL_TEXTURE_2D; 846 glEnable GL_TEXTURE_2D;
673 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 847 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
674 glColor 0, 0, 0, 1; 848 glColor 1, 1, 1, 1;
675 849
676 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h); 850 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
677 851
678 glDisable GL_TEXTURE_2D; 852 glDisable GL_TEXTURE_2D;
679} 853}
… …
682 856
683package CFClient::UI::ViewPort; 857package CFClient::UI::ViewPort;
684 858
685our @ISA = CFClient::UI::Window::; 859our @ISA = CFClient::UI::Window::;
686 860
861sub new {
862 my $class = shift;
863
864 $class->SUPER::new (
865 scroll_x => 0,
866 scroll_y => 1,
867 @_,
868 )
869}
870
687sub size_request { 871sub size_request {
688 my ($self) = @_; 872 my ($self) = @_;
689 873
690 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 874 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
691 $self->child->configure (0, 0, @$self{qw(child_w child_h)});
692 875
693 @$self{qw(child_w child_h)} 876 $w = 10 if $self->{scroll_x};
877 $h = 10 if $self->{scroll_y};
878
879 ($w, $h)
694} 880}
695 881
696sub size_allocate { 882sub size_allocate {
697 my ($self, $w, $h) = @_; 883 my ($self, $w, $h) = @_;
698 884
885 my $child = $self->child;
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
890 $self->child->configure (0, 0, $w, $h);
699 $self->update; 891 $self->update;
700} 892}
701 893
702sub set_offset { 894sub set_offset {
703 my ($self, $x, $y) = @_; 895 my ($self, $x, $y) = @_;
… …
737} 929}
738 930
739sub _render { 931sub _render {
740 my ($self) = @_; 932 my ($self) = @_;
741 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
742 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 937 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
743 938
744 $self->SUPER::_render; 939 $self->SUPER::_render;
745} 940}
746 941
… …
754 my $class = shift; 949 my $class = shift;
755 950
756 my $self; 951 my $self;
757 952
758 my $slider = new CFClient::UI::Slider 953 my $slider = new CFClient::UI::Slider
759 vertical => 1, 954 vertical => 1,
760 range => [0, 0, 1, 0.01], # HACK fix 955 range => [0, 0, 1, 0.01], # HACK fix
761 connect_changed => sub { 956 on_changed => sub {
762 $self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h})); 957 $self->{vp}->set_offset (0, $_[1]);
763 }, 958 },
764 ; 959 ;
765 960
766 $self = $class->SUPER::new ( 961 $self = $class->SUPER::new (
767 vp => (new CFClient::UI::ViewPort), 962 vp => (new CFClient::UI::ViewPort expand => 1),
768 slider => $slider, 963 slider => $slider,
769 @_, 964 @_,
770 ); 965 );
771 966
772 $self->{vp}->add ($self->{scrolled}); 967 $self->{vp}->add ($self->{scrolled});
… …
774 $self->add ($self->{slider}); 969 $self->add ($self->{slider});
775 970
776 $self 971 $self
777} 972}
778 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]);
991}
992
779#TODO# update range on size_allocate depeneing on child 993#TODO# update range on size_allocate depending on child
780# update viewport offset on scroll 994# update viewport offset on scroll
781 995
782############################################################################# 996#############################################################################
783 997
784package CFClient::UI::Frame; 998package CFClient::UI::Frame;
… …
788use CFClient::OpenGL; 1002use CFClient::OpenGL;
789 1003
790sub new { 1004sub new {
791 my $class = shift; 1005 my $class = shift;
792 1006
793 my $self = $class->SUPER::new ( 1007 $class->SUPER::new (
794 bg => [1, 1, 1, 1], 1008 bg => undef,
795 border_bg => [1, 1, 1, 1],
796 border => 0.8,
797 @_ 1009 @_,
798 ); 1010 )
799
800 $self
801} 1011}
802 1012
803sub _draw { 1013sub _draw {
804 my ($self) = @_; 1014 my ($self) = @_;
805 1015
806 my ($w, $h) = ($self->{w}, $self->{h}); 1016 if ($self->{bg}) {
1017 my ($w, $h) = @$self{qw(w h)};
807 1018
808 glEnable GL_BLEND; 1019 glEnable GL_BLEND;
809 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 1020 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
810 glEnable GL_TEXTURE_2D; 1021 glColor @{ $self->{bg} };
811 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
812 1022
813# glBegin GL_QUADS; 1023 glBegin GL_QUADS;
814# glColor 0, 0, 0, 0;
815# glVertex 0 , 0; 1024 glVertex 0 , 0;
816# glVertex 0 , $h; 1025 glVertex 0 , $h;
817# glVertex $w, $h; 1026 glVertex $w, $h;
818# glVertex $w, 0; 1027 glVertex $w, 0;
819# glEnd; 1028 glEnd;
820 1029
821
822 $self->child->draw;
823 glDisable GL_BLEND; 1030 glDisable GL_BLEND;
824 glDisable GL_TEXTURE_2D; 1031 }
1032
1033 $self->SUPER::_draw;
825} 1034}
826 1035
827############################################################################# 1036#############################################################################
828 1037
829package CFClient::UI::FancyFrame; 1038package CFClient::UI::FancyFrame;
830 1039
831our @ISA = CFClient::UI::Bin::; 1040our @ISA = CFClient::UI::Bin::;
832 1041
833use CFClient::OpenGL; 1042use CFClient::OpenGL;
834 1043
835my @tex = 1044my $bg =
1045 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1046 mipmap => 1, wrap => 1;
1047
1048my @border =
836 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1049 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
837 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);
838 1051
839sub new { 1052sub new {
840 my $class = shift; 1053 my $class = shift;
841 1054
842 # TODO: user_x, user_y, overwrite moveto?
843
844 my $self = $class->SUPER::new ( 1055 my $self = $class->SUPER::new (
845 bg => [1, 1, 1, 1], 1056 bg => [1, 1, 1, 1],
846 border_bg => [1, 1, 1, 1], 1057 border_bg => [1, 1, 1, 1],
847 border => 0.6, 1058 border => 0.6,
848 can_events => 1, 1059 can_events => 1,
1060 min_w => 16,
1061 min_h => 16,
849 @_ 1062 @_
850 ); 1063 );
851 1064
852 $self->{title} &&= new CFClient::UI::Label 1065 $self->{title} &&= new CFClient::UI::Label
853 align => 0, 1066 align => 0,
… …
877 my ($self, $w, $h) = @_; 1090 my ($self, $w, $h) = @_;
878 1091
879 $h -= List::Util::max 0, $self->border * 2; 1092 $h -= List::Util::max 0, $self->border * 2;
880 $w -= List::Util::max 0, $self->border * 2; 1093 $w -= List::Util::max 0, $self->border * 2;
881 1094
882 $self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2) 1095 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
883 if $self->{title}; 1096 if $self->{title};
884 1097
885 $self->child->configure ($self->border, $self->border, $w, $h); 1098 $self->child->configure ($self->border, $self->border, $w, $h);
886} 1099}
887 1100
… …
906 my ($ev, $x, $y) = @_; 1119 my ($ev, $x, $y) = @_;
907 1120
908 my $dx = $ev->{x} - $ox; 1121 my $dx = $ev->{x} - $ox;
909 my $dy = $ev->{y} - $oy; 1122 my $dy = $ev->{y} - $oy;
910 1123
911 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1124 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
912 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1125 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1126
1127 $self->realloc;
913 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1128 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
914 $self->check_size;
915 }; 1129 };
916 1130
917 } elsif ($lr ^ $td) { 1131 } elsif ($lr ^ $td) {
918 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1132 my ($ox, $oy) = ($ev->{x}, $ev->{y});
919 my ($bx, $by) = ($self->{x}, $self->{y}); 1133 my ($bx, $by) = ($self->{x}, $self->{y});
… …
921 $self->{motion} = sub { 1135 $self->{motion} = sub {
922 my ($ev, $x, $y) = @_; 1136 my ($ev, $x, $y) = @_;
923 1137
924 ($x, $y) = ($ev->{x}, $ev->{y}); 1138 ($x, $y) = ($ev->{x}, $ev->{y});
925 1139
926 $self->move ($bx + $x - $ox, $by + $y - $oy); 1140 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
927 $self->update;
928 }; 1141 };
929 } 1142 }
930} 1143}
931 1144
932sub button_up { 1145sub button_up {
… …
945 my ($self) = @_; 1158 my ($self) = @_;
946 1159
947 my ($w, $h ) = ($self->{w}, $self->{h}); 1160 my ($w, $h ) = ($self->{w}, $self->{h});
948 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 1161 my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
949 1162
950 glEnable GL_BLEND;
951 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
952 glEnable GL_TEXTURE_2D; 1163 glEnable GL_TEXTURE_2D;
953 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1164 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
954 1165
955 my $border = $self->border; 1166 my $border = $self->border;
956 1167
957 glColor @{ $self->{border_bg} }; 1168 glColor @{ $self->{border_bg} };
958 $tex[1]->draw_quad (0, 0, $w, $border); 1169 $border[0]->draw_quad_alpha (0, 0, $w, $border);
959 $tex[3]->draw_quad (0, $border, $border, $ch); 1170 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
960 $tex[2]->draw_quad ($w - $border, $border, $border, $ch); 1171 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
961 $tex[4]->draw_quad (0, $h - $border, $w, $border); 1172 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
962 1173
963 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1174 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
964 my $bg = $tex[0]; 1175 glColor @{ $self->{bg} };
965 1176
966 # TODO: repeat texture not scale 1177 # TODO: repeat texture not scale
1178 # solve this better(?)
967 my $rep_x = $cw / $bg->{w}; 1179 $bg->{s} = $cw / $bg->{w};
968 my $rep_y = $ch / $bg->{h}; 1180 $bg->{t} = $ch / $bg->{h};
969
970 glColor @{ $self->{bg} };
971
972 $bg->{s} = $rep_x;
973 $bg->{t} = $rep_y;
974 $bg->{wrap_mode} = 1;
975 $bg->draw_quad ($border, $border, $cw, $ch); 1181 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1182 }
976 1183
977 glDisable GL_TEXTURE_2D; 1184 glDisable GL_TEXTURE_2D;
978 glDisable GL_BLEND;
979 }
980 1185
981 $self->{title}->draw if $self->{title}; 1186 $self->{title}->draw if $self->{title};
982 1187
983 $self->child->draw; 1188 $self->child->draw;
984} 1189}
… …
996sub new { 1201sub new {
997 my $class = shift; 1202 my $class = shift;
998 1203
999 $class->SUPER::new ( 1204 $class->SUPER::new (
1000 col_expand => [], 1205 col_expand => [],
1001 @_ 1206 @_,
1002 ) 1207 )
1208}
1209
1210sub children {
1211 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1003} 1212}
1004 1213
1005sub add { 1214sub add {
1006 my ($self, $x, $y, $child) = @_; 1215 my ($self, $x, $y, $child) = @_;
1007 1216
1008 $child->set_parent ($self); 1217 $child->set_parent ($self);
1009 $self->{children}[$y][$x] = $child; 1218 $self->{children}[$y][$x] = $child;
1010 1219
1011 $child->check_size; 1220 $self->realloc;
1012} 1221}
1013 1222
1014sub children {
1015 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1016}
1017
1018# 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?
1019sub clear { 1224sub clear {
1020 my ($self) = @_; 1225 my ($self) = @_;
1021 1226
1022 my @children = $self->children; 1227 my @children = $self->children;
1023 delete $self->{children}; 1228 delete $self->{children};
… …
1025 for (@children) { 1230 for (@children) {
1026 delete $_->{parent}; 1231 delete $_->{parent};
1027 $_->hide; 1232 $_->hide;
1028 } 1233 }
1029 1234
1030 $self->update; 1235 $self->realloc;
1031} 1236}
1032 1237
1033sub get_wh { 1238sub get_wh {
1034 my ($self) = @_; 1239 my ($self) = @_;
1035 1240
… …
1066sub size_allocate { 1271sub size_allocate {
1067 my ($self, $w, $h) = @_; 1272 my ($self, $w, $h) = @_;
1068 1273
1069 my ($ws, $hs) = $self->get_wh; 1274 my ($ws, $hs) = $self->get_wh;
1070 1275
1071 my $req_w = sum @$ws; 1276 my $req_w = (sum @$ws) || 1;
1072 my $req_h = sum @$hs; 1277 my $req_h = (sum @$hs) || 1;
1073 1278
1074 # TODO: nicer code && do row_expand 1279 # TODO: nicer code && do row_expand
1075 my @col_expand = @{$self->{col_expand}}; 1280 my @col_expand = @{$self->{col_expand}};
1076 @col_expand = (1) x @$ws unless @col_expand; 1281 @col_expand = (1) x @$ws unless @col_expand;
1077 my $col_expand = (sum @col_expand) || 1; 1282 my $col_expand = (sum @col_expand) || 1;
… …
1131 } 1336 }
1132} 1337}
1133 1338
1134############################################################################# 1339#############################################################################
1135 1340
1136package CFClient::UI::HBox; 1341package CFClient::UI::Box;
1137
1138# TODO: wrap into common Box base class
1139 1342
1140our @ISA = CFClient::UI::Container::; 1343our @ISA = CFClient::UI::Container::;
1141 1344
1142sub size_request { 1345sub size_request {
1143 my ($self) = @_; 1346 my ($self) = @_;
1144 1347
1145 my @alloc = map [$_->size_request], @{$self->{children}}; 1348 $self->{vertical}
1146 1349 ? (
1147 ( 1350 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1148 (List::Util::sum map $_->[0], @alloc), 1351 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1149 (List::Util::max map $_->[1], @alloc), 1352 )
1150 ) 1353 : (
1354 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1355 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1356 )
1151} 1357}
1152 1358
1153sub size_allocate { 1359sub size_allocate {
1154 my ($self, $w, $h) = @_; 1360 my ($self, $w, $h) = @_;
1155 1361
1156 ($h, $w) = ($w, $h); 1362 my $space = $self->{vertical} ? $h : $w;
1157
1158 my $children = $self->{children}; 1363 my $children = $self->{children};
1159 1364
1160 my @h = map $_->{req_w}, @$children; 1365 my @req;
1161 1366
1162 my $req_h = List::Util::sum @h; 1367 if ($self->{homogeneous}) {
1163 1368 @req = ($space / (@$children || 1)) x @$children;
1164 if ($req_h > $h) {
1165 # ah well, not enough space
1166 $_ *= $h / $req_h for @h;
1167 } 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 {
1168 my $exp = List::Util::sum map $_->{expand}, @$children; 1377 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1169 $exp ||= 1;
1170 1378
1379 $space = ($space - $req) / $expand; # remaining space to give away
1380
1381 $req[$_] += $space * $children->[$_]{expand}
1171 for (0 .. $#$children) { 1382 for 0 .. $#$children;
1172 my $child = $children->[$_];
1173
1174 my $alloc_h = $h[$_];
1175 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1176 $h[$_] = $alloc_h;
1177 } 1383 }
1178 } 1384 }
1179 1385
1180 CFClient::UI::harmonize \@h; 1386 CFClient::UI::harmonize \@req;
1181 1387
1182 my $y = 0; 1388 my $pos = 0;
1183 for (0 .. $#$children) { 1389 for (0 .. $#$children) {
1184 my $child = $children->[$_];
1185 my $h = $h[$_]; 1390 my $alloc = $req[$_];
1186 $child->configure ($y, 0, $h, $w); 1391 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1187 1392
1188 $y += $h; 1393 $pos += $alloc;
1189 } 1394 }
1190 1395
1191 1 1396 1
1192} 1397}
1193 1398
1194############################################################################# 1399#############################################################################
1195 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
1196package CFClient::UI::VBox; 1416package CFClient::UI::VBox;
1197 1417
1198# TODO: wrap into common Box base class
1199
1200our @ISA = CFClient::UI::Container::; 1418our @ISA = CFClient::UI::Box::;
1201 1419
1202sub size_request { 1420sub new {
1203 my ($self) = @_; 1421 my $class = shift;
1204 1422
1205 my @alloc = map [$_->size_request], @{$self->{children}}; 1423 $class->SUPER::new (
1206 1424 vertical => 1,
1207 ( 1425 @_,
1208 (List::Util::max map $_->[0], @alloc),
1209 (List::Util::sum map $_->[1], @alloc),
1210 ) 1426 )
1211} 1427}
1212 1428
1213sub size_allocate {
1214 my ($self, $w, $h) = @_;
1215
1216 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1217
1218 my $children = $self->{children};
1219
1220 my @h = map $_->{req_h}, @$children;
1221
1222 my $req_h = List::Util::sum @h;
1223
1224 if ($req_h > $h) {
1225 # ah well, not enough space
1226 $_ *= $h / $req_h for @h;
1227 } else {
1228 my $exp = List::Util::sum map $_->{expand}, @$children;
1229 $exp ||= 1;
1230
1231 for (0 .. $#$children) {
1232 my $child = $children->[$_];
1233
1234 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1235 }
1236 }
1237
1238 CFClient::UI::harmonize \@h;
1239
1240 my $y = 0;
1241 for (0 .. $#$children) {
1242 my $child = $children->[$_];
1243 my $h = $h[$_];
1244 $child->configure (0, $y, $w, $h);
1245
1246 $y += $h;
1247 }
1248
1249 1
1250}
1251
1252############################################################################# 1429#############################################################################
1253 1430
1254package CFClient::UI::Label; 1431package CFClient::UI::Label;
1255 1432
1256our @ISA = CFClient::UI::Base::; 1433our @ISA = CFClient::UI::DrawBG::;
1257 1434
1258use CFClient::OpenGL; 1435use CFClient::OpenGL;
1259 1436
1260sub new { 1437sub new {
1261 my ($class, %arg) = @_; 1438 my ($class, %arg) = @_;
1262 1439
1263 my $self = $class->SUPER::new ( 1440 my $self = $class->SUPER::new (
1264 fg => [1, 1, 1], 1441 fg => [1, 1, 1],
1442 #bg => none
1443 #active_bg => none
1265 #font => default_font 1444 #font => default_font
1266 #text => initial text 1445 #text => initial text
1267 #markup => initial narkup 1446 #markup => initial narkup
1447 #max_w => maximum pixel width
1448 ellipsise => 3, # end
1268 layout => (new CFClient::Layout), 1449 layout => (new CFClient::Layout),
1269 fontsize => 1, 1450 fontsize => 1,
1270 align => -1, 1451 align => -1,
1271 valign => -1, 1452 valign => -1,
1272 padding => 2, 1453 padding_x => 2,
1454 padding_y => 2,
1273 can_events => 0, 1455 can_events => 0,
1274 %arg 1456 %arg
1275 ); 1457 );
1276 1458
1277 if (exists $self->{template}) { 1459 if (exists $self->{template}) {
… …
1287 } 1469 }
1288 1470
1289 $self 1471 $self
1290} 1472}
1291 1473
1292sub escape { 1474sub escape($) {
1293 local $_ = $_[1]; 1475 local $_ = $_[0];
1294 1476
1295 s/&/&amp;/g; 1477 s/&/&amp;/g;
1296 s/>/&gt;/g; 1478 s/>/&gt;/g;
1297 s/</&lt;/g; 1479 s/</&lt;/g;
1298 1480
1299 $_[1] 1481 $_
1300} 1482}
1301 1483
1302sub update { 1484sub update {
1303 my ($self) = @_; 1485 my ($self) = @_;
1304 1486
… …
1313 $self->{text} = "T$text"; 1495 $self->{text} = "T$text";
1314 1496
1315 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1497 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1316 $self->{layout}->set_text ($text); 1498 $self->{layout}->set_text ($text);
1317 1499
1500 $self->realloc;
1318 $self->update; 1501 $self->update;
1319 $self->check_size;
1320} 1502}
1321 1503
1322sub set_markup { 1504sub set_markup {
1323 my ($self, $markup) = @_; 1505 my ($self, $markup) = @_;
1324 1506
… …
1328 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1510 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1329 1511
1330 $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;
1331 $self->{layout}->set_markup ($markup); 1513 $self->{layout}->set_markup ($markup);
1332 1514
1515 $self->realloc;
1333 $self->update; 1516 $self->update;
1334 $self->check_size;
1335} 1517}
1336 1518
1337sub size_request { 1519sub size_request {
1338 my ($self) = @_; 1520 my ($self) = @_;
1339 1521
1340 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1522 $self->{layout}->set_font ($self->{font}) if $self->{font};
1341 $self->{layout}->set_width ($self->{max_w} || -1); 1523 $self->{layout}->set_width ($self->{max_w} || -1);
1524 $self->{layout}->set_ellipsise ($self->{ellipsise});
1525 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1342 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1526 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1343 1527
1344 my ($w, $h) = $self->{layout}->size; 1528 my ($w, $h) = $self->{layout}->size;
1345 1529
1346 if (exists $self->{template}) { 1530 if (exists $self->{template}) {
… …
1351 1535
1352 $w = List::Util::max $w, $w2; 1536 $w = List::Util::max $w, $w2;
1353 $h = List::Util::max $h, $h2; 1537 $h = List::Util::max $h, $h2;
1354 } 1538 }
1355 1539
1356 ( 1540 ($w, $h)
1357 $w + $self->{padding} * 2,
1358 $h + $self->{padding} * 2,
1359 )
1360} 1541}
1361 1542
1362sub size_allocate { 1543sub size_allocate {
1363 my ($self, $w, $h) = @_; 1544 my ($self, $w, $h) = @_;
1364 1545
1365 delete $self->{texture}; 1546 delete $self->{texture}
1547 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1366} 1548}
1367 1549
1368sub set_fontsize { 1550sub set_fontsize {
1369 my ($self, $fontsize) = @_; 1551 my ($self, $fontsize) = @_;
1370 1552
1371 $self->{fontsize} = $fontsize; 1553 $self->{fontsize} = $fontsize;
1372 delete $self->{texture}; 1554 delete $self->{texture};
1373 1555
1374 $self->update; 1556 $self->realloc;
1375 $self->check_size;
1376} 1557}
1377 1558
1378sub _draw { 1559sub _draw {
1379 my ($self) = @_; 1560 my ($self) = @_;
1561
1562 $self->SUPER::_draw; # draw background, if applicable
1380 1563
1381 my $tex = $self->{texture} ||= do { 1564 my $tex = $self->{texture} ||= do {
1382 $self->{layout}->set_foreground (@{$self->{fg}}); 1565 $self->{layout}->set_foreground (@{$self->{fg}});
1383 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1566 $self->{layout}->set_font ($self->{font}) if $self->{font};
1384 $self->{layout}->set_width ($self->{w}); 1567 $self->{layout}->set_width ($self->{w});
1568 $self->{layout}->set_ellipsise ($self->{ellipsise});
1569 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1385 $self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE); 1570 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1386 1571
1387 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1572 my $tex = new_from_layout CFClient::Texture $self->{layout};
1388 1573
1389 $self->{ox} = int $self->{align} < 0 ? $self->{padding} 1574 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1390 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1575 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1391 : ($self->{w} - $tex->{w}) * 0.5; 1576 : ($self->{w} - $tex->{w}) * 0.5);
1392 1577
1393 $self->{oy} = int $self->{valign} < 0 ? $self->{padding} 1578 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1394 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1579 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1395 : ($self->{h} - $tex->{h}) * 0.5; 1580 : ($self->{h} - $tex->{h}) * 0.5);
1396 1581
1397 $tex 1582 $tex
1398 }; 1583 };
1399 1584
1400 glEnable GL_TEXTURE_2D; 1585 glEnable GL_TEXTURE_2D;
… …
1428 active_fg => [0, 0, 0], 1613 active_fg => [0, 0, 0],
1429 can_hover => 1, 1614 can_hover => 1,
1430 can_focus => 1, 1615 can_focus => 1,
1431 valign => 0, 1616 valign => 0,
1432 can_events => 1, 1617 can_events => 1,
1618 #text => ...
1433 @_ 1619 @_
1434 ) 1620 )
1435} 1621}
1436 1622
1437sub _set_text { 1623sub _set_text {
… …
1447 $self->{text} = $text; 1633 $self->{text} = $text;
1448 1634
1449 $text =~ s/./*/g if $self->{hidden}; 1635 $text =~ s/./*/g if $self->{hidden};
1450 $self->{layout}->set_text ("$text "); 1636 $self->{layout}->set_text ("$text ");
1451 1637
1452 $self->emit (changed => $self->{text}); 1638 $self->_emit (changed => $self->{text});
1453} 1639}
1454 1640
1455sub set_text { 1641sub set_text {
1456 my ($self, $text) = @_; 1642 my ($self, $text) = @_;
1457 1643
1458 $self->{cursor} = length $text; 1644 $self->{cursor} = length $text;
1459 $self->_set_text ($text); 1645 $self->_set_text ($text);
1460 $self->check_size; 1646
1461 $self->update; 1647 $self->realloc;
1462} 1648}
1463 1649
1464sub get_text { 1650sub get_text {
1465 $_[0]{text} 1651 $_[0]{text}
1466} 1652}
… …
1469 my ($self) = @_; 1655 my ($self) = @_;
1470 1656
1471 my ($w, $h) = $self->SUPER::size_request; 1657 my ($w, $h) = $self->SUPER::size_request;
1472 1658
1473 ($w + 1, $h) # add 1 for cursor 1659 ($w + 1, $h) # add 1 for cursor
1474}
1475
1476sub size_allocate {
1477 my ($self, $w, $h) = @_;
1478
1479 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1480} 1660}
1481 1661
1482sub key_down { 1662sub key_down {
1483 my ($self, $ev) = @_; 1663 my ($self, $ev) = @_;
1484 1664
… …
1486 my $sym = $ev->{sym}; 1666 my $sym = $ev->{sym};
1487 my $uni = $ev->{unicode}; 1667 my $uni = $ev->{unicode};
1488 1668
1489 my $text = $self->get_text; 1669 my $text = $self->get_text;
1490 1670
1491 if ($sym == 8) { 1671 if ($uni == 8) {
1492 substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; 1672 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1493 } elsif ($sym == 127) { 1673 } elsif ($uni == 127) {
1494 substr $text, $self->{cursor}, 1, ""; 1674 substr $text, $self->{cursor}, 1, "";
1495 } elsif ($sym == CFClient::SDLK_LEFT) { 1675 } elsif ($sym == CFClient::SDLK_LEFT) {
1496 --$self->{cursor} if $self->{cursor}; 1676 --$self->{cursor} if $self->{cursor};
1497 } elsif ($sym == CFClient::SDLK_RIGHT) { 1677 } elsif ($sym == CFClient::SDLK_RIGHT) {
1498 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 1678 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1499 } elsif ($sym == CFClient::SDLK_HOME) { 1679 } elsif ($sym == CFClient::SDLK_HOME) {
1500 $self->{cursor} = 0; 1680 $self->{cursor} = 0;
1501 } elsif ($sym == CFClient::SDLK_END) { 1681 } elsif ($sym == CFClient::SDLK_END) {
1502 $self->{cursor} = length $text; 1682 $self->{cursor} = length $text;
1503 } elsif ($sym == 27) { 1683 } elsif ($uni == 27) {
1504 $self->emit ('escape'); 1684 $self->_emit ('escape');
1505 } elsif ($uni) { 1685 } elsif ($uni) {
1506 substr $text, $self->{cursor}++, 0, chr $uni; 1686 substr $text, $self->{cursor}++, 0, chr $uni;
1507 } 1687 }
1508 1688
1509 $self->_set_text ($text); 1689 $self->_set_text ($text);
1510 $self->update; 1690
1691 $self->realloc;
1511} 1692}
1512 1693
1513sub focus_in { 1694sub focus_in {
1514 my ($self) = @_; 1695 my ($self) = @_;
1515 1696
… …
1595 if ($sym == 13) { 1776 if ($sym == 13) {
1596 unshift @{$self->{history}}, 1777 unshift @{$self->{history}},
1597 my $txt = $self->get_text; 1778 my $txt = $self->get_text;
1598 $self->{history_pointer} = -1; 1779 $self->{history_pointer} = -1;
1599 $self->{history_saveback} = ''; 1780 $self->{history_saveback} = '';
1600 $self->emit (activate => $txt); 1781 $self->_emit (activate => $txt);
1601 $self->update; 1782 $self->update;
1602 1783
1603 } elsif ($sym == CFClient::SDLK_UP) { 1784 } elsif ($sym == CFClient::SDLK_UP) {
1604 if ($self->{history_pointer} < 0) { 1785 if ($self->{history_pointer} < 0) {
1605 $self->{history_saveback} = $self->get_text; 1786 $self->{history_saveback} = $self->get_text;
… …
1642 1823
1643sub new { 1824sub new {
1644 my $class = shift; 1825 my $class = shift;
1645 1826
1646 $class->SUPER::new ( 1827 $class->SUPER::new (
1647 padding => 4, 1828 padding_x => 4,
1829 padding_y => 4,
1648 fg => [1, 1, 1], 1830 fg => [1, 1, 1],
1649 bg => [1, 1, 1, 0.2],
1650 active_fg => [0, 0, 1], 1831 active_fg => [0, 0, 1],
1651 can_hover => 1, 1832 can_hover => 1,
1652 align => 0, 1833 align => 0,
1653 valign => 0, 1834 valign => 0,
1654 can_events => 1, 1835 can_events => 1,
1655 @_ 1836 @_
1656 ) 1837 )
1657} 1838}
1658 1839
1840sub activate { }
1841
1659sub button_up { 1842sub button_up {
1660 my ($self, $ev, $x, $y) = @_; 1843 my ($self, $ev, $x, $y) = @_;
1661 1844
1845 $self->emit ("activate")
1662 if ($x >= 0 && $x < $self->{w} 1846 if $x >= 0 && $x < $self->{w}
1663 && $y >= 0 && $y < $self->{h}) { 1847 && $y >= 0 && $y < $self->{h};
1664 $self->emit ("activate");
1665 }
1666} 1848}
1667 1849
1668sub _draw { 1850sub _draw {
1669 my ($self) = @_; 1851 my ($self) = @_;
1670 1852
… …
1699 1881
1700sub new { 1882sub new {
1701 my $class = shift; 1883 my $class = shift;
1702 1884
1703 $class->SUPER::new ( 1885 $class->SUPER::new (
1704 padding => 2, 1886 padding_x => 2,
1887 padding_y => 2,
1705 fg => [1, 1, 1], 1888 fg => [1, 1, 1],
1706 active_fg => [1, 1, 0], 1889 active_fg => [1, 1, 0],
1890 bg => [0, 0, 0, 0.2],
1891 active_bg => [1, 1, 1, 0.5],
1707 state => 0, 1892 state => 0,
1708 can_hover => 1, 1893 can_hover => 1,
1709 @_ 1894 @_
1710 ) 1895 )
1711} 1896}
1712 1897
1713sub size_request { 1898sub size_request {
1714 my ($self) = @_; 1899 my ($self) = @_;
1715 1900
1716 ($self->{padding} * 2 + 6) x 2 1901 (6) x 2
1717} 1902}
1718 1903
1719sub button_down { 1904sub button_down {
1720 my ($self, $ev, $x, $y) = @_; 1905 my ($self, $ev, $x, $y) = @_;
1721 1906
1722 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1907 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1723 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1908 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1724 $self->{state} = !$self->{state}; 1909 $self->{state} = !$self->{state};
1725 $self->emit (changed => $self->{state}); 1910 $self->_emit (changed => $self->{state});
1726 } 1911 }
1727} 1912}
1728 1913
1729sub _draw { 1914sub _draw {
1730 my ($self) = @_; 1915 my ($self) = @_;
1731 1916
1732 $self->SUPER::_draw; 1917 $self->SUPER::_draw;
1733 1918
1734 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1919 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1735 1920
1736 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;
1737 1924
1738 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1925 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1739 1926
1927 my $tex = $self->{state} ? $tex[1] : $tex[0];
1928
1740 glEnable GL_TEXTURE_2D; 1929 glEnable GL_TEXTURE_2D;
1741
1742 my $tex = $self->{state} ? $tex[1] : $tex[0];
1743
1744 $tex->draw_quad_alpha (0, 0, $s, $s); 1930 $tex->draw_quad_alpha (0, 0, $s, $s);
1745
1746 glDisable GL_TEXTURE_2D; 1931 glDisable GL_TEXTURE_2D;
1747} 1932}
1748 1933
1749############################################################################# 1934#############################################################################
1750 1935
… …
1997 qw(s1_slider.png s1_slider_bg.png); 2182 qw(s1_slider.png s1_slider_bg.png);
1998 2183
1999sub new { 2184sub new {
2000 my $class = shift; 2185 my $class = shift;
2001 2186
2002 # range [value, low, high, page] 2187 # range [value, low, high, page, unit]
2003 2188
2004 # TODO: 0-width page 2189 # TODO: 0-width page
2005 # TODO: req_w/h are wrong with vertical 2190 # TODO: req_w/h are wrong with vertical
2006 # TODO: calculations are off 2191 # TODO: calculations are off
2007 my $self = $class->SUPER::new ( 2192 my $self = $class->SUPER::new (
2008 fg => [1, 1, 1], 2193 fg => [1, 1, 1],
2009 active_fg => [0, 0, 0], 2194 active_fg => [0, 0, 0],
2195 bg => [0, 0, 0, 0.2],
2196 active_bg => [1, 1, 1, 0.5],
2010 range => [0, 0, 100, 10], 2197 range => [0, 0, 100, 10, 0],
2011 req_w => $::WIDTH / 80, 2198 min_w => $::WIDTH / 80,
2012 req_h => $::WIDTH / 80, 2199 min_h => $::WIDTH / 80,
2013 vertical => 0, 2200 vertical => 0,
2014 can_hover => 1, 2201 can_hover => 1,
2015 inner_pad => 5, 2202 inner_pad => 0.02,
2016 @_ 2203 @_
2017 ); 2204 );
2018 2205
2206 $self->set_value ($self->{range}[0]);
2207 $self->update;
2208
2019 $self 2209 $self
2020} 2210}
2021 2211
2212sub changed { }
2213
2214sub set_range {
2215 my ($self, $range) = @_;
2216
2217 ($range, $self->{range}) = ($self->{range}, $range);
2218
2219 $self->update
2220 if "@$range" ne "@{$self->{range}}";
2221}
2222
2223sub set_value {
2224 my ($self, $value) = @_;
2225
2226 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2227
2228 $hi = $lo + 1 if $hi <= $lo;
2229
2230 $page = $hi - $lo if $page > $hi - $lo;
2231
2232 $value = $lo if $value < $lo;
2233 $value = $hi - $page if $value > $hi - $page;
2234
2235 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2236 if $unit;
2237
2238 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2239
2240 if ($value != $old_value) {
2241 $self->_emit (changed => $value);
2242 $self->update;
2243 }
2244}
2245
2022sub size_request { 2246sub size_request {
2023 my ($self) = @_; 2247 my ($self) = @_;
2024 2248
2025 my $w = $self->{req_w}; 2249 ($self->{req_w}, $self->{req_h})
2026 my $h = $self->{req_h};
2027
2028 $self->{vertical} ? ($h, $w) : ($w, $h)
2029} 2250}
2030 2251
2031sub button_down { 2252sub button_down {
2032 my ($self, $ev, $x, $y) = @_; 2253 my ($self, $ev, $x, $y) = @_;
2033 2254
2034 $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
2035 $self->mouse_motion ($ev, $x, $y); 2259 $self->mouse_motion ($ev, $x, $y);
2036} 2260}
2037 2261
2038sub mouse_motion { 2262sub mouse_motion {
2039 my ($self, $ev, $x, $y) = @_; 2263 my ($self, $ev, $x, $y) = @_;
2040 2264
2041 if ($GRAB == $self) { 2265 if ($GRAB == $self) {
2266 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2267
2268 my (undef, $lo, $hi, $page) = @{$self->{range}};
2269
2270 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2271
2272 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2273 }
2274}
2275
2276sub update {
2277 my ($self) = @_;
2278
2279 $CFClient::UI::ROOT->on_post_alloc ($self => sub {
2280 $self->set_value ($self->{range}[0]);
2281
2042 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2282 my ($value, $lo, $hi, $page) = @{$self->{range}};
2283 my $range = ($hi - $page - $lo) || 1e-100;
2043 2284
2044 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2285 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2045 2286
2046 my $inner_pad_px = $self->_calc_inner_pad_px ($w); 2287 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2047 my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right 2288 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2048 2289
2049 $x -= $inner_pad_px; # substract the padding 2290 $value = ($value - $lo) / $range;
2050 $x = $x * ($hi - $lo) / $inner_w + $lo; 2291 $value = $value * $self->{scale} + $self->{offset};
2051 $x = $lo if $x < $lo;
2052 $x = $hi - $page if $x > $hi - $page;
2053 $self->{range}[0] = $x;
2054 2292
2055 $self->emit (changed => $x); 2293 $self->{knob_x} = $value - $knob_w * 0.5;
2056 $self->update; 2294 $self->{knob_w} = $knob_w;
2057 } 2295 });
2058}
2059 2296
2060# the inner_* stuff is for generating a padding for the slider handle, 2297 $self->SUPER::update;
2061# so that the handle doesn't leave the texture. This calculation isn't 100%
2062# correct propably, but it does the job for now
2063sub _calc_inner_pad_px {
2064 my ($self, $w) = @_;
2065 ($w / 100) * $self->{inner_pad} # % to pixels
2066} 2298}
2067 2299
2068sub _draw { 2300sub _draw {
2069 my ($self) = @_; 2301 my ($self) = @_;
2070 2302
2071 $self->SUPER::_draw (); 2303 $self->SUPER::_draw ();
2072 2304
2073 my ($w, $h) = @$self{qw(w h)}; 2305 glScale $self->{w}, $self->{h};
2074 2306
2075 if ($self->{vertical}) { 2307 if ($self->{vertical}) {
2076 # draw a vertical slider like a rotated horizontal slider 2308 # draw a vertical slider like a rotated horizontal slider
2077 2309
2310 glTranslate 1, 0, 0;
2078 glRotate 90, 0, 0, 1; 2311 glRotate 90, 0, 0, 1;
2079 glTranslate 0, -$self->{w}, 0;
2080
2081 ($w, $h) = ($h, $w);
2082 } 2312 }
2083 2313
2084 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg}; 2314 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2085 my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg}; 2315 my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2086 2316
2087 my ($value, $lo, $hi, $page) = @{$self->{range}};
2088
2089 $hi = $value + 1 if $lo == $hi;
2090
2091 my $inner_pad_px = $self->_calc_inner_pad_px ($w);
2092 my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
2093
2094 $page = int $page * $inner_w / ($hi - $lo);
2095 $value = int +($value - $lo) * $inner_w / ($hi - $lo);
2096
2097 $w -= $page;
2098 $page &= ~1;
2099 glTranslate $page * 0.5, 0, 0;
2100 $page ||= 2;
2101
2102 my $knob_a = $inner_pad_px + ($value - $page * 0.5);
2103 my $knob_b = $inner_pad_px + ($value + $page * 0.5);
2104
2105 glEnable GL_TEXTURE_2D; 2317 glEnable GL_TEXTURE_2D;
2106 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2318 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2107 2319
2108 # draw background 2320 # draw background
2109 $tex[1]->draw_quad_alpha (0, 0, $w, $h); 2321 $tex[1]->draw_quad_alpha (0, 0, 1, 1);
2110 2322
2111 # draw handle 2323 # draw handle
2112 $tex[0]->draw_quad_alpha ($knob_a, 0, $knob_b - $knob_a, $h); 2324 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2113 2325
2114 glDisable GL_TEXTURE_2D; 2326 glDisable GL_TEXTURE_2D;
2115} 2327}
2328
2329#############################################################################
2330
2331package CFClient::UI::ValSlider;
2332
2333our @ISA = CFClient::UI::HBox::;
2334
2335sub new {
2336 my ($class, %arg) = @_;
2337
2338 my $range = delete $arg{range};
2339
2340 my $self = $class->SUPER::new (
2341 slider => (new CFClient::UI::Slider expand => 1, range => $range),
2342 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
2343 to_value => sub { shift },
2344 from_value => sub { shift },
2345 %arg,
2346 );
2347
2348 $self->{slider}->connect (changed => sub {
2349 my ($self, $value) = @_;
2350 $self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
2351 $self->{parent}->emit (changed => $value);
2352 });
2353
2354# $self->{entry}->connect (changed => sub {
2355# my ($self, $value) = @_;
2356# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
2357# $self->{parent}->emit (changed => $value);
2358# });
2359
2360 $self->add ($self->{slider}, $self->{entry});
2361
2362 $self->{slider}->emit (changed => $self->{slider}{range}[0]);
2363
2364 $self
2365}
2366
2367sub set_range { shift->{slider}->set_range (@_) }
2368sub set_value { shift->{slider}->set_value (@_) }
2116 2369
2117############################################################################# 2370#############################################################################
2118 2371
2119package CFClient::UI::TextView; 2372package CFClient::UI::TextView;
2120 2373
… …
2150 2403
2151 $self->{fontsize} = $fontsize; 2404 $self->{fontsize} = $fontsize;
2152 $self->reflow; 2405 $self->reflow;
2153} 2406}
2154 2407
2155sub text_height {
2156 my ($self, $text) = @_;
2157
2158 my $layout = $self->{layout};
2159
2160 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2161 $layout->set_width ($self->{children}[0]{w});
2162 $layout->set_markup ($text);
2163
2164 ($layout->size)[1]
2165}
2166
2167sub reflow {
2168 my ($self) = @_;
2169
2170 $self->{need_reflow}++;
2171 $self->update;
2172}
2173
2174sub size_allocate { 2408sub size_allocate {
2175 my ($self, $w, $h) = @_; 2409 my ($self, $w, $h) = @_;
2176 2410
2177 $self->SUPER::size_allocate ($w, $h); 2411 $self->SUPER::size_allocate ($w, $h);
2178 2412
… …
2181 $self->{layout}->set_width ($self->{children}[0]{w}); 2415 $self->{layout}->set_width ($self->{children}[0]{w});
2182 2416
2183 $self->reflow; 2417 $self->reflow;
2184} 2418}
2185 2419
2420sub text_size {
2421 my ($self, $text, $indent) = @_;
2422
2423 my $layout = $self->{layout};
2424
2425 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2426 $layout->set_width ($self->{children}[0]{w} - $indent);
2427 $layout->set_markup ($text);
2428
2429 $layout->size
2430}
2431
2432sub reflow {
2433 my ($self) = @_;
2434
2435 $self->{need_reflow}++;
2436 $self->update;
2437}
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
2446sub clear {
2447 my ($self) = @_;
2448
2449 $self->{par} = [];
2450 $self->{height} = 0;
2451 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2452}
2453
2186sub add_paragraph { 2454sub add_paragraph {
2187 my ($self, $color, $text) = @_; 2455 my ($self, $color, $text, $indent) = @_;
2188 2456
2189 #TODO: intelligently "reformat" paragraph 2457 for my $line (split /\n/, $text) {
2190 2458 my ($w, $h) = $self->text_size ($line);
2191 my $height = $self->text_height ($text);
2192
2193 $self->{height} += $height; 2459 $self->{height} += $h;
2460 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2461 }
2194 2462
2195 push @{$self->{par}}, [$height, $color, $text];
2196
2197 $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]);
2198 $self->{children}[1]->update;
2199} 2464}
2200 2465
2201sub update { 2466sub update {
2202 my ($self) = @_; 2467 my ($self) = @_;
2203 2468
… …
2205 2470
2206 return unless $self->{h} > 0; 2471 return unless $self->{h} > 0;
2207 2472
2208 delete $self->{texture}; 2473 delete $self->{texture};
2209 2474
2210 $ROOT->on_refresh ($self, sub { 2475 $ROOT->on_post_alloc ($self, sub {
2476 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2477
2211 if (delete $self->{need_reflow}) { 2478 if (delete $self->{need_reflow}) {
2212 my $height = 0; 2479 my $height = 0;
2213 2480
2214 $height += $_->[0] = $self->text_height ($_->[2]) 2481 my $layout = $self->{layout};
2482
2483 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2484
2215 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 }
2216 2496
2217 $self->{height} = $height; 2497 $self->{height} = $height;
2218 2498
2219 $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}]; 2499 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2220 2500
2221 delete $self->{texture}; 2501 delete $self->{texture};
2222 } 2502 }
2223 2503
2224 $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 {
2225 glClearColor 0, 0, 0, 0; 2505 glClearColor 0.5, 0.5, 0.5, 0;
2226 glClear GL_COLOR_BUFFER_BIT; 2506 glClear GL_COLOR_BUFFER_BIT;
2227 2507
2228 glEnable GL_TEXTURE_2D;
2229 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2230
2231 my $top = int $self->{children}[1]{range}[0]; 2508 my $top = int $self->{children}[1]{range}[0];
2232 2509
2233 my $y0 = $top; 2510 my $y0 = $top;
2234 my $y1 = $top + $self->{h}; 2511 my $y1 = $top + $H;
2235 2512
2236 my $y = 0; 2513 my $y = 0;
2237 2514
2238 my $layout = $self->{layout}; 2515 my $layout = $self->{layout};
2239 2516
2240 $layout->set_font ($self->{font}) if $self->{font}; 2517 $layout->set_font ($self->{font}) if $self->{font};
2241 2518
2519 glEnable GL_BLEND;
2520 #TODO# not correct in windows where rgba is forced off
2521 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2522
2242 for my $par (@{$self->{par}}) { 2523 for my $par (@{$self->{par}}) {
2243 my $h = $par->[0]; 2524 my $h = $par->[1];
2244 2525
2245 if ($y0 < $y + $h && $y < $y1) { 2526 if ($y0 < $y + $h && $y < $y1) {
2246 $layout->set_foreground (@{ $par->[1] }); 2527 $layout->set_foreground (@{ $par->[2] });
2528 $layout->set_width ($W - $par->[3]);
2247 $layout->set_markup ($par->[2]); 2529 $layout->set_markup ($par->[4]);
2248 2530
2249 my ($W, $H) = $layout->size; 2531 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2250 CFClient::Texture->new_from_layout ($layout)->draw_quad_alpha_premultiplied (0, $y - $y0); 2532
2533 glRasterPos $par->[3], $y - $y0;
2534 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2251 } 2535 }
2252 2536
2253 $y += $h; 2537 $y += $h;
2254 } 2538 }
2255 2539
2256 glDisable GL_TEXTURE_2D; 2540 glDisable GL_BLEND;
2257 }; 2541 };
2258 }); 2542 });
2259} 2543}
2260 2544
2261sub _draw { 2545sub _draw {
2262 my ($self) = @_; 2546 my ($self) = @_;
2263 2547
2264 glEnable GL_TEXTURE_2D; 2548 glEnable GL_TEXTURE_2D;
2265 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2549 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2266 glColor 1, 1, 1, 1; 2550 glColor 1, 1, 1, 1;
2267 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2551 $self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2268 glDisable GL_TEXTURE_2D; 2552 glDisable GL_TEXTURE_2D;
2269 2553
2270 $self->{children}[1]->draw; 2554 $self->{children}[1]->draw;
2271 2555
2272} 2556}
… …
2321 2605
2322sub new { 2606sub new {
2323 my $class = shift; 2607 my $class = shift;
2324 2608
2325 my $self = $class->SUPER::new ( 2609 my $self = $class->SUPER::new (
2326 state => 0, 2610 state => 0,
2327 connect_activate => \&toggle_flopper, 2611 on_activate => \&toggle_flopper,
2328 @_ 2612 @_
2329 ); 2613 );
2330 2614
2331 if ($self->{state}) {
2332 $self->{state} = 0;
2333 $self->toggle_flopper;
2334 }
2335
2336 $self 2615 $self
2337} 2616}
2338 2617
2339sub toggle_flopper { 2618sub toggle_flopper {
2340 my ($self) = @_; 2619 my ($self) = @_;
2341 2620
2342 # TODO: use animation 2621 $self->{other}->toggle_visibility;
2343 if ($self->{state} = !$self->{state}) {
2344 $CFClient::UI::ROOT->add ($self->{other});
2345 $self->{other}->move ($self->coord2global (0, $self->{h}));
2346 $self->emit ("open");
2347 } else {
2348 $CFClient::UI::ROOT->remove ($self->{other});
2349 $self->emit ("close");
2350 }
2351
2352 $self->emit (changed => $self->{state});
2353} 2622}
2354 2623
2355############################################################################# 2624#############################################################################
2356 2625
2357package CFClient::UI::Tooltip; 2626package CFClient::UI::Tooltip;
… …
2367 @_, 2636 @_,
2368 can_events => 0, 2637 can_events => 0,
2369 ) 2638 )
2370} 2639}
2371 2640
2372sub set_markup { 2641sub set_tooltip_from {
2373 my ($self, $text, $font) = @_; 2642 my ($self, $widget) = @_;
2374 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
2375 $self->{label} = new CFClient::UI::Label 2653 $self->add (new CFClient::UI::Label
2654 markup => $tooltip,
2655 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2376 fontsize => 0.8, 2656 fontsize => 0.8,
2377 fg => [0, 0, 0], 2657 fg => [0, 0, 0, 1],
2658 ellipsise => 0,
2378 font => ($font || $::FONT_PROP); 2659 font => ($widget->{tooltip_font} || $::FONT_PROP),
2379 2660 );
2380 $self->{label}->set_max_size ($::WIDTH * 0.3);
2381 $self->{label}->set_markup ($text);
2382 $self->add ($self->{label});
2383} 2661}
2384 2662
2385sub size_request { 2663sub size_request {
2386 my ($self) = @_; 2664 my ($self) = @_;
2387 2665
… …
2394 my ($self, $w, $h) = @_; 2672 my ($self, $w, $h) = @_;
2395 2673
2396 $self->SUPER::size_allocate ($w - 4, $h - 4); 2674 $self->SUPER::size_allocate ($w - 4, $h - 4);
2397} 2675}
2398 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 });
2693}
2694
2399sub _draw { 2695sub _draw {
2400 my ($self) = @_; 2696 my ($self) = @_;
2401 2697
2402 glPushMatrix;
2403 glTranslate 0.375, 0.375; 2698 glTranslate 0.375, 0.375;
2404 2699
2405 my ($w, $h) = @$self{qw(w h)}; 2700 my ($w, $h) = @$self{qw(w h)};
2406 2701
2407 glColor 1, 0.8, 0.4; 2702 glColor 1, 0.8, 0.4;
… …
2418 glVertex 0 , $h; 2713 glVertex 0 , $h;
2419 glVertex $w, $h; 2714 glVertex $w, $h;
2420 glVertex $w, 0; 2715 glVertex $w, 0;
2421 glEnd; 2716 glEnd;
2422 2717
2423 glPopMatrix; 2718 glTranslate 2 - 0.375, 2 - 0.375;
2424 2719
2425 glTranslate 2, 2;
2426 $self->SUPER::_draw; 2720 $self->SUPER::_draw;
2427} 2721}
2428 2722
2429############################################################################# 2723#############################################################################
2430 2724
… …
2435use CFClient::OpenGL; 2729use CFClient::OpenGL;
2436 2730
2437sub new { 2731sub new {
2438 my $class = shift; 2732 my $class = shift;
2439 2733
2440 $class->SUPER::new ( 2734 my $self = $class->SUPER::new (
2441 aspect => 1, 2735 aspect => 1,
2736 can_events => 0,
2442 @_, 2737 @_,
2443 ) 2738 );
2739
2740 if ($self->{anim} && $self->{animspeed}) {
2741 Scalar::Util::weaken (my $widget = $self);
2742
2743 $self->{timer} = Event->timer (
2744 at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2745 hard => 1,
2746 interval => $self->{animspeed},
2747 cb => sub {
2748 ++$widget->{frame};
2749 $widget->update;
2750 },
2751 );
2752 }
2753
2754 $self
2444} 2755}
2445 2756
2446sub size_request { 2757sub size_request {
2447 (32, 8) 2758 (32, 8)
2448} 2759}
2449 2760
2761sub update {
2762 my ($self) = @_;
2763
2764 return unless $self->{visible};
2765
2766 $self->SUPER::update;
2767}
2768
2450sub _draw { 2769sub _draw {
2451 my ($self) = @_; 2770 my ($self) = @_;
2452 2771
2453 return unless $::CONN;#d# manage and cache textures differently 2772 return unless $::CONN;
2773
2774 my $face;
2775
2776 if ($self->{frame}) {
2777 my $anim = $::CONN->{anim}[$self->{anim}];
2778
2779 $face = $anim->[ $self->{frame} % @$anim ]
2780 if $anim && @$anim;
2781 }
2782
2454 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]]; 2783 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2455 2784
2456 # TODO animation
2457 if ($tex) { 2785 if ($tex) {
2458 glEnable GL_TEXTURE_2D; 2786 glEnable GL_TEXTURE_2D;
2459 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2787 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2460 glColor 1, 1, 1, 1; 2788 glColor 1, 1, 1, 1;
2461 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 2789 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2462 glDisable GL_TEXTURE_2D; 2790 glDisable GL_TEXTURE_2D;
2463 } 2791 }
2464} 2792}
2465 2793
2466############################################################################# 2794sub DESTROY {
2467
2468package CFClient::UI::InventoryItem;
2469
2470our @ISA = CFClient::UI::HBox::;
2471
2472sub new {
2473 my $class = shift;
2474
2475 my %args = @_;
2476
2477 my $item = delete $args{item};
2478
2479 my $desc = $item->{nrof} < 2
2480 ? $item->{name}
2481 : "$item->{nrof} $item->{name_pl}";
2482
2483
2484 my $self = $class->SUPER::new (
2485 can_hover => 1,
2486 can_events => 1,
2487 tooltip => (CFClient::UI::Label->escape ($desc)
2488 . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
2489 connect_button_down => sub {
2490 my ($self, $ev, $x, $y) = @_;
2491
2492 # todo: maybe put examine on 1? but should just be a tooltip :(
2493 if ($ev->{button} == 1) {
2494 $::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
2495 } elsif ($ev->{button} == 2) {
2496 $::CONN->send ("apply $item->{tag}");
2497 } elsif ($ev->{button} == 3) {
2498 CFClient::UI::Menu->new (
2499 items => [
2500 ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2501 [
2502 $item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
2503 sub { $::CONN->send ("lock $item->{tag}") },
2504 ],
2505 ["mark", sub { $::CONN->send ("mark $item->{tag}") }],
2506 ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2507 ["drop", sub { $::CONN->send ("move 0 $item->{tag} 0") }],
2508 ],
2509 )->popup ($ev);
2510 }
2511
2512 1
2513 },
2514 %args
2515 );
2516
2517 $self->add (new CFClient::UI::Face
2518 can_events => 0,
2519 face => $item->{face},
2520 anim => $item->{anim},
2521 animspeed => $item->{animspeed},
2522 );
2523
2524 $self->add (new CFClient::UI::Label
2525 can_events => 0,
2526 text => $desc,
2527 );
2528
2529 $self
2530}
2531
2532#############################################################################
2533
2534package CFClient::UI::Inventory;
2535
2536our @ISA = CFClient::UI::ScrolledWindow::;
2537
2538sub new {
2539 my $class = shift;
2540
2541 my $self = $class->SUPER::new (
2542 scrolled => (new CFClient::UI::VBox),
2543 @_,
2544 );
2545
2546 $self
2547}
2548
2549sub set_items {
2550 my ($self, $items) = @_; 2795 my ($self) = @_;
2551 2796
2552 $self->{scrolled}->clear; 2797 $self->{timer}->cancel
2553 return unless $items; 2798 if $self->{timer};
2554 2799
2555 my @items = sort { $a->{type} <=> $b->{type} } @$items; 2800 $self->SUPER::DESTROY;
2556
2557 $self->{real_items} = \@items;
2558
2559 for my $item (@items) {
2560 my $desc = $item->{nrof} < 2
2561 ? $item->{name}
2562 : "$item->{nrof} $item->{name_pl}";
2563
2564 $self->{scrolled}->add ($item->{widget} ||= new CFClient::UI::InventoryItem item => $item);
2565 }
2566
2567# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2568}
2569
2570sub size_request {
2571 my ($self) = @_;
2572 ($self->{req_w}, $self->{req_h});
2573} 2801}
2574 2802
2575############################################################################# 2803#############################################################################
2576 2804
2577package CFClient::UI::Menu; 2805package CFClient::UI::Menu;
… …
2612 2840
2613# 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)
2614sub popup { 2842sub popup {
2615 my ($self, $ev) = @_; 2843 my ($self, $ev) = @_;
2616 2844
2617 $self->emit ("popdown"); 2845 $self->_emit ("popdown");
2618 2846
2619 # maybe save $GRAB? must be careful about events... 2847 # maybe save $GRAB? must be careful about events...
2620 $GRAB = $self; 2848 $GRAB = $self;
2621 $self->{button} = $ev->{button}; 2849 $self->{button} = $ev->{button};
2622 2850
2623 $self->show; 2851 $self->show;
2624 $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);
2625} 2853}
2626 2854
2627sub mouse_motion { 2855sub mouse_motion {
2628 my ($self, $ev, $x, $y) = @_; 2856 my ($self, $ev, $x, $y) = @_;
2629 2857
… …
2637 2865
2638 if ($ev->{button} == $self->{button}) { 2866 if ($ev->{button} == $self->{button}) {
2639 undef $GRAB; 2867 undef $GRAB;
2640 $self->hide; 2868 $self->hide;
2641 2869
2642 $self->emit ("popdown"); 2870 $self->_emit ("popdown");
2643 $self->{hover}[1]->() if $self->{hover}; 2871 $self->{hover}[1]->() if $self->{hover};
2644 } 2872 }
2645} 2873}
2646 2874
2647############################################################################# 2875#############################################################################
2648 2876
2649package CFClient::UI::Statusbox; 2877package CFClient::UI::Statusbox;
2650 2878
2651our @ISA = CFClient::UI::VBox::; 2879our @ISA = CFClient::UI::VBox::;
2880
2881sub new {
2882 my $class = shift;
2883
2884 $class->SUPER::new (
2885 fontsize => 0.8,
2886 @_,
2887 )
2888}
2652 2889
2653sub reorder { 2890sub reorder {
2654 my ($self) = @_; 2891 my ($self) = @_;
2655 my $NOW = time; 2892 my $NOW = time;
2656 2893
2657 while (my ($k, $v) = each %{ $self->{item} }) { 2894 while (my ($k, $v) = each %{ $self->{item} }) {
2658 delete $self->{item}{$k} if $v->{timeout} < $NOW; 2895 delete $self->{item}{$k} if $v->{timeout} < $NOW;
2659 } 2896 }
2660 2897
2661 my @widgets; 2898 my @widgets;
2662 my @items = sort { $a->{time} <=> $b->{time} } values %{ $self->{item} }; 2899
2900 my @items = sort {
2901 $a->{pri} <=> $b->{pri}
2902 or $b->{id} <=> $a->{id}
2903 } values %{ $self->{item} };
2904
2663 my $count = 10 + 1; 2905 my $count = 10 + 1;
2664 for my $item (@items) { 2906 for my $item (@items) {
2665 last unless --$count; 2907 last unless --$count;
2666 2908
2667 push @widgets, $item->{label} ||= do { 2909 push @widgets, $item->{label} ||= do {
2668 # TODO: doesn't handle markup well (read as: at all) 2910 # TODO: doesn't handle markup well (read as: at all)
2669 my $short = delete $item->{text}; 2911 my $short = $item->{count} > 1
2912 ? "<b>$item->{count} ×</b> $item->{text}"
2913 : $item->{text};
2914
2670 for ($short) { 2915 for ($short) {
2671 s/^\s+//; 2916 s/^\s+//;
2672 s/\012.*//s; 2917 s/\s+/ /g;
2673 my $len = int 30 / $item->{fontsize};
2674 substr $_, $len, length, "…" if $len < length;
2675 } 2918 }
2676 2919
2677 new CFClient::UI::Label 2920 new CFClient::UI::Label
2678 markup => $short, 2921 markup => $short,
2679 tooltip => delete $item->{tooltip}, 2922 tooltip => $item->{tooltip},
2680 fontsize => delete $item->{fontsize}, 2923 tooltip_font => $::FONT_PROP,
2681 color => delete $item->{color}, 2924 tooltip_width => 0.67,
2925 fontsize => $item->{fontsize} || $self->{fontsize},
2926 max_w => $::WIDTH * 0.44,
2927 fg => $item->{fg},
2682 can_events => 1, 2928 can_events => 1,
2683 can_hover => 1, 2929 can_hover => 1
2684 }; 2930 };
2685 } 2931 }
2686 2932
2687 $self->clear; 2933 $self->clear;
2688 $self->SUPER::add (@widgets); 2934 $self->SUPER::add (reverse @widgets);
2689} 2935}
2690 2936
2691sub add { 2937sub add {
2692 my ($self, $text, %arg) = @_; 2938 my ($self, $text, %arg) = @_;
2693 2939
2694 my $item = { 2940 $text =~ s/^\s+//;
2695 time => time, 2941 $text =~ s/\s+$//;
2942
2943 return unless $text;
2944
2945 my $timeout = time + ((delete $arg{timeout}) || 60);
2946
2947 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2948
2949 if (my $item = $self->{item}{$group}) {
2950 if ($item->{text} eq $text) {
2951 $item->{count}++;
2952 } else {
2953 $item->{count} = 1;
2954 $item->{text} = $item->{tooltip} = $text;
2955 }
2956 $item->{id} = ++$self->{id};
2957 $item->{timeout} = $timeout;
2958 delete $item->{label};
2959 } else {
2960 $self->{item}{$group} = {
2961 id => ++$self->{id},
2696 text => $text, 2962 text => $text,
2697 timeout => 60, 2963 timeout => $timeout,
2698 tooltip => $text, 2964 tooltip => $text,
2699 fontsize => 0.8,
2700 color => [0.8, 0.8, 0.8, 0.8], 2965 fg => [0.8, 0.8, 0.8, 0.8],
2966 pri => 0,
2967 count => 1,
2701 %arg, 2968 %arg,
2969 };
2702 }; 2970 }
2703
2704 $item->{timeout} += time;
2705 $item->{group} ||= $item+0;
2706
2707 $item = $self->{item}{$item->{group}} ||= $item;
2708 2971
2709 $self->reorder; 2972 $self->reorder;
2710} 2973}
2711 2974
2975sub reconfigure {
2976 my ($self) = @_;
2977
2978 delete $_->{label}
2979 for values %{ $self->{item} || {} };
2980
2981 $self->reorder;
2982 $self->SUPER::reconfigure;
2983}
2984
2712############################################################################# 2985#############################################################################
2713 2986
2714package CFClient::UI::Root; 2987package CFClient::UI::Inventory;
2715 2988
2716our @ISA = CFClient::UI::Container::; 2989our @ISA = CFClient::UI::ScrolledWindow::;
2717
2718use CFClient::OpenGL;
2719 2990
2720sub new { 2991sub new {
2721 my $class = shift; 2992 my $class = shift;
2722 2993
2723 $class->SUPER::new ( 2994 my $self = $class->SUPER::new (
2995 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2724 @_, 2996 @_,
2725 ) 2997 );
2726}
2727 2998
2728sub 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 {
2729 my ($self, $x, $y, $w, $h) = @_; 3147 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
2730 3148
2731 $self->{w} = $w; 3149 $self->clear_command_list;
2732 $self->{h} = $h; 3150 $self->{recording} = 0;
2733} 3151 $self->{rec_btn}->set_text ("start recording");
2734 3152
2735sub 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 {
2736 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}
2737 3171
2738 $self->size_allocate ($self->{w}, $self->{h}) 3172sub update_binding_widgets {
2739 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
2740} 3295}
2741 3296
2742sub size_request { 3297sub size_request {
2743 my ($self) = @_; 3298 my ($self) = @_;
2744 3299
2745 ($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
2746} 3315}
2747 3316
2748sub size_allocate { 3317sub size_allocate {
2749 my ($self, $w, $h) = @_; 3318 my ($self, $w, $h) = @_;
2750 3319
2751 my $old_w = $self->{old_w};
2752 my $old_h = $self->{old_h};
2753
2754 if ($old_w && $old_h) {
2755 for my $child ($self->children) {
2756 $child->{x} = int 0.5 + $child->{x} * $w / $old_w;
2757 $child->{w} = int 0.5 + $child->{w} * $w / $old_w;
2758 $child->{req_w} = int 0.5 + $child->{req_w} * $w / $old_w if exists $child->{req_w};
2759 $child->{user_w} = int 0.5 + $child->{user_w} * $w / $old_w if exists $child->{user_w};
2760 $child->{y} = int 0.5 + $child->{y} * $h / $old_h;
2761 $child->{h} = int 0.5 + $child->{h} * $h / $old_h;
2762 $child->{req_h} = int 0.5 + $child->{req_h} * $h / $old_h if exists $child->{req_h};
2763 $child->{user_h} = int 0.5 + $child->{user_h} * $h / $old_h if exists $child->{user_h};
2764 }
2765 }
2766
2767 for my $child ($self->children) { 3320 for my $child ($self->children) {
2768 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)};
2769 3322
2770 $X = List::Util::max 0, List::Util::min $w - $W, $X; 3323 $X = $child->{force_x} if exists $child->{force_x};
2771 $Y = List::Util::max 0, List::Util::min $h - $H, $Y; 3324 $Y = $child->{force_y} if exists $child->{force_y};
3325
3326 $X = _to_pixel $X, $W, $self->{w};
3327 $Y = _to_pixel $Y, $H, $self->{h};
3328
2772 $child->configure ($X, $Y, $W, $H); 3329 $child->configure ($X, $Y, $W, $H);
2773 } 3330 }
2774
2775 $self->{old_w} = $w;
2776 $self->{old_h} = $h;
2777} 3331}
2778 3332
2779sub coord2local { 3333sub coord2local {
2780 my ($self, $x, $y) = @_; 3334 my ($self, $x, $y) = @_;
2781 3335
… …
2789} 3343}
2790 3344
2791sub update { 3345sub update {
2792 my ($self) = @_; 3346 my ($self) = @_;
2793 3347
2794 $self->check_size;
2795 $::WANT_REFRESH++; 3348 $::WANT_REFRESH++;
2796} 3349}
2797 3350
2798sub add { 3351sub add {
2799 my ($self, $child) = @_; 3352 my ($self, @children) = @_;
2800 3353
2801 # integerise window positions 3354 $_->{is_toplevel} = 1
2802 $child->{x} = int $child->{x}; 3355 for @children;
2803 $child->{y} = int $child->{y};
2804 3356
2805 $self->SUPER::add ($child); 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;
3367
3368 while (@children) {
3369 my $w = pop @children;
3370 push @children, $w->children;
3371 $w->set_invisible;
3372 }
2806} 3373}
2807 3374
2808sub on_refresh { 3375sub on_refresh {
2809 my ($self, $id, $cb) = @_; 3376 my ($self, $id, $cb) = @_;
2810 3377
2811 $self->{refresh_hook}{$id} = $cb; 3378 $self->{refresh_hook}{$id} = $cb;
2812} 3379}
2813 3380
3381sub on_post_alloc {
3382 my ($self, $id, $cb) = @_;
3383
3384 $self->{post_alloc_hook}{$id} = $cb;
3385}
3386
2814sub draw { 3387sub draw {
2815 my ($self) = @_; 3388 my ($self) = @_;
2816
2817 if ($self->{check_size}) {
2818 my @queue = ([], []);
2819
2820 for (;;) {
2821 if ($self->{check_size}) {
2822 # heuristic: check containers last
2823 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_
2824 for values %{delete $self->{check_size}}
2825 }
2826
2827 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;
2828
2829 my ($w, $h) = $widget->{user_w} && $widget->{user_h}
2830 ? @$widget{qw(user_w user_h)}
2831 : $widget->size_request;
2832
2833 if ($w != $widget->{req_w} || $h != $widget->{req_h}) {
2834 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
2835
2836 $widget->{req_w} = $w;
2837 $widget->{req_h} = $h;
2838
2839 $self->{size_alloc}{$widget} = [$widget, $widget->{w}, $widget->{h}];
2840
2841 $widget->{parent}->check_size
2842 if $widget->{parent};
2843 }
2844 }
2845 }
2846
2847 while ($self->{size_alloc}) {
2848 for (values %{delete $self->{size_alloc}}) {
2849 my ($widget, $w, $h) = @$_;
2850
2851 $w = 0 if $w < 0;
2852 $h = 0 if $h < 0;
2853
2854 $widget->{w} = $w;
2855 $widget->{h} = $h;
2856 $widget->size_allocate ($w, $h);
2857 $widget->emit (size_allocate => $w, $h);
2858 }
2859 }
2860 3389
2861 while ($self->{refresh_hook}) { 3390 while ($self->{refresh_hook}) {
2862 $_->() 3391 $_->()
2863 for values %{delete $self->{refresh_hook}}; 3392 for values %{delete $self->{refresh_hook}};
2864 } 3393 }
2865 3394
3395 if ($self->{realloc}) {
3396 my %queue;
3397 my @queue;
3398 my $widget;
3399
3400 outer:
3401 while () {
3402 if (my $realloc = delete $self->{realloc}) {
3403 for $widget (values %$realloc) {
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 }
3410 }
3411
3412 while () {
3413 @queue or last outer;
3414
3415 $widget = pop @{ $queue[-1] || [] }
3416 and last;
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}) {
3433 $widget->{req_w} = $w;
3434 $widget->{req_h} = $h;
3435
3436 $self->{size_alloc}{$widget+0} = $widget;
3437
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 }
3445 }
3446
3447 delete $self->{realloc}{$widget+0};
3448 }
3449 }
3450
3451 while (my $size_alloc = delete $self->{size_alloc}) {
3452 my @queue = sort { $b->{visible} <=> $a->{visible} }
3453 values %$size_alloc;
3454
3455 while () {
3456 my $widget = pop @queue || last;
3457
3458 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3459
3460 $w = 0 if $w < 0;
3461 $h = 0 if $h < 0;
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
3470 $widget->{w} = $w;
3471 $widget->{h} = $h;
3472
3473 $widget->emit (size_allocate => $w, $h);
3474 }
3475 }
3476 }
3477
3478 while ($self->{post_alloc_hook}) {
3479 $_->()
3480 for values %{delete $self->{post_alloc_hook}};
3481 }
3482
3483
2866 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3484 glViewport 0, 0, $::WIDTH, $::HEIGHT;
2867 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3485 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2868 glClear GL_COLOR_BUFFER_BIT; 3486 glClear GL_COLOR_BUFFER_BIT;
2869 3487
2870 glMatrixMode GL_PROJECTION; 3488 glMatrixMode GL_PROJECTION;
2871 glLoadIdentity; 3489 glLoadIdentity;
2872 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000; 3490 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2873 glMatrixMode GL_MODELVIEW; 3491 glMatrixMode GL_MODELVIEW;
2874 glLoadIdentity; 3492 glLoadIdentity;
2875 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
2876 $self->_draw; 3501 $self->_draw;
2877} 3502}
2878 3503
2879############################################################################# 3504#############################################################################
2880 3505
2881package CFClient::UI; 3506package CFClient::UI;
2882 3507
2883$ROOT = new CFClient::UI::Root; 3508$ROOT = new CFClient::UI::Root;
2884$TOOLTIP = new CFClient::UI::Tooltip; 3509$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2885 3510
28861 35111
2887 3512

Diff Legend

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