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

Diff Legend

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