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

Diff Legend

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