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.202 by root, Sun May 14 20:51:19 2006 UTC vs.
Revision 1.273 by root, Sat Jun 3 02:32:35 2006 UTC

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

Diff Legend

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