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.198 by root, Fri May 12 02:08:52 2006 UTC vs.
Revision 1.271 by root, Fri Jun 2 22:13:47 2006 UTC

… …
5 5
6use Scalar::Util (); 6use Scalar::Util ();
7use List::Util (); 7use List::Util ();
8 8
9use CFClient; 9use CFClient;
10use CFClient::Texture;
10 11
11our ($FOCUS, $HOVER, $GRAB); # various widgets 12our ($FOCUS, $HOVER, $GRAB); # various widgets
12 13
14our $LAYOUT;
13our $ROOT; 15our $ROOT;
14our $TOOLTIP; 16our $TOOLTIP;
15our $BUTTON_STATE; 17our $BUTTON_STATE;
16 18
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_tooltip_from ($widget); 59 $TOOLTIP->set_tooltip_from ($widget);
30 $TOOLTIP->show; 60 $TOOLTIP->show;
31
32 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
33
34 if ($x + $TOOLTIP->{w} > $::WIDTH) {
35 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0);
36 }
37
38 $TOOLTIP->move ($x, $y);
39 $TOOLTIP->check_size;
40 $TOOLTIP->update;
41 } 61 }
42 62
43 return; 63 return;
44 } 64 }
45 } 65 }
… …
49 delete $TOOLTIP->{owner}; 69 delete $TOOLTIP->{owner};
50} 70}
51 71
52# class methods for events 72# class methods for events
53sub feed_sdl_key_down_event { 73sub feed_sdl_key_down_event {
54 $FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0]) 74 $FOCUS->emit (key_down => $_[0])
55 if $FOCUS; 75 if $FOCUS;
56} 76}
57 77
58sub feed_sdl_key_up_event { 78sub feed_sdl_key_up_event {
59 $FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0]) 79 $FOCUS->emit (key_up => $_[0])
60 if $FOCUS; 80 if $FOCUS;
61} 81}
62 82
63sub feed_sdl_button_down_event { 83sub feed_sdl_button_down_event {
64 my ($ev) = @_; 84 my ($ev) = @_;
… …
73 check_tooltip; 93 check_tooltip;
74 } 94 }
75 95
76 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 96 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
77 97
78 if ($GRAB) { 98 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
79 ($x, $y) = $GRAB->coord2local ($x, $y); 99 if $GRAB;
80 $GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
81 }
82} 100}
83 101
84sub feed_sdl_button_up_event { 102sub feed_sdl_button_up_event {
85 my ($ev) = @_; 103 my ($ev) = @_;
86 my ($x, $y) = ($ev->{x}, $ev->{y}); 104 my ($x, $y) = ($ev->{x}, $ev->{y});
87 105
88 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 106 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
89 107
90 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 108 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
91 109
92 if ($GRAB) { 110 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
93 ($x, $y) = $GRAB->coord2local ($x, $y); 111 if $GRAB;
94 $GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
95 }
96 112
97 if (!$BUTTON_STATE) { 113 if (!$BUTTON_STATE) {
98 my $grab = $GRAB; undef $GRAB; 114 my $grab = $GRAB; undef $GRAB;
99 $grab->update if $grab; 115 $grab->update if $grab;
100 $GRAB->update if $GRAB; 116 $GRAB->update if $GRAB;
… …
116 $HOVER->update if $HOVER && $HOVER->{can_hover}; 132 $HOVER->update if $HOVER && $HOVER->{can_hover};
117 133
118 check_tooltip; 134 check_tooltip;
119 } 135 }
120 136
121 if ($HOVER) {
122 ($x, $y) = $HOVER->coord2local ($x, $y);
123 $HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y); 137 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
124 } 138 if $HOVER;
125} 139}
126 140
127# convert position array to integers 141# convert position array to integers
128sub harmonize { 142sub harmonize {
129 my ($vals) = @_; 143 my ($vals) = @_;
… …
135 $rem += $_ - $i; 149 $rem += $_ - $i;
136 $_ = $i; 150 $_ = $i;
137 } 151 }
138} 152}
139 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} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
177 $widget->{y} += int $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} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
187 $widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
188
189 }
190 }
191
192 reconfigure_widgets;
193}
194
140############################################################################# 195#############################################################################
141 196
142package CFClient::UI::Base; 197package CFClient::UI::Base;
143 198
144use strict; 199use strict;
… …
147 202
148sub new { 203sub new {
149 my $class = shift; 204 my $class = shift;
150 205
151 my $self = bless { 206 my $self = bless {
152 x => 0, 207 x => "center",
153 y => 0, 208 y => "center",
154 z => 0, 209 z => 0,
210 w => undef,
211 h => undef,
155 can_events => 1, 212 can_events => 1,
156 @_ 213 @_
157 }, $class; 214 }, $class;
158 215
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
159 for (keys %$self) { 218 for (keys %$self) {
160 if (/^connect_(.*)$/) { 219 if (/^on_(.*)$/) {
161 $self->connect ($1 => delete $self->{$_}); 220 $self->connect ($1 => delete $self->{$_});
162 } 221 }
163 } 222 }
164 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
165 $self 236 $self
166} 237}
167 238
168sub destroy { 239sub destroy {
169 my ($self) = @_; 240 my ($self) = @_;
… …
178 return if $self->{parent}; 249 return if $self->{parent};
179 250
180 $CFClient::UI::ROOT->add ($self); 251 $CFClient::UI::ROOT->add ($self);
181} 252}
182 253
183sub hide { 254sub set_visible {
184 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};
185 278
186 undef $GRAB if $GRAB == $self; 279 undef $GRAB if $GRAB == $self;
187 undef $HOVER if $HOVER == $self; 280 undef $HOVER if $HOVER == $self;
188 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
189 $self->{parent}->remove ($self) 312 $self->{parent}->remove ($self)
190 if $self->{parent}; 313 if $self->{parent};
191} 314}
192 315
193sub move { 316sub move_abs {
194 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
195 318
196 $self->{x} = int $x; 319 $self->{x} = List::Util::max 0, int $x;
197 $self->{y} = int $y; 320 $self->{y} = List::Util::max 0, int $y;
198 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
199 322
200 $self->update; 323 $self->update;
201} 324}
202 325
203sub set_size { 326sub set_size {
204 my ($self, $w, $h) = @_; 327 my ($self, $w, $h) = @_;
205 328
206 $self->{user_w} = $w; 329 $self->{force_w} = $w;
207 $self->{user_h} = $h; 330 $self->{force_h} = $h;
208 331
209 $self->check_size; 332 $self->realloc;
210} 333}
211 334
212sub size_request { 335sub size_request {
213 require Carp; 336 require Carp;
214 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
… …
216 339
217sub configure { 340sub configure {
218 my ($self, $x, $y, $w, $h) = @_; 341 my ($self, $x, $y, $w, $h) = @_;
219 342
220 if ($self->{aspect}) { 343 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h);
345
221 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 346 $w = List::Util::min $w, int $h * $self->{aspect};
222 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 347 $h = List::Util::min $h, int $w / $self->{aspect};
223 348
224 # use alignment to adjust x, y 349 # use alignment to adjust x, y
225 350
226 $x += int +($w - $w2) * 0.5; 351 $x += int 0.5 * ($ow - $w);
227 $y += int +($h - $h2) * 0.5; 352 $y += int 0.5 * ($oh - $h);
228
229 ($w, $h) = ($w2, $h2);
230 } 353 }
231 354
232 if ($self->{x} != $x || $self->{y} != $y) { 355 if ($self->{x} ne $x || $self->{y} ne $y) {
233 $self->{x} = $x; 356 $self->{x} = $x;
234 $self->{y} = $y; 357 $self->{y} = $y;
235 $self->update; 358 $self->update;
236 } 359 }
237 360
238 if ($self->{w} != $w || $self->{h} != $h) { 361 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
239 $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;
240 } 368 }
241} 369}
242 370
243sub size_allocate { 371sub size_allocate {
244 # nothing to be done 372 # nothing to be done
245} 373}
246 374
247sub children { 375sub children {
248} 376}
249 377
250# call when resolution changes etc.
251sub reconfigure {
252 my ($self) = @_;
253
254 $_->reconfigure
255 for $self->children;
256
257 $self->check_size (1);
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; #?
306}
307 439
440 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
441 unless $FOCUS;
442}
443
308sub mouse_motion { } 444sub mouse_motion { 0 }
309sub button_up { } 445sub button_up { 0 }
310sub key_down { } 446sub key_down { 0 }
311sub key_up { } 447sub key_up { 0 }
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}
318 453
319sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 454 0
320sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 455}
321sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 456
322sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 457sub find_widget {
323sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 458 my ($self, $x, $y) = @_;
459
460 return () unless $self->{can_events};
461
462 return $self
463 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
464 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
465
466 ()
467}
468
469sub set_parent {
470 my ($self, $parent) = @_;
471
472 Scalar::Util::weaken ($self->{parent} = $parent);
473 $self->set_visible if $parent->{visible};
474}
475
476sub connect {
477 my ($self, $signal, $cb) = @_;
478
479 push @{ $self->{signal_cb}{$signal} }, $cb;
480}
481
482sub _emit {
483 my ($self, $signal, @args) = @_;
484
485 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
486}
487
488sub emit {
489 my ($self, $signal, @args) = @_;
490
491 $self->_emit ($signal, @args)
492 || $self->$signal (@args);
493}
494
495sub visibility_change {
496 #my ($self, $visible) = @_;
497}
498
499sub realloc {
500 my ($self) = @_;
501
502 if ($self->{visible}) {
503 return if $self->{root}{realloc}{$self+0};
504
505 $self->{root}{realloc}{$self+0} = $self;
506 $self->{root}->update;
507 } else {
508 delete $self->{req_w};
509 delete $self->{req_h};
510 }
511}
512
513sub update {
514 my ($self) = @_;
515
516 $self->{parent}->update
517 if $self->{parent};
518}
519
520sub reconfigure {
521 my ($self) = @_;
522
523 $self->realloc;
524 $self->update;
525}
526
527# using global variables seems a bit hacky, but passing through all drawing
528# functions seems pointless.
529our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
324 530
325sub draw { 531sub draw {
326 my ($self) = @_; 532 my ($self) = @_;
327 533
328 return unless $self->{h} && $self->{w}; 534 return unless $self->{h} && $self->{w};
535
536 # update screen rectangle
537 local $draw_x = $draw_x + $self->{x};
538 local $draw_y = $draw_y + $self->{y};
539 local $draw_w = $draw_x + $self->{w};
540 local $draw_h = $draw_y + $self->{h};
541
542 # skip widgets that are entirely outside the drawing area
543 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
544 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
329 545
330 glPushMatrix; 546 glPushMatrix;
331 glTranslate $self->{x}, $self->{y}, 0; 547 glTranslate $self->{x}, $self->{y}, 0;
332 $self->_draw; 548 $self->_draw;
333 glPopMatrix; 549 glPopMatrix;
… …
345 glVertex $x , $y + $self->{h}; 561 glVertex $x , $y + $self->{h};
346 glEnd; 562 glEnd;
347 glDisable GL_BLEND; 563 glDisable GL_BLEND;
348 } 564 }
349 565
350 if ($ENV{PCLIENT_DEBUG}) { 566 if ($ENV{CFPLUS_DEBUG} & 1) {
351 glPushMatrix; 567 glPushMatrix;
352 glColor 1, 1, 0, 1; 568 glColor 1, 1, 0, 1;
353 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 569 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
354 glBegin GL_LINE_LOOP; 570 glBegin GL_LINE_LOOP;
355 glVertex 0 , 0; 571 glVertex 0 , 0;
356 glVertex $self->{w}, 0; 572 glVertex $self->{w} - 1, 0;
357 glVertex $self->{w}, $self->{h}; 573 glVertex $self->{w} - 1, $self->{h} - 1;
358 glVertex 0 , $self->{h}; 574 glVertex 0 , $self->{h} - 1;
359 glEnd; 575 glEnd;
360 glPopMatrix; 576 glPopMatrix;
361 CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 577 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
362 } 578 }
363} 579}
364 580
365sub _draw { 581sub _draw {
366 my ($self) = @_; 582 my ($self) = @_;
367 583
368 warn "no draw defined for $self\n"; 584 warn "no draw defined for $self\n";
369} 585}
370 586
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
389 # TODO: req_w _does_change after ->reconfigure
390 $self->check_size
391 unless exists $self->{req_w};
392}
393
394sub check_size {
395 my ($self, $forced) = @_;
396
397 $self->{force_alloc} = 1 if $forced;
398 $CFClient::UI::ROOT->{check_size}{$self} = $self;
399}
400
401sub update {
402 my ($self) = @_;
403
404 $self->{parent}->update
405 if $self->{parent};
406}
407
408sub connect {
409 my ($self, $signal, $cb) = @_;
410
411 push @{ $self->{signal_cb}{$signal} }, $cb;
412}
413
414sub emit {
415 my ($self, $signal, @args) = @_;
416
417 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
418}
419
420sub DESTROY { 587sub DESTROY {
421 my ($self) = @_; 588 my ($self) = @_;
422 589
590 delete $WIDGET{$self+0};
423 #$self->deactivate; 591 #$self->deactivate;
424} 592}
425 593
426############################################################################# 594#############################################################################
427 595
… …
436 my $class = shift; 604 my $class = shift;
437 605
438 # range [value, low, high, page] 606 # range [value, low, high, page]
439 607
440 $class->SUPER::new ( 608 $class->SUPER::new (
441 bg => [0, 0, 0, 0.2], 609 #bg => [0, 0, 0, 0.2],
442 active_bg => [1, 1, 1, 0.5], 610 #active_bg => [1, 1, 1, 0.5],
443 @_ 611 @_
444 ) 612 )
445} 613}
446 614
447sub _draw { 615sub _draw {
448 my ($self) = @_; 616 my ($self) = @_;
449 617
618 my $color = $FOCUS == $self && $self->{active_bg}
619 ? $self->{active_bg}
620 : $self->{bg};
621
622 if ($color && (@$color < 4 || $color->[3])) {
450 my ($w, $h) = @$self{qw(w h)}; 623 my ($w, $h) = @$self{qw(w h)};
451 624
452 glEnable GL_BLEND; 625 glEnable GL_BLEND;
453 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 626 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
454 glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} }; 627 glColor @$color;
455 628
456 glBegin GL_QUADS; 629 glBegin GL_QUADS;
457 glVertex 0 , 0; 630 glVertex 0 , 0;
458 glVertex 0 , $h; 631 glVertex 0 , $h;
459 glVertex $w, $h; 632 glVertex $w, $h;
460 glVertex $w, 0; 633 glVertex $w, 0;
461 glEnd; 634 glEnd;
462 635
463 glDisable GL_BLEND; 636 glDisable GL_BLEND;
637 }
464} 638}
465 639
466############################################################################# 640#############################################################################
467 641
468package CFClient::UI::Empty; 642package CFClient::UI::Empty;
… …
473 my ($class, %arg) = @_; 647 my ($class, %arg) = @_;
474 $class->SUPER::new (can_events => 0, %arg); 648 $class->SUPER::new (can_events => 0, %arg);
475} 649}
476 650
477sub size_request { 651sub size_request {
478 (0, 0) 652 my ($self) = @_;
653
654 ($self->{w} + 0, $self->{h} + 0)
479} 655}
480 656
481sub draw { } 657sub draw { }
482 658
483############################################################################# 659#############################################################################
… …
512 $self->{children} = [ 688 $self->{children} = [
513 sort { $a->{z} <=> $b->{z} } 689 sort { $a->{z} <=> $b->{z} }
514 @{$self->{children}}, @widgets 690 @{$self->{children}}, @widgets
515 ]; 691 ];
516 692
517 $self->check_size (1); 693 $self->realloc;
518 $self->update;
519} 694}
520 695
521sub children { 696sub children {
522 @{ $_[0]{children} } 697 @{ $_[0]{children} }
523} 698}
… …
528 delete $child->{parent}; 703 delete $child->{parent};
529 $child->hide; 704 $child->hide;
530 705
531 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 706 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
532 707
533 $self->check_size; 708 $self->realloc;
534 $self->update;
535} 709}
536 710
537sub clear { 711sub clear {
538 my ($self) = @_; 712 my ($self) = @_;
539 713
… …
543 for (@$children) { 717 for (@$children) {
544 delete $_->{parent}; 718 delete $_->{parent};
545 $_->hide; 719 $_->hide;
546 } 720 }
547 721
548 $self->check_size; 722 $self->realloc;
549 $self->update;
550} 723}
551 724
552sub find_widget { 725sub find_widget {
553 my ($self, $x, $y) = @_; 726 my ($self, $x, $y) = @_;
554 727
… …
641 $self->SUPER::size_allocate ($w, $h); 814 $self->SUPER::size_allocate ($w, $h);
642 $self->update; 815 $self->update;
643} 816}
644 817
645sub _render { 818sub _render {
819 my ($self) = @_;
820
646 $_[0]{children}[0]->draw; 821 $self->{children}[0]->draw;
647} 822}
648 823
649sub render_child { 824sub render_child {
650 my ($self) = @_; 825 my ($self) = @_;
651 826
652 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 827 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
653 glClearColor 0, 0, 0, 0; 828 glClearColor 0, 0, 0, 0;
654 glClear GL_COLOR_BUFFER_BIT; 829 glClear GL_COLOR_BUFFER_BIT;
655 830
831 {
832 package CFClient::UI::Base;
833
834 ($draw_x, $draw_y, $draw_w, $draw_h) =
835 (0, 0, $self->{w}, $self->{h});
836 }
837
656 $self->_render; 838 $self->_render;
657# glColorMask 1, 1, 1, 0;
658# glEnable GL_BLEND;
659# glBlendFunc GL_SRC_ALPHA, GL_ZERO;
660# glRasterPos 0, 0;
661# glCopyPixels 0, 0, $self->{w}, $self->{h};
662# glDisable GL_BLEND;
663# glColorMask 1, 1, 1, 1;
664 }; 839 };
665} 840}
666 841
667sub _draw { 842sub _draw {
668 my ($self) = @_; 843 my ($self) = @_;
669 844
670 my ($w, $h) = ($self->w, $self->h); 845 my ($w, $h) = @$self{qw(w h)};
671 846
672 my $tex = $self->{texture} 847 my $tex = $self->{texture}
673 or return; 848 or return;
674 849
675 glEnable GL_TEXTURE_2D; 850 glEnable GL_TEXTURE_2D;
676 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 851 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
677 glColor 0, 0, 0, 1; 852 glColor 1, 1, 1, 1;
678 853
679 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h); 854 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
680 855
681 glDisable GL_TEXTURE_2D; 856 glDisable GL_TEXTURE_2D;
682} 857}
… …
685 860
686package CFClient::UI::ViewPort; 861package CFClient::UI::ViewPort;
687 862
688our @ISA = CFClient::UI::Window::; 863our @ISA = CFClient::UI::Window::;
689 864
865sub new {
866 my $class = shift;
867
868 $class->SUPER::new (
869 scroll_x => 0,
870 scroll_y => 1,
871 @_,
872 )
873}
874
690sub size_request { 875sub size_request {
691 my ($self) = @_; 876 my ($self) = @_;
692 877
693 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 878 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
694 $self->child->configure (0, 0, @$self{qw(child_w child_h)});
695 879
696 @$self{qw(child_w child_h)} 880 $w = 10 if $self->{scroll_x};
881 $h = 10 if $self->{scroll_y};
882
883 ($w, $h)
697} 884}
698 885
699sub size_allocate { 886sub size_allocate {
700 my ($self, $w, $h) = @_; 887 my ($self, $w, $h) = @_;
701 888
889 my $child = $self->child;
890
891 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
892 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
893
894 $self->child->configure (0, 0, $w, $h);
702 $self->update; 895 $self->update;
703} 896}
704 897
705sub set_offset { 898sub set_offset {
706 my ($self, $x, $y) = @_; 899 my ($self, $x, $y) = @_;
… …
740} 933}
741 934
742sub _render { 935sub _render {
743 my ($self) = @_; 936 my ($self) = @_;
744 937
938 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
939 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
940
745 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 941 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
746 942
747 $self->SUPER::_render; 943 $self->SUPER::_render;
748} 944}
749 945
… …
757 my $class = shift; 953 my $class = shift;
758 954
759 my $self; 955 my $self;
760 956
761 my $slider = new CFClient::UI::Slider 957 my $slider = new CFClient::UI::Slider
762 vertical => 1, 958 vertical => 1,
763 range => [0, 0, 1, 0.01], # HACK fix 959 range => [0, 0, 1, 0.01], # HACK fix
764 connect_changed => sub { 960 on_changed => sub {
765 $self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h})); 961 $self->{vp}->set_offset (0, $_[1]);
766 }, 962 },
767 ; 963 ;
768 964
769 $self = $class->SUPER::new ( 965 $self = $class->SUPER::new (
770 vp => (new CFClient::UI::ViewPort), 966 vp => (new CFClient::UI::ViewPort expand => 1),
771 slider => $slider, 967 slider => $slider,
772 @_, 968 @_,
773 ); 969 );
774 970
775 $self->{vp}->add ($self->{scrolled}); 971 $self->{vp}->add ($self->{scrolled});
… …
777 $self->add ($self->{slider}); 973 $self->add ($self->{slider});
778 974
779 $self 975 $self
780} 976}
781 977
978sub update {
979 my ($self) = @_;
980
981 $self->SUPER::update;
982
983 # todo: overwrite size_allocate of child
984 my $child = $self->{vp}->child;
985 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
986}
987
988sub size_allocate {
989 my ($self, $w, $h) = @_;
990
991 $self->SUPER::size_allocate ($w, $h);
992
993 my $child = $self->{vp}->child;
994 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
995}
996
782#TODO# update range on size_allocate depeneing on child 997#TODO# update range on size_allocate depending on child
783# update viewport offset on scroll 998# update viewport offset on scroll
784 999
785############################################################################# 1000#############################################################################
786 1001
787package CFClient::UI::Frame; 1002package CFClient::UI::Frame;
788 1003
789our @ISA = CFClient::UI::Bin::; 1004our @ISA = CFClient::UI::Bin::;
790 1005
791use CFClient::OpenGL; 1006use CFClient::OpenGL;
792
793#############################################################################
794
795package CFClient::UI::FancyFrame;
796
797our @ISA = CFClient::UI::Bin::;
798
799use CFClient::OpenGL;
800
801my @tex =
802 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
803 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
804 1007
805sub new { 1008sub new {
806 my $class = shift; 1009 my $class = shift;
807 1010
808 # TODO: user_x, user_y, overwrite moveto? 1011 $class->SUPER::new (
1012 bg => undef,
1013 @_,
1014 )
1015}
1016
1017sub _draw {
1018 my ($self) = @_;
1019
1020 if ($self->{bg}) {
1021 my ($w, $h) = @$self{qw(w h)};
1022
1023 glEnable GL_BLEND;
1024 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1025 glColor @{ $self->{bg} };
1026
1027 glBegin GL_QUADS;
1028 glVertex 0 , 0;
1029 glVertex 0 , $h;
1030 glVertex $w, $h;
1031 glVertex $w, 0;
1032 glEnd;
1033
1034 glDisable GL_BLEND;
1035 }
1036
1037 $self->SUPER::_draw;
1038}
1039
1040#############################################################################
1041
1042package CFClient::UI::FancyFrame;
1043
1044our @ISA = CFClient::UI::Bin::;
1045
1046use CFClient::OpenGL;
1047
1048my $bg =
1049 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1050 mipmap => 1, wrap => 1;
1051
1052my @border =
1053 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1054 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1055
1056sub new {
1057 my ($class, %arg) = @_;
1058
1059 my $title = delete $arg{title};
809 1060
810 my $self = $class->SUPER::new ( 1061 my $self = $class->SUPER::new (
811 bg => [1, 1, 1, 1], 1062 bg => [1, 1, 1, 1],
812 border_bg => [1, 1, 1, 1], 1063 border_bg => [1, 1, 1, 1],
813 border => 0.6, 1064 border => 0.6,
814 can_events => 1, 1065 can_events => 1,
815 @_ 1066 min_w => 16,
1067 min_h => 16,
1068 %arg,
816 ); 1069 );
817 1070
818 $self->{title} &&= new CFClient::UI::Label 1071 $self->{title} = new CFClient::UI::Label
819 align => 0, 1072 align => 0,
820 valign => 1, 1073 valign => 1,
821 text => $self->{title}, 1074 text => $title,
822 fontsize => $self->{border}; 1075 fontsize => $self->{border}
1076 if defined $title;
823 1077
824 $self 1078 $self
1079}
1080
1081sub add {
1082 my ($self, @widgets) = @_;
1083
1084 $self->SUPER::add (@widgets);
1085 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
825} 1086}
826 1087
827sub border { 1088sub border {
828 int $_[0]{border} * $::FONTSIZE 1089 int $_[0]{border} * $::FONTSIZE
829} 1090}
830 1091
831sub size_request { 1092sub size_request {
832 my ($self) = @_; 1093 my ($self) = @_;
1094
1095 $self->{title}->size_request
1096 if $self->{title};
833 1097
834 my ($w, $h) = $self->SUPER::size_request; 1098 my ($w, $h) = $self->SUPER::size_request;
835 1099
836 ( 1100 (
837 $w + $self->border * 2, 1101 $w + $self->border * 2,
… …
840} 1104}
841 1105
842sub size_allocate { 1106sub size_allocate {
843 my ($self, $w, $h) = @_; 1107 my ($self, $w, $h) = @_;
844 1108
1109 if ($self->{title}) {
1110 $self->{title}{w} = $w;
1111 $self->{title}{h} = $h;
1112 $self->{title}->size_allocate ($w, $h);
1113 }
1114
1115 my $border = $self->border;
1116
845 $h -= List::Util::max 0, $self->border * 2; 1117 $h -= List::Util::max 0, $border * 2;
846 $w -= List::Util::max 0, $self->border * 2; 1118 $w -= List::Util::max 0, $border * 2;
847 1119
848 $self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)
849 if $self->{title};
850
851 $self->child->configure ($self->border, $self->border, $w, $h); 1120 $self->child->configure ($border, $border, $w, $h);
852} 1121}
853 1122
854sub button_down { 1123sub button_down {
855 my ($self, $ev, $x, $y) = @_; 1124 my ($self, $ev, $x, $y) = @_;
856 1125
… …
872 my ($ev, $x, $y) = @_; 1141 my ($ev, $x, $y) = @_;
873 1142
874 my $dx = $ev->{x} - $ox; 1143 my $dx = $ev->{x} - $ox;
875 my $dy = $ev->{y} - $oy; 1144 my $dy = $ev->{y} - $oy;
876 1145
877 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1146 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
878 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1147 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1148
1149 $self->realloc;
879 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1150 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
880 $self->check_size;
881 }; 1151 };
882 1152
883 } elsif ($lr ^ $td) { 1153 } elsif ($lr ^ $td) {
884 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1154 my ($ox, $oy) = ($ev->{x}, $ev->{y});
885 my ($bx, $by) = ($self->{x}, $self->{y}); 1155 my ($bx, $by) = ($self->{x}, $self->{y});
… …
887 $self->{motion} = sub { 1157 $self->{motion} = sub {
888 my ($ev, $x, $y) = @_; 1158 my ($ev, $x, $y) = @_;
889 1159
890 ($x, $y) = ($ev->{x}, $ev->{y}); 1160 ($x, $y) = ($ev->{x}, $ev->{y});
891 1161
892 $self->move ($bx + $x - $ox, $by + $y - $oy); 1162 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
893 $self->update;
894 }; 1163 };
1164 } else {
1165 return 0;
1166 }
1167
895 } 1168 1
896} 1169}
897 1170
898sub button_up { 1171sub button_up {
899 my ($self, $ev, $x, $y) = @_; 1172 my ($self, $ev, $x, $y) = @_;
900 1173
901 delete $self->{motion}; 1174 !!delete $self->{motion}
902} 1175}
903 1176
904sub mouse_motion { 1177sub mouse_motion {
905 my ($self, $ev, $x, $y) = @_; 1178 my ($self, $ev, $x, $y) = @_;
906 1179
907 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1180 $self->{motion}->($ev, $x, $y) if $self->{motion};
1181
1182 !!$self->{motion}
908} 1183}
909 1184
910sub _draw { 1185sub _draw {
911 my ($self) = @_; 1186 my ($self) = @_;
912 1187
1188 my $child = $self->{children}[0];
1189
913 my ($w, $h ) = ($self->{w}, $self->{h}); 1190 my ($w, $h ) = ($self->{w}, $self->{h});
914 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 1191 my ($cw, $ch) = ($child->{w}, $child->{h});
915 1192
916 glEnable GL_TEXTURE_2D; 1193 glEnable GL_TEXTURE_2D;
917 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1194 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
918 1195
919 my $border = $self->border; 1196 my $border = $self->border;
920 1197
921 glColor @{ $self->{border_bg} }; 1198 glColor @{ $self->{border_bg} };
922 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1199 $border[0]->draw_quad_alpha (0, 0, $w, $border);
923 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1200 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
924 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1201 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
925 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1202 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
926 1203
927 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1204 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
928 my $bg = $tex[0]; 1205 glColor @{ $self->{bg} };
929 1206
930 # TODO: repeat texture not scale 1207 # TODO: repeat texture not scale
1208 # solve this better(?)
931 my $rep_x = $cw / $bg->{w}; 1209 $bg->{s} = $cw / $bg->{w};
932 my $rep_y = $ch / $bg->{h}; 1210 $bg->{t} = $ch / $bg->{h};
933
934 glColor @{ $self->{bg} };
935
936 $bg->{s} = $rep_x;
937 $bg->{t} = $rep_y;
938 $bg->{wrap_mode} = 1;
939 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1211 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
940 } 1212 }
941 1213
942 glDisable GL_TEXTURE_2D; 1214 glDisable GL_TEXTURE_2D;
943 1215
944 $self->{title}->draw if $self->{title};
945
946 $self->child->draw; 1216 $child->draw;
1217
1218 if ($self->{title}) {
1219 glTranslate 0, $border - $self->{h};
1220 $self->{title}->_draw;
1221 }
947} 1222}
948 1223
949############################################################################# 1224#############################################################################
950 1225
951package CFClient::UI::Table; 1226package CFClient::UI::Table;
… …
959sub new { 1234sub new {
960 my $class = shift; 1235 my $class = shift;
961 1236
962 $class->SUPER::new ( 1237 $class->SUPER::new (
963 col_expand => [], 1238 col_expand => [],
964 @_ 1239 @_,
965 ) 1240 )
1241}
1242
1243sub children {
1244 grep $_, map @$_, grep $_, @{ $_[0]{children} }
966} 1245}
967 1246
968sub add { 1247sub add {
969 my ($self, $x, $y, $child) = @_; 1248 my ($self, $x, $y, $child) = @_;
970 1249
971 $child->set_parent ($self); 1250 $child->set_parent ($self);
972 $self->{children}[$y][$x] = $child; 1251 $self->{children}[$y][$x] = $child;
973 1252
974 $child->check_size; 1253 $self->realloc;
975} 1254}
976 1255
977sub children {
978 grep $_, map @$_, grep $_, @{ $_[0]{children} }
979}
980
981# TODO: move to container class maybe? send childs a signal on removal? 1256# TODO: move to container class maybe? send children a signal on removal?
982sub clear { 1257sub clear {
983 my ($self) = @_; 1258 my ($self) = @_;
984 1259
985 my @children = $self->children; 1260 my @children = $self->children;
986 delete $self->{children}; 1261 delete $self->{children};
… …
988 for (@children) { 1263 for (@children) {
989 delete $_->{parent}; 1264 delete $_->{parent};
990 $_->hide; 1265 $_->hide;
991 } 1266 }
992 1267
993 $self->update; 1268 $self->realloc;
994} 1269}
995 1270
996sub get_wh { 1271sub get_wh {
997 my ($self) = @_; 1272 my ($self) = @_;
998 1273
… …
1029sub size_allocate { 1304sub size_allocate {
1030 my ($self, $w, $h) = @_; 1305 my ($self, $w, $h) = @_;
1031 1306
1032 my ($ws, $hs) = $self->get_wh; 1307 my ($ws, $hs) = $self->get_wh;
1033 1308
1034 my $req_w = sum @$ws; 1309 my $req_w = (sum @$ws) || 1;
1035 my $req_h = sum @$hs; 1310 my $req_h = (sum @$hs) || 1;
1036 1311
1037 # TODO: nicer code && do row_expand 1312 # TODO: nicer code && do row_expand
1038 my @col_expand = @{$self->{col_expand}}; 1313 my @col_expand = @{$self->{col_expand}};
1039 @col_expand = (1) x @$ws unless @col_expand; 1314 @col_expand = (1) x @$ws unless @col_expand;
1040 my $col_expand = (sum @col_expand) || 1; 1315 my $col_expand = (sum @col_expand) || 1;
… …
1094 } 1369 }
1095} 1370}
1096 1371
1097############################################################################# 1372#############################################################################
1098 1373
1099package CFClient::UI::HBox; 1374package CFClient::UI::Box;
1100
1101# TODO: wrap into common Box base class
1102 1375
1103our @ISA = CFClient::UI::Container::; 1376our @ISA = CFClient::UI::Container::;
1104 1377
1105sub size_request { 1378sub size_request {
1106 my ($self) = @_; 1379 my ($self) = @_;
1107 1380
1108 my @alloc = map [$_->size_request], @{$self->{children}}; 1381 $self->{vertical}
1109 1382 ? (
1110 ( 1383 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1111 (List::Util::sum map $_->[0], @alloc), 1384 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1112 (List::Util::max map $_->[1], @alloc), 1385 )
1113 ) 1386 : (
1387 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1388 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1389 )
1114} 1390}
1115 1391
1116sub size_allocate { 1392sub size_allocate {
1117 my ($self, $w, $h) = @_; 1393 my ($self, $w, $h) = @_;
1118 1394
1119 ($h, $w) = ($w, $h); 1395 my $space = $self->{vertical} ? $h : $w;
1120
1121 my $children = $self->{children}; 1396 my $children = $self->{children};
1122 1397
1123 my @h = map $_->{req_w}, @$children; 1398 my @req;
1124 1399
1125 my $req_h = List::Util::sum @h; 1400 if ($self->{homogeneous}) {
1126 1401 @req = ($space / (@$children || 1)) x @$children;
1127 if ($req_h > $h) {
1128 # ah well, not enough space
1129 $_ *= $h / $req_h for @h;
1130 } else { 1402 } else {
1403 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1404 my $req = List::Util::sum @req;
1405
1406 if ($req > $space) {
1407 # ah well, not enough space
1408 $_ *= $space / $req for @req;
1409 } else {
1131 my $exp = List::Util::sum map $_->{expand}, @$children; 1410 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1132 $exp ||= 1;
1133 1411
1412 $space = ($space - $req) / $expand; # remaining space to give away
1413
1414 $req[$_] += $space * $children->[$_]{expand}
1134 for (0 .. $#$children) { 1415 for 0 .. $#$children;
1135 my $child = $children->[$_];
1136
1137 my $alloc_h = $h[$_];
1138 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1139 $h[$_] = $alloc_h;
1140 } 1416 }
1141 } 1417 }
1142 1418
1143 CFClient::UI::harmonize \@h; 1419 CFClient::UI::harmonize \@req;
1144 1420
1145 my $y = 0; 1421 my $pos = 0;
1146 for (0 .. $#$children) { 1422 for (0 .. $#$children) {
1147 my $child = $children->[$_];
1148 my $h = $h[$_]; 1423 my $alloc = $req[$_];
1149 $child->configure ($y, 0, $h, $w); 1424 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1150 1425
1151 $y += $h; 1426 $pos += $alloc;
1152 } 1427 }
1153 1428
1154 1 1429 1
1155} 1430}
1156 1431
1157############################################################################# 1432#############################################################################
1158 1433
1434package CFClient::UI::HBox;
1435
1436our @ISA = CFClient::UI::Box::;
1437
1438sub new {
1439 my $class = shift;
1440
1441 $class->SUPER::new (
1442 vertical => 0,
1443 @_,
1444 )
1445}
1446
1447#############################################################################
1448
1159package CFClient::UI::VBox; 1449package CFClient::UI::VBox;
1160 1450
1161# TODO: wrap into common Box base class
1162
1163our @ISA = CFClient::UI::Container::; 1451our @ISA = CFClient::UI::Box::;
1164 1452
1165sub size_request { 1453sub new {
1166 my ($self) = @_; 1454 my $class = shift;
1167 1455
1168 my @alloc = map [$_->size_request], @{$self->{children}}; 1456 $class->SUPER::new (
1169 1457 vertical => 1,
1170 ( 1458 @_,
1171 (List::Util::max map $_->[0], @alloc),
1172 (List::Util::sum map $_->[1], @alloc),
1173 ) 1459 )
1174} 1460}
1175 1461
1176sub size_allocate {
1177 my ($self, $w, $h) = @_;
1178
1179 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1180
1181 my $children = $self->{children};
1182
1183 my @h = map $_->{req_h}, @$children;
1184
1185 my $req_h = List::Util::sum @h;
1186
1187 if ($req_h > $h) {
1188 # ah well, not enough space
1189 $_ *= $h / $req_h for @h;
1190 } else {
1191 my $exp = List::Util::sum map $_->{expand}, @$children;
1192 $exp ||= 1;
1193
1194 for (0 .. $#$children) {
1195 my $child = $children->[$_];
1196
1197 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1198 }
1199 }
1200
1201 CFClient::UI::harmonize \@h;
1202
1203 my $y = 0;
1204 for (0 .. $#$children) {
1205 my $child = $children->[$_];
1206 my $h = $h[$_];
1207 $child->configure (0, $y, $w, $h);
1208
1209 $y += $h;
1210 }
1211
1212 1
1213}
1214
1215############################################################################# 1462#############################################################################
1216 1463
1217package CFClient::UI::Label; 1464package CFClient::UI::Label;
1218 1465
1219our @ISA = CFClient::UI::Base::; 1466our @ISA = CFClient::UI::DrawBG::;
1220 1467
1221use CFClient::OpenGL; 1468use CFClient::OpenGL;
1222 1469
1223sub new { 1470sub new {
1224 my ($class, %arg) = @_; 1471 my ($class, %arg) = @_;
1225 1472
1226 my $self = $class->SUPER::new ( 1473 my $self = $class->SUPER::new (
1227 fg => [1, 1, 1], 1474 fg => [1, 1, 1],
1475 #bg => none
1476 #active_bg => none
1228 #font => default_font 1477 #font => default_font
1229 #text => initial text 1478 #text => initial text
1230 #markup => initial narkup 1479 #markup => initial narkup
1480 #max_w => maximum pixel width
1481 ellipsise => 3, # end
1231 layout => (new CFClient::Layout), 1482 layout => (new CFClient::Layout),
1232 fontsize => 1, 1483 fontsize => 1,
1233 align => -1, 1484 align => -1,
1234 valign => -1, 1485 valign => -1,
1235 padding => 2, 1486 padding_x => 2,
1487 padding_y => 2,
1236 can_events => 0, 1488 can_events => 0,
1237 %arg 1489 %arg
1238 ); 1490 );
1239 1491
1240 if (exists $self->{template}) { 1492 if (exists $self->{template}) {
… …
1250 } 1502 }
1251 1503
1252 $self 1504 $self
1253} 1505}
1254 1506
1255sub escape { 1507sub escape($) {
1256 local $_ = $_[1]; 1508 local $_ = $_[0];
1257 1509
1258 s/&/&amp;/g; 1510 s/&/&amp;/g;
1259 s/>/&gt;/g; 1511 s/>/&gt;/g;
1260 s/</&lt;/g; 1512 s/</&lt;/g;
1261 1513
1262 $_[1] 1514 $_
1263} 1515}
1264 1516
1265sub update { 1517sub update {
1266 my ($self) = @_; 1518 my ($self) = @_;
1267 1519
… …
1276 $self->{text} = "T$text"; 1528 $self->{text} = "T$text";
1277 1529
1278 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1530 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1279 $self->{layout}->set_text ($text); 1531 $self->{layout}->set_text ($text);
1280 1532
1533 $self->realloc;
1281 $self->update; 1534 $self->update;
1282 $self->check_size;
1283} 1535}
1284 1536
1285sub set_markup { 1537sub set_markup {
1286 my ($self, $markup) = @_; 1538 my ($self, $markup) = @_;
1287 1539
… …
1291 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1543 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1292 1544
1293 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1545 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1294 $self->{layout}->set_markup ($markup); 1546 $self->{layout}->set_markup ($markup);
1295 1547
1548 $self->realloc;
1296 $self->update; 1549 $self->update;
1297 $self->check_size;
1298} 1550}
1299 1551
1300sub size_request { 1552sub size_request {
1301 my ($self) = @_; 1553 my ($self) = @_;
1302 1554
1303 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1555 $self->{layout}->set_font ($self->{font}) if $self->{font};
1304 $self->{layout}->set_width ($self->{max_w} || -1); 1556 $self->{layout}->set_width ($self->{max_w} || -1);
1557 $self->{layout}->set_ellipsise ($self->{ellipsise});
1558 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1305 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1559 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1306 1560
1307 my ($w, $h) = $self->{layout}->size; 1561 my ($w, $h) = $self->{layout}->size;
1308 1562
1309 if (exists $self->{template}) { 1563 if (exists $self->{template}) {
… …
1314 1568
1315 $w = List::Util::max $w, $w2; 1569 $w = List::Util::max $w, $w2;
1316 $h = List::Util::max $h, $h2; 1570 $h = List::Util::max $h, $h2;
1317 } 1571 }
1318 1572
1319 ( 1573 ($w, $h)
1320 $w + $self->{padding} * 2,
1321 $h + $self->{padding} * 2,
1322 )
1323} 1574}
1324 1575
1325sub size_allocate { 1576sub size_allocate {
1326 my ($self, $w, $h) = @_; 1577 my ($self, $w, $h) = @_;
1327 1578
1579 delete $self->{ox};
1580
1328 delete $self->{texture}; 1581 delete $self->{texture}
1582 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1329} 1583}
1330 1584
1331sub set_fontsize { 1585sub set_fontsize {
1332 my ($self, $fontsize) = @_; 1586 my ($self, $fontsize) = @_;
1333 1587
1334 $self->{fontsize} = $fontsize; 1588 $self->{fontsize} = $fontsize;
1335 delete $self->{texture}; 1589 delete $self->{texture};
1336 1590
1337 $self->update; 1591 $self->realloc;
1338 $self->check_size;
1339} 1592}
1340 1593
1341sub _draw { 1594sub _draw {
1342 my ($self) = @_; 1595 my ($self) = @_;
1596
1597 $self->SUPER::_draw; # draw background, if applicable
1343 1598
1344 my $tex = $self->{texture} ||= do { 1599 my $tex = $self->{texture} ||= do {
1345 $self->{layout}->set_foreground (@{$self->{fg}}); 1600 $self->{layout}->set_foreground (@{$self->{fg}});
1346 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1601 $self->{layout}->set_font ($self->{font}) if $self->{font};
1347 $self->{layout}->set_width ($self->{w}); 1602 $self->{layout}->set_width ($self->{w});
1603 $self->{layout}->set_ellipsise ($self->{ellipsise});
1604 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1348 $self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE); 1605 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1349 1606
1350 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1607 new_from_layout CFClient::Texture $self->{layout}
1608 };
1351 1609
1610 unless (exists $self->{ox}) {
1352 $self->{ox} = int $self->{align} < 0 ? $self->{padding} 1611 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1353 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1612 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1354 : ($self->{w} - $tex->{w}) * 0.5; 1613 : ($self->{w} - $tex->{w}) * 0.5);
1355 1614
1356 $self->{oy} = int $self->{valign} < 0 ? $self->{padding} 1615 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1357 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1616 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1358 : ($self->{h} - $tex->{h}) * 0.5; 1617 : ($self->{h} - $tex->{h}) * 0.5);
1359
1360 $tex
1361 }; 1618 };
1362 1619
1363 glEnable GL_TEXTURE_2D; 1620 glEnable GL_TEXTURE_2D;
1364 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1621 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1365 1622
… …
1391 active_fg => [0, 0, 0], 1648 active_fg => [0, 0, 0],
1392 can_hover => 1, 1649 can_hover => 1,
1393 can_focus => 1, 1650 can_focus => 1,
1394 valign => 0, 1651 valign => 0,
1395 can_events => 1, 1652 can_events => 1,
1653 #text => ...
1396 @_ 1654 @_
1397 ) 1655 )
1398} 1656}
1399 1657
1400sub _set_text { 1658sub _set_text {
… …
1410 $self->{text} = $text; 1668 $self->{text} = $text;
1411 1669
1412 $text =~ s/./*/g if $self->{hidden}; 1670 $text =~ s/./*/g if $self->{hidden};
1413 $self->{layout}->set_text ("$text "); 1671 $self->{layout}->set_text ("$text ");
1414 1672
1415 $self->emit (changed => $self->{text}); 1673 $self->_emit (changed => $self->{text});
1416} 1674}
1417 1675
1418sub set_text { 1676sub set_text {
1419 my ($self, $text) = @_; 1677 my ($self, $text) = @_;
1420 1678
1421 $self->{cursor} = length $text; 1679 $self->{cursor} = length $text;
1422 $self->_set_text ($text); 1680 $self->_set_text ($text);
1423 $self->check_size; 1681
1424 $self->update; 1682 $self->realloc;
1425} 1683}
1426 1684
1427sub get_text { 1685sub get_text {
1428 $_[0]{text} 1686 $_[0]{text}
1429} 1687}
… …
1432 my ($self) = @_; 1690 my ($self) = @_;
1433 1691
1434 my ($w, $h) = $self->SUPER::size_request; 1692 my ($w, $h) = $self->SUPER::size_request;
1435 1693
1436 ($w + 1, $h) # add 1 for cursor 1694 ($w + 1, $h) # add 1 for cursor
1437}
1438
1439sub size_allocate {
1440 my ($self, $w, $h) = @_;
1441
1442 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1443} 1695}
1444 1696
1445sub key_down { 1697sub key_down {
1446 my ($self, $ev) = @_; 1698 my ($self, $ev) = @_;
1447 1699
… …
1449 my $sym = $ev->{sym}; 1701 my $sym = $ev->{sym};
1450 my $uni = $ev->{unicode}; 1702 my $uni = $ev->{unicode};
1451 1703
1452 my $text = $self->get_text; 1704 my $text = $self->get_text;
1453 1705
1454 if ($sym == 8) { 1706 if ($uni == 8) {
1455 substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; 1707 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1456 } elsif ($sym == 127) { 1708 } elsif ($uni == 127) {
1457 substr $text, $self->{cursor}, 1, ""; 1709 substr $text, $self->{cursor}, 1, "";
1458 } elsif ($sym == CFClient::SDLK_LEFT) { 1710 } elsif ($sym == CFClient::SDLK_LEFT) {
1459 --$self->{cursor} if $self->{cursor}; 1711 --$self->{cursor} if $self->{cursor};
1460 } elsif ($sym == CFClient::SDLK_RIGHT) { 1712 } elsif ($sym == CFClient::SDLK_RIGHT) {
1461 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 1713 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1462 } elsif ($sym == CFClient::SDLK_HOME) { 1714 } elsif ($sym == CFClient::SDLK_HOME) {
1463 $self->{cursor} = 0; 1715 $self->{cursor} = 0;
1464 } elsif ($sym == CFClient::SDLK_END) { 1716 } elsif ($sym == CFClient::SDLK_END) {
1465 $self->{cursor} = length $text; 1717 $self->{cursor} = length $text;
1466 } elsif ($sym == 27) { 1718 } elsif ($uni == 27) {
1467 $self->emit ('escape'); 1719 $self->_emit ('escape');
1468 } elsif ($uni) { 1720 } elsif ($uni) {
1469 substr $text, $self->{cursor}++, 0, chr $uni; 1721 substr $text, $self->{cursor}++, 0, chr $uni;
1722 } else {
1723 return 0;
1470 } 1724 }
1471 1725
1472 $self->_set_text ($text); 1726 $self->_set_text ($text);
1473 $self->update; 1727
1728 $self->realloc;
1729
1730 1
1474} 1731}
1475 1732
1476sub focus_in { 1733sub focus_in {
1477 my ($self) = @_; 1734 my ($self) = @_;
1478 1735
… …
1493 utf8::encode $text; 1750 utf8::encode $text;
1494 $self->{cursor} = length substr $text, 0, $idx; 1751 $self->{cursor} = length substr $text, 0, $idx;
1495 1752
1496 $self->_set_text ($self->{text}); 1753 $self->_set_text ($self->{text});
1497 $self->update; 1754 $self->update;
1755
1756 1
1498} 1757}
1499 1758
1500sub mouse_motion { 1759sub mouse_motion {
1501 my ($self, $ev, $x, $y) = @_; 1760 my ($self, $ev, $x, $y) = @_;
1502# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1761# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1762
1763 0
1503} 1764}
1504 1765
1505sub _draw { 1766sub _draw {
1506 my ($self) = @_; 1767 my ($self) = @_;
1507 1768
… …
1558 if ($sym == 13) { 1819 if ($sym == 13) {
1559 unshift @{$self->{history}}, 1820 unshift @{$self->{history}},
1560 my $txt = $self->get_text; 1821 my $txt = $self->get_text;
1561 $self->{history_pointer} = -1; 1822 $self->{history_pointer} = -1;
1562 $self->{history_saveback} = ''; 1823 $self->{history_saveback} = '';
1563 $self->emit (activate => $txt); 1824 $self->_emit (activate => $txt);
1564 $self->update; 1825 $self->update;
1565 1826
1566 } elsif ($sym == CFClient::SDLK_UP) { 1827 } elsif ($sym == CFClient::SDLK_UP) {
1567 if ($self->{history_pointer} < 0) { 1828 if ($self->{history_pointer} < 0) {
1568 $self->{history_saveback} = $self->get_text; 1829 $self->{history_saveback} = $self->get_text;
… …
1584 } else { 1845 } else {
1585 $self->set_text ($self->{history_saveback}); 1846 $self->set_text ($self->{history_saveback});
1586 } 1847 }
1587 1848
1588 } else { 1849 } else {
1589 $self->SUPER::key_down ($ev); 1850 return $self->SUPER::key_down ($ev)
1851 }
1852
1590 } 1853 1
1591
1592} 1854}
1593 1855
1594############################################################################# 1856#############################################################################
1595 1857
1596package CFClient::UI::Button; 1858package CFClient::UI::Button;
… …
1605 1867
1606sub new { 1868sub new {
1607 my $class = shift; 1869 my $class = shift;
1608 1870
1609 $class->SUPER::new ( 1871 $class->SUPER::new (
1610 padding => 4, 1872 padding_x => 4,
1873 padding_y => 4,
1611 fg => [1, 1, 1], 1874 fg => [1, 1, 1],
1612 bg => [1, 1, 1, 0.2],
1613 active_fg => [0, 0, 1], 1875 active_fg => [0, 0, 1],
1614 can_hover => 1, 1876 can_hover => 1,
1615 align => 0, 1877 align => 0,
1616 valign => 0, 1878 valign => 0,
1617 can_events => 1, 1879 can_events => 1,
1618 @_ 1880 @_
1619 ) 1881 )
1620} 1882}
1621 1883
1884sub activate { }
1885
1622sub button_up { 1886sub button_up {
1623 my ($self, $ev, $x, $y) = @_; 1887 my ($self, $ev, $x, $y) = @_;
1624 1888
1889 $self->emit ("activate")
1625 if ($x >= 0 && $x < $self->{w} 1890 if $x >= 0 && $x < $self->{w}
1626 && $y >= 0 && $y < $self->{h}) { 1891 && $y >= 0 && $y < $self->{h};
1627 $self->emit ("activate"); 1892
1628 } 1893 1
1629} 1894}
1630 1895
1631sub _draw { 1896sub _draw {
1632 my ($self) = @_; 1897 my ($self) = @_;
1633 1898
… …
1662 1927
1663sub new { 1928sub new {
1664 my $class = shift; 1929 my $class = shift;
1665 1930
1666 $class->SUPER::new ( 1931 $class->SUPER::new (
1667 padding => 2, 1932 padding_x => 2,
1933 padding_y => 2,
1668 fg => [1, 1, 1], 1934 fg => [1, 1, 1],
1669 active_fg => [1, 1, 0], 1935 active_fg => [1, 1, 0],
1936 bg => [0, 0, 0, 0.2],
1937 active_bg => [1, 1, 1, 0.5],
1670 state => 0, 1938 state => 0,
1671 can_hover => 1, 1939 can_hover => 1,
1672 @_ 1940 @_
1673 ) 1941 )
1674} 1942}
1675 1943
1676sub size_request { 1944sub size_request {
1677 my ($self) = @_; 1945 my ($self) = @_;
1678 1946
1679 ($self->{padding} * 2 + 6) x 2 1947 (6) x 2
1680} 1948}
1681 1949
1682sub button_down { 1950sub button_down {
1683 my ($self, $ev, $x, $y) = @_; 1951 my ($self, $ev, $x, $y) = @_;
1684 1952
1685 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1953 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1686 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1954 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1687 $self->{state} = !$self->{state}; 1955 $self->{state} = !$self->{state};
1688 $self->emit (changed => $self->{state}); 1956 $self->_emit (changed => $self->{state});
1957 } else {
1958 return 0
1959 }
1960
1689 } 1961 1
1690} 1962}
1691 1963
1692sub _draw { 1964sub _draw {
1693 my ($self) = @_; 1965 my ($self) = @_;
1694 1966
1695 $self->SUPER::_draw; 1967 $self->SUPER::_draw;
1696 1968
1697 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1969 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1698 1970
1699 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1971 my ($w, $h) = @$self{qw(w h)};
1972
1973 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1700 1974
1701 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1975 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1702 1976
1703 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1977 my $tex = $self->{state} ? $tex[1] : $tex[0];
1704 1978
… …
1958 qw(s1_slider.png s1_slider_bg.png); 2232 qw(s1_slider.png s1_slider_bg.png);
1959 2233
1960sub new { 2234sub new {
1961 my $class = shift; 2235 my $class = shift;
1962 2236
1963 # range [value, low, high, page] 2237 # range [value, low, high, page, unit]
1964 2238
1965 # TODO: 0-width page 2239 # TODO: 0-width page
1966 # TODO: req_w/h are wrong with vertical 2240 # TODO: req_w/h are wrong with vertical
1967 # TODO: calculations are off 2241 # TODO: calculations are off
1968 my $self = $class->SUPER::new ( 2242 my $self = $class->SUPER::new (
1969 fg => [1, 1, 1], 2243 fg => [1, 1, 1],
1970 active_fg => [0, 0, 0], 2244 active_fg => [0, 0, 0],
2245 bg => [0, 0, 0, 0.2],
2246 active_bg => [1, 1, 1, 0.5],
1971 range => [0, 0, 100, 10], 2247 range => [0, 0, 100, 10, 0],
1972 req_w => $::WIDTH / 80, 2248 min_w => $::WIDTH / 80,
1973 req_h => $::WIDTH / 80, 2249 min_h => $::WIDTH / 80,
1974 vertical => 0, 2250 vertical => 0,
1975 can_hover => 1, 2251 can_hover => 1,
1976 inner_pad => 5, 2252 inner_pad => 0.02,
1977 @_ 2253 @_
1978 ); 2254 );
1979 2255
2256 $self->set_value ($self->{range}[0]);
2257 $self->update;
2258
1980 $self 2259 $self
1981} 2260}
1982 2261
2262sub changed { }
2263
2264sub set_range {
2265 my ($self, $range) = @_;
2266
2267 ($range, $self->{range}) = ($self->{range}, $range);
2268
2269 $self->update
2270 if "@$range" ne "@{$self->{range}}";
2271}
2272
2273sub set_value {
2274 my ($self, $value) = @_;
2275
2276 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2277
2278 $hi = $lo + 1 if $hi <= $lo;
2279
2280 $page = $hi - $lo if $page > $hi - $lo;
2281
2282 $value = $lo if $value < $lo;
2283 $value = $hi - $page if $value > $hi - $page;
2284
2285 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2286 if $unit;
2287
2288 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2289
2290 if ($value != $old_value) {
2291 $self->_emit (changed => $value);
2292 $self->update;
2293 }
2294}
2295
1983sub size_request { 2296sub size_request {
1984 my ($self) = @_; 2297 my ($self) = @_;
1985 2298
1986 my $w = $self->{req_w}; 2299 ($self->{req_w}, $self->{req_h})
1987 my $h = $self->{req_h};
1988
1989 $self->{vertical} ? ($h, $w) : ($w, $h)
1990} 2300}
1991 2301
1992sub button_down { 2302sub button_down {
1993 my ($self, $ev, $x, $y) = @_; 2303 my ($self, $ev, $x, $y) = @_;
1994 2304
1995 $self->SUPER::button_down ($ev, $x, $y); 2305 $self->SUPER::button_down ($ev, $x, $y);
2306
2307 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2308
1996 $self->mouse_motion ($ev, $x, $y); 2309 $self->mouse_motion ($ev, $x, $y)
1997} 2310}
1998 2311
1999sub mouse_motion { 2312sub mouse_motion {
2000 my ($self, $ev, $x, $y) = @_; 2313 my ($self, $ev, $x, $y) = @_;
2001 2314
2002 if ($GRAB == $self) { 2315 if ($GRAB == $self) {
2316 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2317
2318 my (undef, $lo, $hi, $page) = @{$self->{range}};
2319
2320 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2321
2322 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2323 } else {
2324 return 0;
2325 }
2326
2327 1
2328}
2329
2330sub update {
2331 my ($self) = @_;
2332
2333 $CFClient::UI::ROOT->on_post_alloc ($self => sub {
2334 $self->set_value ($self->{range}[0]);
2335
2003 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2336 my ($value, $lo, $hi, $page) = @{$self->{range}};
2337 my $range = ($hi - $page - $lo) || 1e-100;
2004 2338
2005 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2339 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2006 2340
2007 my $inner_pad_px = $self->_calc_inner_pad_px ($w); 2341 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2008 my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right 2342 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2009 2343
2010 $x -= $inner_pad_px; # substract the padding 2344 $value = ($value - $lo) / $range;
2011 $x = $x * ($hi - $lo) / $inner_w + $lo; 2345 $value = $value * $self->{scale} + $self->{offset};
2012 $x = $lo if $x < $lo;
2013 $x = $hi - $page if $x > $hi - $page;
2014 $self->{range}[0] = $x;
2015 2346
2016 $self->emit (changed => $x); 2347 $self->{knob_x} = $value - $knob_w * 0.5;
2017 $self->update; 2348 $self->{knob_w} = $knob_w;
2018 } 2349 });
2019}
2020 2350
2021# the inner_* stuff is for generating a padding for the slider handle, 2351 $self->SUPER::update;
2022# so that the handle doesn't leave the texture. This calculation isn't 100%
2023# correct propably, but it does the job for now
2024sub _calc_inner_pad_px {
2025 my ($self, $w) = @_;
2026 ($w / 100) * $self->{inner_pad} # % to pixels
2027} 2352}
2028 2353
2029sub _draw { 2354sub _draw {
2030 my ($self) = @_; 2355 my ($self) = @_;
2031 2356
2032 $self->SUPER::_draw (); 2357 $self->SUPER::_draw ();
2033 2358
2034 my ($w, $h) = @$self{qw(w h)}; 2359 glScale $self->{w}, $self->{h};
2035 2360
2036 if ($self->{vertical}) { 2361 if ($self->{vertical}) {
2037 # draw a vertical slider like a rotated horizontal slider 2362 # draw a vertical slider like a rotated horizontal slider
2038 2363
2364 glTranslate 1, 0, 0;
2039 glRotate 90, 0, 0, 1; 2365 glRotate 90, 0, 0, 1;
2040 glTranslate 0, -$self->{w}, 0;
2041
2042 ($w, $h) = ($h, $w);
2043 } 2366 }
2044 2367
2045 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg}; 2368 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2046 my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg}; 2369 my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2047 2370
2048 my ($value, $lo, $hi, $page) = @{$self->{range}};
2049
2050 $hi = $value + 1 if $lo == $hi;
2051
2052 my $inner_pad_px = $self->_calc_inner_pad_px ($w);
2053 my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
2054
2055 $page = int $page * $inner_w / ($hi - $lo);
2056 $value = int +($value - $lo) * $inner_w / ($hi - $lo);
2057
2058 $w -= $page;
2059 $page &= ~1;
2060 glTranslate $page * 0.5, 0, 0;
2061 $page ||= 2;
2062
2063 my $knob_a = $inner_pad_px + ($value - $page * 0.5);
2064 my $knob_b = $inner_pad_px + ($value + $page * 0.5);
2065
2066 glEnable GL_TEXTURE_2D; 2371 glEnable GL_TEXTURE_2D;
2067 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2372 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2068 2373
2069 # draw background 2374 # draw background
2070 $tex[1]->draw_quad_alpha (0, 0, $w, $h); 2375 $tex[1]->draw_quad_alpha (0, 0, 1, 1);
2071 2376
2072 # draw handle 2377 # draw handle
2073 $tex[0]->draw_quad_alpha ($knob_a, 0, $knob_b - $knob_a, $h); 2378 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2074 2379
2075 glDisable GL_TEXTURE_2D; 2380 glDisable GL_TEXTURE_2D;
2076} 2381}
2382
2383#############################################################################
2384
2385package CFClient::UI::ValSlider;
2386
2387our @ISA = CFClient::UI::HBox::;
2388
2389sub new {
2390 my ($class, %arg) = @_;
2391
2392 my $range = delete $arg{range};
2393
2394 my $self = $class->SUPER::new (
2395 slider => (new CFClient::UI::Slider expand => 1, range => $range),
2396 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
2397 to_value => sub { shift },
2398 from_value => sub { shift },
2399 %arg,
2400 );
2401
2402 $self->{slider}->connect (changed => sub {
2403 my ($self, $value) = @_;
2404 $self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
2405 $self->{parent}->emit (changed => $value);
2406 });
2407
2408# $self->{entry}->connect (changed => sub {
2409# my ($self, $value) = @_;
2410# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
2411# $self->{parent}->emit (changed => $value);
2412# });
2413
2414 $self->add ($self->{slider}, $self->{entry});
2415
2416 $self->{slider}->emit (changed => $self->{slider}{range}[0]);
2417
2418 $self
2419}
2420
2421sub set_range { shift->{slider}->set_range (@_) }
2422sub set_value { shift->{slider}->set_value (@_) }
2077 2423
2078############################################################################# 2424#############################################################################
2079 2425
2080package CFClient::UI::TextView; 2426package CFClient::UI::TextView;
2081 2427
… …
2111 2457
2112 $self->{fontsize} = $fontsize; 2458 $self->{fontsize} = $fontsize;
2113 $self->reflow; 2459 $self->reflow;
2114} 2460}
2115 2461
2116sub text_height {
2117 my ($self, $text) = @_;
2118
2119 my $layout = $self->{layout};
2120
2121 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2122 $layout->set_width ($self->{children}[0]{w});
2123 $layout->set_markup ($text);
2124
2125 ($layout->size)[1]
2126}
2127
2128sub reflow {
2129 my ($self) = @_;
2130
2131 $self->{need_reflow}++;
2132 $self->update;
2133}
2134
2135sub size_allocate { 2462sub size_allocate {
2136 my ($self, $w, $h) = @_; 2463 my ($self, $w, $h) = @_;
2137 2464
2138 $self->SUPER::size_allocate ($w, $h); 2465 $self->SUPER::size_allocate ($w, $h);
2139 2466
… …
2142 $self->{layout}->set_width ($self->{children}[0]{w}); 2469 $self->{layout}->set_width ($self->{children}[0]{w});
2143 2470
2144 $self->reflow; 2471 $self->reflow;
2145} 2472}
2146 2473
2474sub text_size {
2475 my ($self, $text, $indent) = @_;
2476
2477 my $layout = $self->{layout};
2478
2479 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2480 $layout->set_width ($self->{children}[0]{w} - $indent);
2481 $layout->set_markup ($text);
2482
2483 $layout->size
2484}
2485
2486sub reflow {
2487 my ($self) = @_;
2488
2489 $self->{need_reflow}++;
2490 $self->update;
2491}
2492
2493sub set_offset {
2494 my ($self, $offset) = @_;
2495
2496 # todo: base offset on lines or so, not on pixels
2497 $self->{children}[1]->set_value ($offset);
2498}
2499
2500sub clear {
2501 my ($self) = @_;
2502
2503 $self->{par} = [];
2504 $self->{height} = 0;
2505 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2506}
2507
2147sub add_paragraph { 2508sub add_paragraph {
2148 my ($self, $color, $text) = @_; 2509 my ($self, $color, $text, $indent) = @_;
2149 2510
2150 #TODO: intelligently "reformat" paragraph 2511 for my $line (split /\n/, $text) {
2151 2512 my ($w, $h) = $self->text_size ($line);
2152 my $height = $self->text_height ($text);
2153
2154 $self->{height} += $height; 2513 $self->{height} += $h;
2514 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2515 }
2155 2516
2156 push @{$self->{par}}, [$height, $color, $text];
2157
2158 $self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}]; 2517 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2159 $self->{children}[1]->update;
2160} 2518}
2161 2519
2162sub update { 2520sub update {
2163 my ($self) = @_; 2521 my ($self) = @_;
2164 2522
… …
2167 return unless $self->{h} > 0; 2525 return unless $self->{h} > 0;
2168 2526
2169 delete $self->{texture}; 2527 delete $self->{texture};
2170 2528
2171 $ROOT->on_post_alloc ($self, sub { 2529 $ROOT->on_post_alloc ($self, sub {
2530 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2531
2172 if (delete $self->{need_reflow}) { 2532 if (delete $self->{need_reflow}) {
2173 my $height = 0; 2533 my $height = 0;
2174 2534
2175 $height += $_->[0] = $self->text_height ($_->[2]) 2535 my $layout = $self->{layout};
2536
2537 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2538
2176 for @{$self->{par}}; 2539 for (@{$self->{par}}) {
2540 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2541 $layout->set_width ($W - $_->[3]);
2542 $layout->set_markup ($_->[4]);
2543 my ($w, $h) = $layout->size;
2544 $_->[0] = $w + $_->[3];
2545 $_->[1] = $h;
2546 }
2547
2548 $height += $_->[1];
2549 }
2177 2550
2178 $self->{height} = $height; 2551 $self->{height} = $height;
2179 2552
2180 $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}]; 2553 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2181 2554
2182 delete $self->{texture}; 2555 delete $self->{texture};
2183 } 2556 }
2184 2557
2185 $self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub { 2558 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2186 glClearColor 0, 0, 0, 0; 2559 glClearColor 0.5, 0.5, 0.5, 0;
2187 glClear GL_COLOR_BUFFER_BIT; 2560 glClear GL_COLOR_BUFFER_BIT;
2188 2561
2189 glEnable GL_TEXTURE_2D;
2190 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2191
2192 my $top = int $self->{children}[1]{range}[0]; 2562 my $top = int $self->{children}[1]{range}[0];
2193 2563
2194 my $y0 = $top; 2564 my $y0 = $top;
2195 my $y1 = $top + $self->{h}; 2565 my $y1 = $top + $H;
2196 2566
2197 my $y = 0; 2567 my $y = 0;
2198 2568
2199 my $layout = $self->{layout}; 2569 my $layout = $self->{layout};
2200 2570
2201 $layout->set_font ($self->{font}) if $self->{font}; 2571 $layout->set_font ($self->{font}) if $self->{font};
2202 2572
2573 glEnable GL_BLEND;
2574 #TODO# not correct in windows where rgba is forced off
2575 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2576
2203 for my $par (@{$self->{par}}) { 2577 for my $par (@{$self->{par}}) {
2204 my $h = $par->[0]; 2578 my $h = $par->[1];
2205 2579
2206 if ($y0 < $y + $h && $y < $y1) { 2580 if ($y0 < $y + $h && $y < $y1) {
2207 $layout->set_foreground (@{ $par->[1] }); 2581 $layout->set_foreground (@{ $par->[2] });
2582 $layout->set_width ($W - $par->[3]);
2208 $layout->set_markup ($par->[2]); 2583 $layout->set_markup ($par->[4]);
2209 2584
2210 my ($W, $H) = $layout->size; 2585 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2211 CFClient::Texture->new_from_layout ($layout)->draw_quad_alpha_premultiplied (0, $y - $y0); 2586
2587 glRasterPos $par->[3], $y - $y0;
2588 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2212 } 2589 }
2213 2590
2214 $y += $h; 2591 $y += $h;
2215 } 2592 }
2216 2593
2217 glDisable GL_TEXTURE_2D; 2594 glDisable GL_BLEND;
2218 }; 2595 };
2219 }); 2596 });
2220} 2597}
2221 2598
2222sub _draw { 2599sub _draw {
2223 my ($self) = @_; 2600 my ($self) = @_;
2224 2601
2225 glEnable GL_TEXTURE_2D; 2602 glEnable GL_TEXTURE_2D;
2226 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2603 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2227 glColor 1, 1, 1, 1; 2604 glColor 1, 1, 1, 1;
2228 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2605 $self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2229 glDisable GL_TEXTURE_2D; 2606 glDisable GL_TEXTURE_2D;
2230 2607
2231 $self->{children}[1]->draw; 2608 $self->{children}[1]->draw;
2232 2609
2233} 2610}
… …
2282 2659
2283sub new { 2660sub new {
2284 my $class = shift; 2661 my $class = shift;
2285 2662
2286 my $self = $class->SUPER::new ( 2663 my $self = $class->SUPER::new (
2287 state => 0, 2664 state => 0,
2288 connect_activate => \&toggle_flopper, 2665 on_activate => \&toggle_flopper,
2289 @_ 2666 @_
2290 ); 2667 );
2291 2668
2292 if ($self->{state}) {
2293 $self->{state} = 0;
2294 $self->toggle_flopper;
2295 }
2296
2297 $self 2669 $self
2298} 2670}
2299 2671
2300sub toggle_flopper { 2672sub toggle_flopper {
2301 my ($self) = @_; 2673 my ($self) = @_;
2302 2674
2303 # TODO: use animation 2675 $self->{other}->toggle_visibility;
2304 if ($self->{state} = !$self->{state}) {
2305 $CFClient::UI::ROOT->add ($self->{other});
2306 $self->{other}->move ($self->coord2global (0, $self->{h}));
2307 $self->emit ("open");
2308 } else {
2309 $CFClient::UI::ROOT->remove ($self->{other});
2310 $self->emit ("close");
2311 }
2312
2313 $self->emit (changed => $self->{state});
2314} 2676}
2315 2677
2316############################################################################# 2678#############################################################################
2317 2679
2318package CFClient::UI::Tooltip; 2680package CFClient::UI::Tooltip;
… …
2331} 2693}
2332 2694
2333sub set_tooltip_from { 2695sub set_tooltip_from {
2334 my ($self, $widget) = @_; 2696 my ($self, $widget) = @_;
2335 2697
2698 my $tooltip = $widget->{tooltip};
2699
2700 if ($ENV{CFPLUS_DEBUG} & 2) {
2701 $tooltip .= "\n\n" . (ref $widget) . "\n"
2702 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2703 . "req $widget->{req_w} $widget->{req_h}\n"
2704 . "visible $widget->{visible}";
2705 }
2706
2336 $self->add (new CFClient::UI::Label 2707 $self->add (new CFClient::UI::Label
2337 markup => $widget->{tooltip}, 2708 markup => $tooltip,
2338 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2709 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2339 fontsize => 0.8, 2710 fontsize => 0.8,
2340 fg => [0, 0, 0, 1], 2711 fg => [0, 0, 0, 1],
2712 ellipsise => 0,
2341 font => ($widget->{tooltip_font} || $::FONT_PROP), 2713 font => ($widget->{tooltip_font} || $::FONT_PROP),
2342 ); 2714 );
2343} 2715}
2344 2716
2345sub size_request { 2717sub size_request {
2346 my ($self) = @_; 2718 my ($self) = @_;
… …
2352 2724
2353sub size_allocate { 2725sub size_allocate {
2354 my ($self, $w, $h) = @_; 2726 my ($self, $w, $h) = @_;
2355 2727
2356 $self->SUPER::size_allocate ($w - 4, $h - 4); 2728 $self->SUPER::size_allocate ($w - 4, $h - 4);
2729}
2730
2731sub visibility_change {
2732 my ($self, $visible) = @_;
2733
2734 return unless $visible;
2735
2736 $self->{root}->on_post_alloc ("move_$self" => sub {
2737 my $widget = $self->{owner}
2738 or return;
2739
2740 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2741
2742 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2743 if $x + $self->{w} > $::WIDTH;
2744
2745 $self->move_abs ($x, $y);
2746 });
2357} 2747}
2358 2748
2359sub _draw { 2749sub _draw {
2360 my ($self) = @_; 2750 my ($self) = @_;
2361 2751
… …
2378 glVertex $w, $h; 2768 glVertex $w, $h;
2379 glVertex $w, 0; 2769 glVertex $w, 0;
2380 glEnd; 2770 glEnd;
2381 2771
2382 glTranslate 2 - 0.375, 2 - 0.375; 2772 glTranslate 2 - 0.375, 2 - 0.375;
2773
2383 $self->SUPER::_draw; 2774 $self->SUPER::_draw;
2384} 2775}
2385 2776
2386############################################################################# 2777#############################################################################
2387 2778
… …
2392use CFClient::OpenGL; 2783use CFClient::OpenGL;
2393 2784
2394sub new { 2785sub new {
2395 my $class = shift; 2786 my $class = shift;
2396 2787
2397 $class->SUPER::new ( 2788 my $self = $class->SUPER::new (
2398 aspect => 1, 2789 aspect => 1,
2790 can_events => 0,
2399 @_, 2791 @_,
2400 ) 2792 );
2793
2794 if ($self->{anim} && $self->{animspeed}) {
2795 Scalar::Util::weaken (my $widget = $self);
2796
2797 $self->{timer} = Event->timer (
2798 at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2799 hard => 1,
2800 interval => $self->{animspeed},
2801 cb => sub {
2802 ++$widget->{frame};
2803 $widget->update;
2804 },
2805 );
2806 }
2807
2808 $self
2401} 2809}
2402 2810
2403sub size_request { 2811sub size_request {
2404 (32, 8) 2812 (32, 8)
2405} 2813}
2406 2814
2815sub update {
2816 my ($self) = @_;
2817
2818 return unless $self->{visible};
2819
2820 $self->SUPER::update;
2821}
2822
2407sub _draw { 2823sub _draw {
2408 my ($self) = @_; 2824 my ($self) = @_;
2409 2825
2410 return unless $::CONN;#d# manage and cache textures differently 2826 return unless $::CONN;
2827
2828 my $face;
2829
2830 if ($self->{frame}) {
2831 my $anim = $::CONN->{anim}[$self->{anim}];
2832
2833 $face = $anim->[ $self->{frame} % @$anim ]
2834 if $anim && @$anim;
2835 }
2836
2411 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]]; 2837 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2412 2838
2413 # TODO animation
2414 if ($tex) { 2839 if ($tex) {
2415 glEnable GL_TEXTURE_2D; 2840 glEnable GL_TEXTURE_2D;
2416 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2841 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2417 glColor 1, 1, 1, 1; 2842 glColor 1, 1, 1, 1;
2418 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 2843 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2419 glDisable GL_TEXTURE_2D; 2844 glDisable GL_TEXTURE_2D;
2420 } 2845 }
2421} 2846}
2422 2847
2423############################################################################# 2848sub DESTROY {
2424
2425package CFClient::UI::InventoryItem;
2426
2427our @ISA = CFClient::UI::HBox::;
2428
2429sub new {
2430 my $class = shift;
2431
2432 my %args = @_;
2433
2434 my $item = delete $args{item};
2435
2436 my $desc = $item->{nrof} < 2
2437 ? $item->{name}
2438 : "$item->{nrof} $item->{name_pl}";
2439
2440
2441 my $self = $class->SUPER::new (
2442 can_hover => 1,
2443 can_events => 1,
2444 tooltip => (CFClient::UI::Label->escape ($desc)
2445 . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
2446 connect_button_down => sub {
2447 my ($self, $ev, $x, $y) = @_;
2448
2449 # todo: maybe put examine on 1? but should just be a tooltip :(
2450 if ($ev->{button} == 1) {
2451 $::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
2452 } elsif ($ev->{button} == 2) {
2453 $::CONN->send ("apply $item->{tag}");
2454 } elsif ($ev->{button} == 3) {
2455 CFClient::UI::Menu->new (
2456 items => [
2457 ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2458 [
2459 $item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
2460 sub { $::CONN->send ("lock $item->{tag}") },
2461 ],
2462 ["mark", sub { $::CONN->send ("mark $item->{tag}") }],
2463 ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2464 ["drop", sub { $::CONN->send ("move 0 $item->{tag} 0") }],
2465 ],
2466 )->popup ($ev);
2467 }
2468
2469 1
2470 },
2471 %args
2472 );
2473
2474 $self->add (new CFClient::UI::Face
2475 can_events => 0,
2476 face => $item->{face},
2477 anim => $item->{anim},
2478 animspeed => $item->{animspeed},
2479 );
2480
2481 $self->add (new CFClient::UI::Label
2482 can_events => 0,
2483 text => $desc,
2484 );
2485
2486 $self
2487}
2488
2489#############################################################################
2490
2491package CFClient::UI::Inventory;
2492
2493our @ISA = CFClient::UI::ScrolledWindow::;
2494
2495sub new {
2496 my $class = shift;
2497
2498 my $self = $class->SUPER::new (
2499 scrolled => (new CFClient::UI::VBox),
2500 @_,
2501 );
2502
2503 $self
2504}
2505
2506sub set_items {
2507 my ($self, $items) = @_; 2849 my ($self) = @_;
2508 2850
2509 $self->{scrolled}->clear; 2851 $self->{timer}->cancel
2510 return unless $items; 2852 if $self->{timer};
2511 2853
2512 my @items = sort { $a->{type} <=> $b->{type} } @$items; 2854 $self->SUPER::DESTROY;
2513
2514 $self->{real_items} = \@items;
2515
2516 for my $item (@items) {
2517 my $desc = $item->{nrof} < 2
2518 ? $item->{name}
2519 : "$item->{nrof} $item->{name_pl}";
2520
2521 $self->{scrolled}->add ($item->{widget} ||= new CFClient::UI::InventoryItem item => $item);
2522 }
2523
2524# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2525}
2526
2527sub size_request {
2528 my ($self) = @_;
2529 ($self->{req_w}, $self->{req_h});
2530} 2855}
2531 2856
2532############################################################################# 2857#############################################################################
2533 2858
2534package CFClient::UI::Menu; 2859package CFClient::UI::Menu;
… …
2569 2894
2570# popup given the event (must be a mouse button down event currently) 2895# popup given the event (must be a mouse button down event currently)
2571sub popup { 2896sub popup {
2572 my ($self, $ev) = @_; 2897 my ($self, $ev) = @_;
2573 2898
2574 $self->emit ("popdown"); 2899 $self->_emit ("popdown");
2575 2900
2576 # maybe save $GRAB? must be careful about events... 2901 # maybe save $GRAB? must be careful about events...
2577 $GRAB = $self; 2902 $GRAB = $self;
2578 $self->{button} = $ev->{button}; 2903 $self->{button} = $ev->{button};
2579 2904
2580 $self->show; 2905 $self->show;
2581 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2906 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2582} 2907}
2583 2908
2584sub mouse_motion { 2909sub mouse_motion {
2585 my ($self, $ev, $x, $y) = @_; 2910 my ($self, $ev, $x, $y) = @_;
2586 2911
2587 # TODO: should use vbox->find_widget or so 2912 # TODO: should use vbox->find_widget or so
2588 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 2913 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2589 $self->{hover} = $self->{item}{$HOVER}; 2914 $self->{hover} = $self->{item}{$HOVER};
2915
2916 0
2590} 2917}
2591 2918
2592sub button_up { 2919sub button_up {
2593 my ($self, $ev, $x, $y) = @_; 2920 my ($self, $ev, $x, $y) = @_;
2594 2921
2595 if ($ev->{button} == $self->{button}) { 2922 if ($ev->{button} == $self->{button}) {
2596 undef $GRAB; 2923 undef $GRAB;
2597 $self->hide; 2924 $self->hide;
2598 2925
2599 $self->emit ("popdown"); 2926 $self->_emit ("popdown");
2600 $self->{hover}[1]->() if $self->{hover}; 2927 $self->{hover}[1]->() if $self->{hover};
2928 } else {
2929 return 0
2930 }
2931
2601 } 2932 1
2602} 2933}
2603 2934
2604############################################################################# 2935#############################################################################
2605 2936
2606package CFClient::UI::Statusbox; 2937package CFClient::UI::Statusbox;
2607 2938
2608our @ISA = CFClient::UI::VBox::; 2939our @ISA = CFClient::UI::VBox::;
2940
2941sub new {
2942 my $class = shift;
2943
2944 $class->SUPER::new (
2945 fontsize => 0.8,
2946 @_,
2947 )
2948}
2609 2949
2610sub reorder { 2950sub reorder {
2611 my ($self) = @_; 2951 my ($self) = @_;
2612 my $NOW = time; 2952 my $NOW = time;
2613 2953
… …
2632 ? "<b>$item->{count} ×</b> $item->{text}" 2972 ? "<b>$item->{count} ×</b> $item->{text}"
2633 : $item->{text}; 2973 : $item->{text};
2634 2974
2635 for ($short) { 2975 for ($short) {
2636 s/^\s+//; 2976 s/^\s+//;
2637 s/\012.*/…/s; 2977 s/\s+/ /g;
2638 my $len = int 40 / $item->{fontsize};
2639 substr $_, $len, length, "…" if $len < length;
2640 } 2978 }
2641 2979
2642 new CFClient::UI::Label 2980 new CFClient::UI::Label
2643 markup => $short, 2981 markup => $short,
2644 tooltip => $item->{tooltip}, 2982 tooltip => $item->{tooltip},
2645 tooltip_font => $::FONT_PROP, 2983 tooltip_font => $::FONT_PROP,
2646 tooltip_width => 0.67, 2984 tooltip_width => 0.67,
2647 fontsize => $item->{fontsize}, 2985 fontsize => $item->{fontsize} || $self->{fontsize},
2986 max_w => $::WIDTH * 0.44,
2648 color => $item->{color}, 2987 fg => $item->{fg},
2649 can_events => 1, 2988 can_events => 1,
2650 can_hover => 1 2989 can_hover => 1
2651 }; 2990 };
2652 } 2991 }
2653 2992
… …
2658sub add { 2997sub add {
2659 my ($self, $text, %arg) = @_; 2998 my ($self, $text, %arg) = @_;
2660 2999
2661 $text =~ s/^\s+//; 3000 $text =~ s/^\s+//;
2662 $text =~ s/\s+$//; 3001 $text =~ s/\s+$//;
3002
3003 return unless $text;
2663 3004
2664 my $timeout = time + ((delete $arg{timeout}) || 60); 3005 my $timeout = time + ((delete $arg{timeout}) || 60);
2665 3006
2666 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 3007 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2667 3008
… …
2679 $self->{item}{$group} = { 3020 $self->{item}{$group} = {
2680 id => ++$self->{id}, 3021 id => ++$self->{id},
2681 text => $text, 3022 text => $text,
2682 timeout => $timeout, 3023 timeout => $timeout,
2683 tooltip => $text, 3024 tooltip => $text,
2684 fontsize => 0.8,
2685 color => [0.8, 0.8, 0.8, 0.8], 3025 fg => [0.8, 0.8, 0.8, 0.8],
2686 pri => 0, 3026 pri => 0,
2687 count => 1, 3027 count => 1,
2688 %arg, 3028 %arg,
2689 }; 3029 };
2690 } 3030 }
2691 3031
2692 $self->reorder; 3032 $self->reorder;
2693} 3033}
2694 3034
3035sub reconfigure {
3036 my ($self) = @_;
3037
3038 delete $_->{label}
3039 for values %{ $self->{item} || {} };
3040
3041 $self->reorder;
3042 $self->SUPER::reconfigure;
3043}
3044
2695############################################################################# 3045#############################################################################
2696 3046
2697package CFClient::UI::Root; 3047package CFClient::UI::Inventory;
2698 3048
2699our @ISA = CFClient::UI::Container::; 3049our @ISA = CFClient::UI::ScrolledWindow::;
2700
2701use CFClient::OpenGL;
2702 3050
2703sub new { 3051sub new {
2704 my $class = shift; 3052 my $class = shift;
2705 3053
2706 $class->SUPER::new ( 3054 my $self = $class->SUPER::new (
3055 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2707 @_, 3056 @_,
2708 ) 3057 );
2709}
2710 3058
2711sub configure { 3059 $self
3060}
3061
3062sub set_items {
3063 my ($self, $items) = @_;
3064
3065 $self->{scrolled}->clear;
3066 return unless $items;
3067
3068 my @items = sort {
3069 ($a->{type} <=> $b->{type})
3070 or ($a->{name} cmp $b->{name})
3071 } @$items;
3072
3073 $self->{real_items} = \@items;
3074
3075 my $row = 0;
3076 for my $item (@items) {
3077 CFClient::Item::update_widgets $item;
3078
3079 $self->{scrolled}->add (0, $row, $item->{face_widget});
3080 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3081 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3082
3083 $row++;
3084 }
3085}
3086
3087#############################################################################
3088
3089package CFClient::UI::BindEditor;
3090
3091our @ISA = CFClient::UI::FancyFrame::;
3092
3093sub new {
3094 my $class = shift;
3095
3096 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3097
3098 $self->add (my $vb = new CFClient::UI::VBox);
3099
3100
3101 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3102 text => "start recording",
3103 tooltip => "Start/Stops recording of actions."
3104 ."All subsequent actions after the recording started will be captured."
3105 ."The actions are displayed after the record was stopped."
3106 ."To bind the action you have to click on the 'Bind' button",
3107 on_activate => sub {
3108 unless ($self->{recording}) {
3109 $self->start;
3110 } else {
3111 $self->stop;
3112 }
3113 });
3114
3115 $vb->add (new CFClient::UI::Label text => "Actions:");
3116 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3117
3118 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3119 $vb->add (my $hb = new CFClient::UI::HBox);
3120 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3121 $hb->add (new CFClient::UI::Button
3122 text => "bind",
3123 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3124 on_activate => sub {
3125 $self->ask_for_bind;
3126 });
3127
3128 $vb->add (my $hb = new CFClient::UI::HBox);
3129 $hb->add (new CFClient::UI::Button
3130 text => "ok",
3131 expand => 1,
3132 tooltip => "This closes the binding editor and saves the binding",
3133 on_activate => sub {
3134 $self->hide;
3135 $self->commit;
3136 });
3137
3138 $hb->add (new CFClient::UI::Button
3139 text => "cancel",
3140 expand => 1,
3141 tooltip => "This closes the binding editor without saving",
3142 on_activate => sub {
3143 $self->hide;
3144 $self->{binding_cancel}->()
3145 if $self->{binding_cancel};
3146 });
3147
3148 $self->update_binding_widgets;
3149
3150 $self
3151}
3152
3153sub commit {
3154 my ($self) = @_;
3155 my ($mod, $sym, $cmds) = $self->get_binding;
3156 if ($sym != 0 && @$cmds > 0) {
3157 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3158 ."'. Don't forget 'Save Config'!");
3159 $self->{binding_change}->($mod, $sym, $cmds)
3160 if $self->{binding_change};
3161 } else {
3162 $::STATUSBOX->add ("No action bound, no key or action specified!");
3163 $self->{binding_cancel}->()
3164 if $self->{binding_cancel};
3165 }
3166}
3167
3168sub start {
3169 my ($self) = @_;
3170
3171 $self->{rec_btn}->set_text ("stop recording");
3172 $self->{recording} = 1;
3173 $self->clear_command_list;
3174 $::CONN->start_record if $::CONN;
3175}
3176
3177sub stop {
3178 my ($self) = @_;
3179
3180 $self->{rec_btn}->set_text ("start recording");
3181 $self->{recording} = 0;
3182
3183 my $rec;
3184 $rec = $::CONN->stop_record if $::CONN;
3185 return unless ref $rec eq 'ARRAY';
3186 $self->set_command_list ($rec);
3187}
3188
3189
3190sub ask_for_bind_and_commit {
3191 my ($self) = @_;
3192 $self->ask_for_bind (1);
3193}
3194
3195sub ask_for_bind {
3196 my ($self, $commit) = @_;
3197
3198 CFClient::Binder::open_binding_dialog (sub {
3199 my ($mod, $sym) = @_;
3200 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3201 $self->update_binding_widgets;
3202 $self->commit if $commit;
3203 });
3204}
3205
3206# $mod and $sym are the modifiers and key symbol
3207# $cmds is a array ref of strings (the commands)
3208# $cb is the callback that is executed on OK
3209# $ccb is the callback that is executed on CANCEL and
3210# when the binding was unsuccessful on OK
3211sub set_binding {
2712 my ($self, $x, $y, $w, $h) = @_; 3212 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
2713 3213
2714 $self->{w} = $w; 3214 $self->clear_command_list;
2715 $self->{h} = $h; 3215 $self->{recording} = 0;
2716} 3216 $self->{rec_btn}->set_text ("start recording");
2717 3217
2718sub check_size { 3218 $self->{binding} = [$mod, $sym];
3219 $self->{commands} = $cmds;
3220
3221 $self->{binding_change} = $cb;
3222 $self->{binding_cancel} = $ccb;
3223
3224 $self->update_binding_widgets;
3225}
3226
3227# this is a shortcut method that asks for a binding
3228# and then just binds it.
3229sub do_quick_binding {
2719 my ($self) = @_; 3230 my ($self, $cmds) = @_;
3231 $self->set_binding (undef, undef, $cmds, sub {
3232 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3233 });
3234 $self->ask_for_bind (1);
3235}
2720 3236
2721 $self->size_allocate ($self->{w}, $self->{h}) 3237sub update_binding_widgets {
2722 if $self->{w}; 3238 my ($self) = @_;
3239 my ($mod, $sym, $cmds) = $self->get_binding;
3240 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3241 $self->set_command_list ($cmds);
3242}
3243
3244sub get_binding {
3245 my ($self) = @_;
3246 return (
3247 $self->{binding}->[0],
3248 $self->{binding}->[1],
3249 [ grep { defined $_ } @{$self->{commands}} ]
3250 );
3251}
3252
3253sub clear_command_list {
3254 my ($self) = @_;
3255 $self->{cmdbox}->clear ();
3256}
3257
3258sub set_command_list {
3259 my ($self, $cmds) = @_;
3260
3261 $self->{cmdbox}->clear ();
3262 $self->{commands} = $cmds;
3263
3264 my $idx = 0;
3265
3266 for (@$cmds) {
3267 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3268
3269 my $i = $idx;
3270 $hb->add (new CFClient::UI::Label text => $_);
3271 $hb->add (new CFClient::UI::Button
3272 text => "delete",
3273 tooltip => "Deletes the action from the record",
3274 on_activate => sub {
3275 $self->{cmdbox}->remove ($hb);
3276 $cmds->[$i] = undef;
3277 });
3278
3279
3280 $idx++
3281 }
3282}
3283
3284#############################################################################
3285
3286package CFClient::UI::SpellList;
3287
3288our @ISA = CFClient::UI::FancyFrame::;
3289
3290sub new {
3291 my $class = shift;
3292
3293 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3294
3295 $self->add (new CFClient::UI::ScrolledWindow
3296 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3297
3298 $self;
3299}
3300
3301# XXX: Do sorting? Argl...
3302sub add_spell {
3303 my ($self, $spell) = @_;
3304 $self->{spells}->{$spell->{name}} = $spell;
3305
3306 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3307 face => $spell->{face},
3308 can_hover => 1,
3309 can_events => 1,
3310 tooltip => $spell->{message});
3311
3312 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3313 text => $spell->{name},
3314 can_hover => 1,
3315 can_events => 1,
3316 tooltip => $spell->{message},
3317 expand => 1);
3318
3319 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3320 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3321 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3322 expand => 1);
3323
3324 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3325 text => "bind to key",
3326 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3327}
3328
3329sub rebuild_spell_list {
3330 my ($self) = @_;
3331 $self->{tbl_idx} = 0;
3332 $self->add_spell ($_) for values %{$self->{spells}};
3333}
3334
3335sub remove_spell {
3336 my ($self, $spell) = @_;
3337 delete $self->{spells}->{$spell->{name}};
3338 $self->rebuild_spell_list;
3339}
3340
3341#############################################################################
3342
3343package CFClient::UI::Root;
3344
3345our @ISA = CFClient::UI::Container::;
3346
3347use CFClient::OpenGL;
3348
3349sub new {
3350 my $class = shift;
3351
3352 my $self = $class->SUPER::new (
3353 visible => 1,
3354 @_,
3355 );
3356
3357 Scalar::Util::weaken ($self->{root} = $self);
3358
3359 $self
2723} 3360}
2724 3361
2725sub size_request { 3362sub size_request {
2726 my ($self) = @_; 3363 my ($self) = @_;
2727 3364
2728 ($self->{w}, $self->{h}) 3365 ($self->{w}, $self->{h})
3366}
3367
3368sub _to_pixel {
3369 my ($coord, $size, $max) = @_;
3370
3371 $coord =
3372 $coord eq "center" ? ($max - $size) * 0.5
3373 : $coord eq "max" ? $max
3374 : $coord;
3375
3376 $coord = 0 if $coord < 0;
3377 $coord = $max - $size if $coord > $max - $size;
3378
3379 int $coord + 0.5
2729} 3380}
2730 3381
2731sub size_allocate { 3382sub size_allocate {
2732 my ($self, $w, $h) = @_; 3383 my ($self, $w, $h) = @_;
2733 3384
2734 my $old_w = $self->{old_w};
2735 my $old_h = $self->{old_h};
2736
2737 if ($old_w && $old_h) {
2738 for my $child ($self->children) {
2739 $child->{x} = int 0.5 + $child->{x} * $w / $old_w;
2740 $child->{w} = int 0.5 + $child->{w} * $w / $old_w;
2741 $child->{req_w} = int 0.5 + $child->{req_w} * $w / $old_w if exists $child->{req_w};
2742 $child->{user_w} = int 0.5 + $child->{user_w} * $w / $old_w if exists $child->{user_w};
2743 $child->{y} = int 0.5 + $child->{y} * $h / $old_h;
2744 $child->{h} = int 0.5 + $child->{h} * $h / $old_h;
2745 $child->{req_h} = int 0.5 + $child->{req_h} * $h / $old_h if exists $child->{req_h};
2746 $child->{user_h} = int 0.5 + $child->{user_h} * $h / $old_h if exists $child->{user_h};
2747 }
2748 }
2749
2750 for my $child ($self->children) { 3385 for my $child ($self->children) {
2751 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3386 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2752 3387
2753 $X = List::Util::max 0, List::Util::min $w - $W, $X; 3388 $X = $child->{force_x} if exists $child->{force_x};
2754 $Y = List::Util::max 0, List::Util::min $h - $H, $Y; 3389 $Y = $child->{force_y} if exists $child->{force_y};
3390
3391 $X = _to_pixel $X, $W, $self->{w};
3392 $Y = _to_pixel $Y, $H, $self->{h};
3393
2755 $child->configure ($X, $Y, $W, $H); 3394 $child->configure ($X, $Y, $W, $H);
2756 } 3395 }
2757
2758 $self->{old_w} = $w;
2759 $self->{old_h} = $h;
2760} 3396}
2761 3397
2762sub coord2local { 3398sub coord2local {
2763 my ($self, $x, $y) = @_; 3399 my ($self, $x, $y) = @_;
2764 3400
… …
2772} 3408}
2773 3409
2774sub update { 3410sub update {
2775 my ($self) = @_; 3411 my ($self) = @_;
2776 3412
2777 $self->check_size;
2778 $::WANT_REFRESH++; 3413 $::WANT_REFRESH++;
2779} 3414}
2780 3415
2781sub add { 3416sub add {
2782 my ($self, $child) = @_; 3417 my ($self, @children) = @_;
2783 3418
2784 # integerise window positions 3419 $_->{is_toplevel} = 1
2785 $child->{x} = int $child->{x}; 3420 for @children;
2786 $child->{y} = int $child->{y};
2787 3421
2788 $self->SUPER::add ($child); 3422 $self->SUPER::add (@children);
3423}
3424
3425sub remove {
3426 my ($self, @children) = @_;
3427
3428 $self->SUPER::remove (@children);
3429
3430 delete $self->{is_toplevel}
3431 for @children;
3432
3433 while (@children) {
3434 my $w = pop @children;
3435 push @children, $w->children;
3436 $w->set_invisible;
3437 }
2789} 3438}
2790 3439
2791sub on_refresh { 3440sub on_refresh {
2792 my ($self, $id, $cb) = @_; 3441 my ($self, $id, $cb) = @_;
2793 3442
… …
2806 while ($self->{refresh_hook}) { 3455 while ($self->{refresh_hook}) {
2807 $_->() 3456 $_->()
2808 for values %{delete $self->{refresh_hook}}; 3457 for values %{delete $self->{refresh_hook}};
2809 } 3458 }
2810 3459
2811 if ($self->{check_size}) { 3460 if ($self->{realloc}) {
2812 my @queue = ([], []); 3461 my %queue;
3462 my @queue;
3463 my $widget;
2813 3464
2814 for (;;) { 3465 outer:
2815 if ($self->{check_size}) { 3466 while () {
2816 # heuristic: check containers last 3467 if (my $realloc = delete $self->{realloc}) {
2817 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3468 for $widget (values %$realloc) {
2818 for values %{delete $self->{check_size}} 3469 $widget->{visible} or next; # do not resize invisible widgets
3470
3471 $queue{$widget+0}++ and next; # duplicates are common
3472
3473 push @{ $queue[$widget->{visible}] }, $widget;
3474 }
2819 } 3475 }
2820 3476
2821 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3477 while () {
3478 @queue or last outer;
2822 3479
2823 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3480 $widget = pop @{ $queue[-1] || [] }
2824 ? @$widget{qw(user_w user_h)} 3481 and last;
2825 : $widget->size_request;
2826
2827 if (delete $widget->{force_alloc}
2828 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
2829 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
2830 3482
3483 pop @queue;
3484 }
3485
3486 delete $queue{$widget+0};
3487
3488 my ($w, $h) = $widget->size_request;
3489
3490 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3491 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3492
3493 $w = $widget->{force_w} if exists $widget->{force_w};
3494 $h = $widget->{force_h} if exists $widget->{force_h};
3495
3496 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3497 || delete $widget->{force_realloc}) {
2831 $widget->{req_w} = $w; 3498 $widget->{req_w} = $w;
2832 $widget->{req_h} = $h; 3499 $widget->{req_h} = $h;
2833 3500
2834 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3501 $self->{size_alloc}{$widget+0} = $widget;
2835 3502
2836 $widget->{parent}->check_size
2837 if $widget->{parent}; 3503 if (my $parent = $widget->{parent}) {
3504 $self->{realloc}{$parent+0} = $parent
3505 unless $queue{$parent+0};
3506
3507 $parent->{force_size_alloc} = 1;
3508 $self->{size_alloc}{$parent+0} = $parent;
3509 }
2838 } 3510 }
3511
3512 delete $self->{realloc}{$widget+0};
2839 } 3513 }
2840 } 3514 }
2841 3515
2842 while ($self->{size_alloc}) { 3516 while (my $size_alloc = delete $self->{size_alloc}) {
2843 for (values %{delete $self->{size_alloc}}) { 3517 my @queue = sort { $b->{visible} <=> $a->{visible} }
2844 my ($widget, $w, $h) = @$_; 3518 values %$size_alloc;
3519
3520 while () {
3521 my $widget = pop @queue || last;
3522
3523 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
2845 3524
2846 $w = 0 if $w < 0; 3525 $w = 0 if $w < 0;
2847 $h = 0 if $h < 0; 3526 $h = 0 if $h < 0;
2848 3527
3528 $w = int $w + 0.5;
3529 $h = int $h + 0.5;
3530
3531 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3532 $widget->{old_w} = $widget->{w};
3533 $widget->{old_h} = $widget->{h};
3534
2849 $widget->{w} = $w; 3535 $widget->{w} = $w;
2850 $widget->{h} = $h; 3536 $widget->{h} = $h;
2851 $widget->size_allocate ($w, $h); 3537
2852 $widget->emit (size_allocate => $w, $h); 3538 $widget->emit (size_allocate => $w, $h);
3539 }
2853 } 3540 }
2854 } 3541 }
2855 3542
2856 while ($self->{post_alloc_hook}) { 3543 while ($self->{post_alloc_hook}) {
2857 $_->() 3544 $_->()
2858 for values %{delete $self->{post_alloc_hook}}; 3545 for values %{delete $self->{post_alloc_hook}};
2859 } 3546 }
2860 3547
3548
2861 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3549 glViewport 0, 0, $::WIDTH, $::HEIGHT;
2862 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3550 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2863 glClear GL_COLOR_BUFFER_BIT; 3551 glClear GL_COLOR_BUFFER_BIT;
2864 3552
2865 glMatrixMode GL_PROJECTION; 3553 glMatrixMode GL_PROJECTION;
2866 glLoadIdentity; 3554 glLoadIdentity;
2867 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000; 3555 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2868 glMatrixMode GL_MODELVIEW; 3556 glMatrixMode GL_MODELVIEW;
2869 glLoadIdentity; 3557 glLoadIdentity;
2870 3558
3559 {
3560 package CFClient::UI::Base;
3561
3562 ($draw_x, $draw_y, $draw_w, $draw_h) =
3563 (0, 0, $self->{w}, $self->{h});
3564 }
3565
2871 $self->_draw; 3566 $self->_draw;
2872} 3567}
2873 3568
2874############################################################################# 3569#############################################################################
2875 3570
2876package CFClient::UI; 3571package CFClient::UI;
2877 3572
2878$ROOT = new CFClient::UI::Root; 3573$ROOT = new CFClient::UI::Root;
2879$TOOLTIP = new CFClient::UI::Tooltip; 3574$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2880 3575
28811 35761
2882 3577

Diff Legend

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