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.163 by root, Mon Apr 24 06:40:29 2006 UTC vs.
Revision 1.301 by elmex, Mon Jun 12 12:28:06 2006 UTC

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

Diff Legend

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