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.157 by root, Sun Apr 23 21:47:32 2006 UTC vs.
Revision 1.278 by root, Sun Jun 4 23:05:06 2006 UTC

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

Diff Legend

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