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.99 by elmex, Fri Apr 14 10:57:35 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
12our $TOPLEVEL; 15our $LAYOUT;
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 = $TOPLEVEL->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->translate ($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 || $TOPLEVEL->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->translate ($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 || $TOPLEVEL->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; 132 $hover->update if $hover && $hover->{can_hover};
67 $HOVER->update if $HOVER; 133 $HOVER->update if $HOVER && $HOVER->{can_hover};
68 }
69 134
70 $HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER; 135 $TOOLTIP_WATCHER->start;
136 }
137
138 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
139 if $HOVER;
140}
141
142# convert position array to integers
143sub harmonize {
144 my ($vals) = @_;
145
146 my $rem = 0;
147
148 for (@$vals) {
149 my $i = int $_ + $rem;
150 $rem += $_ - $i;
151 $_ = $i;
152 }
153}
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;
71} 194}
72 195
73############################################################################# 196#############################################################################
74 197
75package CFClient::UI::Base; 198package CFClient::UI::Base;
76 199
77use strict; 200use strict;
78 201
79use SDL::OpenGL; 202use CFClient::OpenGL;
80 203
81sub new { 204sub new {
82 my $class = shift; 205 my $class = shift;
83 206
84 my $self = bless { 207 my $self = bless {
85 x => 0, 208 x => "center",
86 y => 0, 209 y => "center",
87 z => 0, 210 z => 0,
88 w => -1, 211 w => undef,
89 h => -1, 212 h => undef,
213 can_events => 1,
90 @_ 214 @_
91 }, $class; 215 }, $class;
92 216
217 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
218
93 for (keys %$self) { 219 for (keys %$self) {
94 if (/^connect_(.*)$/) { 220 if (/^on_(.*)$/) {
95 $self->connect ($1 => delete $self->{$_}); 221 $self->connect ($1 => delete $self->{$_});
96 } 222 }
97 } 223 }
98 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
99 $self 237 $self
100} 238}
101 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
102sub move { 317sub move_abs {
103 my ($self, $x, $y, $z) = @_; 318 my ($self, $x, $y, $z) = @_;
104 $self->{x} = $x; 319
105 $self->{y} = $y; 320 $self->{x} = List::Util::max 0, int $x;
321 $self->{y} = List::Util::max 0, int $y;
106 $self->{z} = $z if defined $z; 322 $self->{z} = $z if defined $z;
107}
108 323
109sub needs_redraw { 324 $self->update;
110 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;
111} 334}
112 335
113sub size_request { 336sub size_request {
114 require Carp; 337 require Carp;
115 Carp::confess "size_request is abtract"; 338 Carp::confess "size_request is abstract";
116} 339}
117 340
118sub _size_allocate { 341sub configure {
119 my ($self, $x, $y, $w, $h) = @_; 342 my ($self, $x, $y, $w, $h) = @_;
120 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) {
121 $self->{x} = $x; 357 $self->{x} = $x;
122 $self->{y} = $y; 358 $self->{y} = $y;
359 $self->update;
360 }
123 361
124 return unless $self->{w} != $w || $self->{h} != $h; 362 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
363 return unless $self->{visible};
125 364
126 $self->{w} = $w; 365 $self->{alloc_w} = $w;
127 $self->{h} = $h; 366 $self->{alloc_h} = $h;
128 367
368 $self->{root}{size_alloc}{$self+0} = $self;
129 1 369 }
130} 370}
131 371
132sub size_allocate { 372sub size_allocate {
373 # nothing to be done
374}
375
376sub children {
377 # nop
378}
379
380sub visible_children {
381 $_[0]->children
382}
383
384sub set_max_size {
133 my ($self, $x, $y, $w, $h) = @_; 385 my ($self, $w, $h) = @_;
134 386
135 $self->_size_allocate ($x, $y, $w, $h); 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 }
136} 407}
137 408
138# translate global coordinates to local coordinate system 409# translate global coordinates to local coordinate system
139sub translate { 410sub coord2local {
140 my ($self, $x, $y) = @_; 411 my ($self, $x, $y) = @_;
141 412
142 $self->{parent}->translate ($x - $self->{x}, $y - $self->{y}); 413 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
414}
415
416# translate local coordinates to global coordinate system
417sub coord2global {
418 my ($self, $x, $y) = @_;
419
420 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
143} 421}
144 422
145sub focus_in { 423sub focus_in {
146 my ($self) = @_; 424 my ($self) = @_;
147 425
148 return if $FOCUS == $self; 426 return if $FOCUS == $self;
149 return unless $self->{can_focus}; 427 return unless $self->{can_focus};
150 428
151 my $focus = $FOCUS; $FOCUS = $self; 429 my $focus = $FOCUS; $FOCUS = $self;
430
431 $self->_emit (focus_in => $focus);
432
152 $focus->update if $focus; 433 $focus->update if $focus;
153 $FOCUS->update; 434 $FOCUS->update;
154} 435}
155 436
156sub focus_out { 437sub focus_out {
157 my ($self) = @_; 438 my ($self) = @_;
158 439
159 return unless $FOCUS == $self; 440 return unless $FOCUS == $self;
160 441
161 my $focus = $FOCUS; undef $FOCUS; 442 my $focus = $FOCUS; undef $FOCUS;
443
444 $self->_emit (focus_out => $focus);
445
162 $focus->update if $focus; #? 446 $focus->update if $focus; #?
163}
164 447
448 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
449 unless $FOCUS;
450}
451
165sub mouse_motion { } 452sub mouse_motion { 0 }
166sub button_up { } 453sub button_up { 0 }
167sub key_down { } 454sub key_down { 0 }
168sub key_up { } 455sub key_up { 0 }
169 456
170sub button_down { 457sub button_down {
171 my ($self, $ev, $x, $y) = @_; 458 my ($self, $ev, $x, $y) = @_;
172 459
173 $self->focus_in; 460 $self->focus_in;
174}
175 461
176sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
177sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
178sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
179sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
180sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
181
182sub draw {
183 my ($self) = @_;
184
185 return unless $self->{h} && $self->{w};
186
187 glPushMatrix;
188 glTranslate $self->{x}, $self->{y}, 0;
189 $self->_draw;
190 glPopMatrix;
191
192 if ($self == $HOVER && $self->{can_hover}) {
193 my ($x, $y) = @$self{qw(x y)};
194
195 glColor 0, 0, 1, 0.2;
196 glEnable GL_BLEND;
197 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
198 glBegin GL_QUADS;
199 glVertex $x , $y;
200 glVertex $x + $self->{w}, $y;
201 glVertex $x + $self->{w}, $y + $self->{h};
202 glVertex $x , $y + $self->{h};
203 glEnd;
204 glDisable GL_BLEND;
205 } 462 0
206}
207
208sub _draw {
209 my ($self) = @_;
210
211 warn "no draw defined for $self\n";
212} 463}
213 464
214sub find_widget { 465sub find_widget {
215 my ($self, $x, $y) = @_; 466 my ($self, $x, $y) = @_;
467
468 return () unless $self->{can_events};
216 469
217 return $self 470 return $self
218 if $x >= $self->{x} && $x < $self->{x} + $self->{w} 471 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
219 && $y >= $self->{y} && $y < $self->{y} + $self->{h}; 472 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
220 473
221 () 474 ()
222} 475}
223 476
224sub set_parent { 477sub set_parent {
225 my ($self, $par) = @_; 478 my ($self, $parent) = @_;
226 479
227 $self->{parent} = $par;
228 Scalar::Util::weaken $self->{parent}; 480 Scalar::Util::weaken ($self->{parent} = $parent);
481 $self->set_visible if $parent->{visible};
229} 482}
230 483
231sub get_parent { 484sub connect {
232 $_[0]->{parent} 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 }
233} 519}
234 520
235sub update { 521sub update {
236 my ($self) = @_; 522 my ($self) = @_;
237 523
238 $self->{parent}->update 524 $self->{parent}->update
239 if $self->{parent}; 525 if $self->{parent};
240} 526}
241 527
242sub connect { 528sub reconfigure {
243 my ($self, $signal, $cb) = @_; 529 my ($self) = @_;
244 530
245 push @{ $self->{cb}{$signal} }, $cb; 531 $self->realloc;
532 $self->update;
246} 533}
247 534
248sub emit { 535# using global variables seems a bit hacky, but passing through all drawing
249 my ($self, $signal, @args) = @_; 536# functions seems pointless.
537our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
250 538
251 $_->($self, @args) 539sub draw {
252 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";
253} 592}
254 593
255sub DESTROY { 594sub DESTROY {
256 my ($self) = @_; 595 my ($self) = @_;
257 596
597 delete $WIDGET{$self+0};
258 #$self->deactivate; 598 #$self->deactivate;
259} 599}
260 600
261############################################################################# 601#############################################################################
262 602
263package CFClient::UI::DrawBG; 603package CFClient::UI::DrawBG;
264 604
265our @ISA = CFClient::UI::Base::; 605our @ISA = CFClient::UI::Base::;
266 606
267use strict; 607use strict;
268use SDL::OpenGL; 608use CFClient::OpenGL;
269 609
270sub new { 610sub new {
271 my $class = shift; 611 my $class = shift;
272 612
273 # range [value, low, high, page] 613 # range [value, low, high, page]
274 614
275 $class->SUPER::new ( 615 $class->SUPER::new (
276 bg => [0, 0, 0, 0.2], 616 #bg => [0, 0, 0, 0.2],
277 active_bg => [1, 1, 1, 0.5], 617 #active_bg => [1, 1, 1, 0.5],
278 @_ 618 @_
279 ) 619 )
280} 620}
281 621
282sub _draw { 622sub _draw {
283 my ($self) = @_; 623 my ($self) = @_;
284 624
625 my $color = $FOCUS == $self && $self->{active_bg}
626 ? $self->{active_bg}
627 : $self->{bg};
628
629 if ($color && (@$color < 4 || $color->[3])) {
285 my ($w, $h) = @$self{qw(w h)}; 630 my ($w, $h) = @$self{qw(w h)};
286 631
287 glEnable GL_BLEND; 632 glEnable GL_BLEND;
288 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 633 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
289 glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} }; 634 glColor_premultiply @$color;
290 635
291 glBegin GL_QUADS; 636 glBegin GL_QUADS;
292 glVertex 0 , 0; 637 glVertex 0 , 0;
293 glVertex 0 , $h; 638 glVertex 0 , $h;
294 glVertex $w, $h; 639 glVertex $w, $h;
295 glVertex $w, 0; 640 glVertex $w, 0;
296 glEnd; 641 glEnd;
297 642
298 glDisable GL_BLEND; 643 glDisable GL_BLEND;
644 }
299} 645}
300 646
301############################################################################# 647#############################################################################
302 648
303package CFClient::UI::Empty; 649package CFClient::UI::Empty;
304
305our @ISA = CFClient::UI::Base::;
306
307sub size_request {
308 (0, 0)
309}
310
311sub draw { }
312
313#############################################################################
314
315package CFClient::UI::Container;
316 650
317our @ISA = CFClient::UI::Base::; 651our @ISA = CFClient::UI::Base::;
318 652
319sub new { 653sub new {
320 my ($class, %arg) = @_; 654 my ($class, %arg) = @_;
655 $class->SUPER::new (can_events => 0, %arg);
656}
321 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
322 my $children = delete $arg{children} || []; 675 my $children = delete $arg{children};
323 676
324 my $self = $class->SUPER::new (children => [], %arg); 677 my $self = $class->SUPER::new (
678 children => [],
679 can_events => 0,
680 %arg,
681 );
682
325 $self->add ($_) for @$children; 683 $self->add (@$children)
684 if $children;
326 685
327 $self 686 $self
328} 687}
329 688
330sub add { 689sub add {
331 my ($self, $chld) = @_; 690 my ($self, @widgets) = @_;
332 691
333 $chld->set_parent ($self); 692 $_->set_parent ($self)
693 for @widgets;
694
695 use sort 'stable';
334 696
335 $self->{children} = [ 697 $self->{children} = [
336 sort { $a->{z} <=> $b->{z} } 698 sort { $a->{z} <=> $b->{z} }
337 @{$self->{children}}, $chld 699 @{$self->{children}}, @widgets
338 ]; 700 ];
339 701
340 $self->{w} = $self->{h} = -1; 702 $self->realloc;
341 $self->update; 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)
768}
769
770sub add {
771 my ($self, $child) = @_;
772
773 $self->{children} = [];
774
775 $self->SUPER::add ($child);
342} 776}
343 777
344sub remove { 778sub remove {
345 my ($self, $widget) = @_; 779 my ($self, $widget) = @_;
346 780
347 $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ]; 781 $self->SUPER::remove ($widget);
348 782
349 $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)
350} 932}
351 933
352sub find_widget { 934sub find_widget {
353 my ($self, $x, $y) = @_; 935 my ($self, $x, $y) = @_;
354 936
355 $x -= $self->{x}; 937 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
356 $y -= $self->{y}; 938 && $y >= $self->{y} && $y < $self->{y} + $self->{h}
357 939 ) {
358 my $res;
359
360 for (reverse @{ $self->{children} }) {
361 $res = $_->find_widget ($x, $y)
362 and return $res;
363 }
364
365 $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 }
366} 944}
367 945
368sub _draw { 946sub _render {
369 my ($self) = @_; 947 my ($self) = @_;
370 948
371 $_->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;
372} 955}
373 956
374############################################################################# 957#############################################################################
375 958
376package CFClient::UI::Bin; 959package CFClient::UI::ScrolledWindow;
377 960
378our @ISA = CFClient::UI::Container::; 961our @ISA = CFClient::UI::HBox::;
379 962
380sub new { 963sub new {
381 my ($class, %arg) = @_; 964 my ($class, %arg) = @_;
382 965
383 my $child = (delete $arg{child}) || new CFClient::UI::Empty::; 966 my $child = delete $arg{child};
384 967
385 $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
386} 988}
387 989
388sub add { 990sub add {
389 my ($self, $widget) = @_; 991 my ($self, $widget) = @_;
390 992
391 $self->{children} = []; 993 $self->{vp}->add ($self->{child} = $widget);
392
393 $self->SUPER::add ($widget);
394} 994}
395 995
396sub remove { 996sub update {
397 my ($self, $widget) = @_; 997 my ($self) = @_;
398 998
399 $self->SUPER::remove ($widget); 999 $self->SUPER::update;
400 1000
401 $self->{children} = [new CFClient::UI::Empty] 1001 # todo: overwrite size_allocate of child
402 unless @{$self->{children}}; 1002 my $child = $self->{vp}->child;
403} 1003 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
404
405sub child { $_[0]->{children}[0] }
406
407sub size_request {
408 $_[0]{children}[0]->size_request
409} 1004}
410 1005
411sub size_allocate { 1006sub size_allocate {
412 my ($self, $x, $y, $w, $h) = @_; 1007 my ($self, $w, $h) = @_;
413 1008
414 $self->_size_allocate ($x, $y, $w, $h) or return; 1009 $self->SUPER::size_allocate ($w, $h);
415 1010
416 $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]);
417} 1013}
1014
1015#TODO# update range on size_allocate depending on child
1016# update viewport offset on scroll
418 1017
419############################################################################# 1018#############################################################################
420 1019
421package CFClient::UI::Window; 1020package CFClient::UI::Frame;
422 1021
423our @ISA = CFClient::UI::Bin::; 1022our @ISA = CFClient::UI::Bin::;
424 1023
425use 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);
426 1073
427sub new { 1074sub new {
428 my ($class, %arg) = @_; 1075 my ($class, %arg) = @_;
429 1076
1077 my $title = delete $arg{title};
1078
430 my $self = $class->SUPER::new (%arg); 1079 my $self = $class->SUPER::new (
431} 1080 bg => [1, 1, 1, 1],
1081 border_bg => [1, 1, 1, 1],
1082 border => 0.6,
1083 can_events => 1,
1084 min_w => 16,
1085 min_h => 16,
1086 %arg,
1087 );
432 1088
433sub update { 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 {
434 my ($self) = @_; 1100 my ($self, @widgets) = @_;
435 1101
436 # we want to do this delayed... 1102 $self->SUPER::add (@widgets);
437 $self->render_chld; 1103 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
438 $self->SUPER::update;
439} 1104}
440 1105
441sub render_chld { 1106sub border {
442 my ($self) = @_; 1107 int $_[0]{border} * $::FONTSIZE
1108}
443 1109
444 $self->{texture} = 1110sub size_request {
445 CFClient::Texture->new_from_opengl ( 1111 my ($self) = @_;
446 $self->{w}, $self->{h}, sub { $self->child->draw } 1112
447 ); 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 )
448} 1122}
449 1123
450sub size_allocate { 1124sub size_allocate {
451 my ($self, $x, $y, $w, $h) = @_; 1125 my ($self, $w, $h) = @_;
452 1126
453 $self->_size_allocate ($x, $y, $w, $h) or return; 1127 if ($self->{title}) {
454 1128 $self->{title}{w} = $w;
1129 $self->{title}{h} = $h;
455 $self->child->size_allocate (0, 0, $w, $h); 1130 $self->{title}->size_allocate ($w, $h);
1131 }
456 1132
457 $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}
458} 1203}
459 1204
460sub _draw { 1205sub _draw {
461 my ($self) = @_; 1206 my ($self) = @_;
462 1207
1208 my $child = $self->{children}[0];
1209
463 my ($w, $h) = ($self->w, $self->h); 1210 my ($w, $h ) = ($self->{w}, $self->{h});
1211 my ($cw, $ch) = ($child->{w}, $child->{h});
464 1212
465 my $tex = $self->{texture}
466 or return;
467
468 glEnable GL_BLEND;
469 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
470 glEnable GL_TEXTURE_2D; 1213 glEnable GL_TEXTURE_2D;
471 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1214 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
472 1215
473 $tex->draw_quad (0, 0, $w, $h); 1216 my $border = $self->border;
474 1217
475 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
476 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 }
477} 1242}
478 1243
479############################################################################# 1244#############################################################################
480 1245
481package CFClient::UI::Frame; 1246package CFClient::UI::Table;
482 1247
483our @ISA = CFClient::UI::Bin::; 1248our @ISA = CFClient::UI::Base::;
484 1249
485use SDL::OpenGL; 1250use List::Util qw(max sum);
486 1251
487sub size_request { 1252use CFClient::OpenGL;
488 my ($self) = @_;
489 my $chld = $self->child
490 or return (0, 0);
491
492 $chld->move (2, 2);
493
494 map { $_ + 4 } $chld->size_request;
495}
496
497sub size_allocate {
498 my ($self, $x, $y, $w, $h) = @_;
499
500 $self->_size_allocate ($x, $y, $w, $h) or return;
501
502 $self->child->size_allocate (2, 2, $w - 4, $h - 4);
503}
504
505sub _draw {
506 my ($self) = @_;
507
508 my $chld = $self->child;
509
510 my ($w, $h) = $chld->size_request;
511
512 glBegin GL_QUADS;
513 glColor 0, 0, 0;
514 glVertex 0 , 0;
515 glVertex 0 , $h + 4;
516 glVertex $w + 4 , $h + 4;
517 glVertex $w + 4 , 0;
518 glEnd;
519
520 $chld->draw;
521}
522
523#############################################################################
524
525package CFClient::UI::FancyFrame;
526
527our @ISA = CFClient::UI::Bin::;
528
529use SDL::OpenGL;
530
531my @tex =
532 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
533 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
534 1253
535sub new { 1254sub new {
536 my $class = shift; 1255 my $class = shift;
537 1256
538 # TODO: user_x, user_y, overwrite moveto?
539
540 $class->SUPER::new (
541 bg => [1, 1, 1, 1],
542 border_bg => [1, 1, 1, 1],
543 border => $::FONTSIZE * 0.8,
544 @_
545 )
546}
547
548sub size_request {
549 my ($self) = @_;
550
551 return ($self->{user_w}, $self->{user_h}) if $self->{user_w} && $self->{user_h};
552
553 my ($w, $h) = $self->SUPER::size_request;
554
555 (
556 $w + $self->{border} * 2,
557 $h + $self->{border} * 2,
558 )
559}
560
561sub size_allocate {
562 my ($self, $x, $y, $w, $h) = @_;
563
564 $self->_size_allocate ($x, $y, $w, $h) or return;
565
566 $h -= List::Util::max 0, $self->{border} * 2;
567 $w -= List::Util::max 0, $self->{border} * 2;
568
569 $self->child->size_allocate ($self->{border}, $self->{border}, $w, $h);
570}
571
572sub button_down {
573 my ($self, $ev, $x, $y) = @_;
574
575 if ($x < $self->{w} && $x >= $self->{w} - $self->{border}
576 && $y < $self->{h} && $y >= $self->{h} - $self->{border}) {
577
578 my ($ox, $oy) = ($ev->button_x, $ev->button_y);
579 my ($bw, $bh) = ($self->{w}, $self->{h});
580
581 $self->{motion} = sub {
582 my ($ev, $x, $y) = @_;
583
584 ($x, $y) = ($ev->motion_x, $ev->motion_y);
585
586 $self->{user_w} = $bw + $x - $ox;
587 $self->{user_h} = $bh + $y - $oy;
588 $self->update;
589 };
590
591 } elsif ($x >= 0 && $x < $self->{w}
592 && $y >= 0 && $y < $self->{border}) {
593
594 my ($ox, $oy) = ($ev->button_x, $ev->button_y);
595 my ($bx, $by) = ($self->{x}, $self->{y});
596
597 $self->{motion} = sub {
598 my ($ev, $x, $y) = @_;
599
600 ($x, $y) = ($ev->motion_x, $ev->motion_y);
601
602 $self->move ($bx + $x - $ox, $by + $y - $oy);
603 $self->update;
604 };
605 }
606}
607
608sub button_up {
609 my ($self, $ev, $x, $y) = @_;
610
611 delete $self->{motion};
612}
613
614sub mouse_motion {
615 my ($self, $ev, $x, $y) = @_;
616
617 $self->{motion}->($ev, $x, $y) if $self->{motion};
618}
619
620sub _draw {
621 my ($self) = @_;
622
623 my ($w, $h ) = ($self->{w}, $self->{h});
624 my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
625
626 glEnable GL_BLEND;
627 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
628 glEnable GL_TEXTURE_2D;
629 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
630
631 glColor @{ $self->{border_bg} };
632 $tex[1]->draw_quad (0, 0, $w, $self->{border});
633 $tex[3]->draw_quad (0, $self->{border}, $self->{border}, $ch);
634 $tex[2]->draw_quad ($w - $self->{border}, $self->{border}, $self->{border}, $ch);
635 $tex[4]->draw_quad (0, $h - $self->{border}, $w, $self->{border});
636
637 my $bg = $tex[0];
638
639 # TODO: repeat texture not scale
640 my $rep_x = $cw / $bg->{w};
641 my $rep_y = $ch / $bg->{h};
642
643 glColor @{ $self->{bg} };
644 $bg->draw_quad ($self->{border}, $self->{border}, $cw, $ch);
645
646 glDisable GL_TEXTURE_2D;
647 glDisable GL_BLEND;
648
649 $self->child->draw;
650}
651
652#############################################################################
653
654package CFClient::UI::Table;
655
656our @ISA = CFClient::UI::Base::;
657
658use List::Util qw(max sum);
659
660use SDL::OpenGL;
661
662sub new {
663 my $class = shift;
664
665 $class->SUPER::new ( 1257 $class->SUPER::new (
666 col_expand => [], 1258 col_expand => [],
667 @_ 1259 @_,
668 ) 1260 )
669} 1261}
670 1262
1263sub children {
1264 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1265}
1266
671sub add { 1267sub add {
672 my ($self, $x, $y, $chld) = @_; 1268 my ($self, $x, $y, $child) = @_;
673 1269
1270 $child->set_parent ($self);
674 $self->{children}[$y][$x] = $chld; 1271 $self->{children}[$y][$x] = $child;
675 $chld->set_parent ($self);
676 1272
677 $self->{w} = $self->{h} = -1; 1273 $self->realloc;
678 $self->update; 1274}
1275
1276# TODO: move to container class maybe? send children a signal on removal?
1277sub clear {
1278 my ($self) = @_;
1279
1280 my @children = $self->children;
1281 delete $self->{children};
1282
1283 for (@children) {
1284 delete $_->{parent};
1285 $_->hide;
1286 }
1287
1288 $self->realloc;
679} 1289}
680 1290
681sub get_wh { 1291sub get_wh {
682 my ($self) = @_; 1292 my ($self) = @_;
683 1293
… …
688 or next; 1298 or next;
689 1299
690 for my $x (0 .. $#$row) { 1300 for my $x (0 .. $#$row) {
691 my $widget = $row->[$x] 1301 my $widget = $row->[$x]
692 or next; 1302 or next;
693 my ($w, $h) = $widget->size_request; 1303 my ($w, $h) = @$widget{qw(req_w req_h)};
694 1304
695 $w[$x] = max $w[$x], $w; 1305 $w[$x] = max $w[$x], $w;
696 $h[$y] = max $h[$y], $h; 1306 $h[$y] = max $h[$y], $h;
697 } 1307 }
698 } 1308 }
… …
710 (sum @$hs), 1320 (sum @$hs),
711 ) 1321 )
712} 1322}
713 1323
714sub size_allocate { 1324sub size_allocate {
715 my ($self, $x, $y, $w, $h) = @_; 1325 my ($self, $w, $h) = @_;
716
717 $self->_size_allocate ($x, $y, $w, $h) or return;
718 1326
719 my ($ws, $hs) = $self->get_wh; 1327 my ($ws, $hs) = $self->get_wh;
720 1328
721 my $req_w = sum @$ws; 1329 my $req_w = (sum @$ws) || 1;
722 my $req_h = sum @$hs; 1330 my $req_h = (sum @$hs) || 1;
723 1331
724 # TODO: nicer code && do row_expand 1332 # TODO: nicer code && do row_expand
725 my @col_expand = @{$self->{col_expand}}; 1333 my @col_expand = @{$self->{col_expand}};
726 @col_expand = (1) x @$ws unless @col_expand; 1334 @col_expand = (1) x @$ws unless @col_expand;
727 my $col_expand = (sum @col_expand) || 1; 1335 my $col_expand = (sum @col_expand) || 1;
728 1336
729 # linearly scale sizes 1337 # linearly scale sizes
730 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws; 1338 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
731 $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs; 1339 $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1340
1341 CFClient::UI::harmonize $ws;
1342 CFClient::UI::harmonize $hs;
732 1343
733 my $y; 1344 my $y;
734 1345
735 for my $r (0 .. $#{$self->{children}}) { 1346 for my $r (0 .. $#{$self->{children}}) {
736 my $row = $self->{children}[$r] 1347 my $row = $self->{children}[$r]
… …
741 1352
742 for my $c (0 .. $#$row) { 1353 for my $c (0 .. $#$row) {
743 my $col_w = $ws->[$c]; 1354 my $col_w = $ws->[$c];
744 1355
745 if (my $widget = $row->[$c]) { 1356 if (my $widget = $row->[$c]) {
746 $widget->size_allocate ($x, $y, $col_w, $row_h); 1357 $widget->configure ($x, $y, $col_w, $row_h);
747 } 1358 }
748 1359
749 $x += $col_w; 1360 $x += $col_w;
750 } 1361 }
751 1362
… …
778 } 1389 }
779} 1390}
780 1391
781############################################################################# 1392#############################################################################
782 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
783package CFClient::UI::HBox; 1454package CFClient::UI::HBox;
784 1455
785# TODO: wrap into common Box base class
786
787our @ISA = CFClient::UI::Container::; 1456our @ISA = CFClient::UI::Box::;
788 1457
789sub size_request { 1458sub new {
790 my ($self) = @_; 1459 my $class = shift;
791 1460
792 my @alloc = map [$_->size_request], @{$self->{children}}; 1461 $class->SUPER::new (
793 1462 vertical => 0,
794 ( 1463 @_,
795 (List::Util::sum map $_->[0], @alloc),
796 (List::Util::max map $_->[1], @alloc),
797 ) 1464 )
798} 1465}
799 1466
800sub size_allocate {
801 my ($self, $x, $y, $w, $h) = @_;
802
803 $self->_size_allocate ($x, $y, $w, $h);
804
805 ($h, $w) = ($w, $h);
806
807 my $children = $self->{children};
808
809 my @h = map +($_->size_request)[0], @$children;
810
811 my $req_h = List::Util::sum @h;
812
813 if ($req_h > $h) {
814 # ah well, not enough space
815 $_ *= $h / $req_h for @h;
816 } else {
817 my $exp = List::Util::sum map $_->{expand}, @$children;
818 $exp ||= 1;
819
820 for (0 .. $#$children) {
821 my $child = $children->[$_];
822
823 my $alloc_h = $h[$_];
824 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
825 $h[$_] = $alloc_h;
826 }
827 }
828
829 my $y = 0;
830 for (0 .. $#$children) {
831 my $child = $children->[$_];
832 my $h = $h[$_];
833 $child->size_allocate ($y, 0, $h, $w);
834
835 $y += $h;
836 }
837}
838
839############################################################################# 1467#############################################################################
840 1468
841package CFClient::UI::VBox; 1469package CFClient::UI::VBox;
842 1470
843# TODO: wrap into common Box base class
844
845our @ISA = CFClient::UI::Container::; 1471our @ISA = CFClient::UI::Box::;
846 1472
847sub size_request { 1473sub new {
848 my ($self) = @_; 1474 my $class = shift;
849 1475
850 my @alloc = map [$_->size_request], @{$self->{children}}; 1476 $class->SUPER::new (
851 1477 vertical => 1,
852 ( 1478 @_,
853 (List::Util::max map $_->[0], @alloc),
854 (List::Util::sum map $_->[1], @alloc),
855 ) 1479 )
856} 1480}
857 1481
858sub size_allocate {
859 my ($self, $x, $y, $w, $h) = @_;
860
861 $self->_size_allocate ($x, $y, $w, $h);
862
863 my $children = $self->{children};
864
865 my @h = map +($_->size_request)[1], @$children;
866
867 my $req_h = List::Util::sum @h;
868
869 if ($req_h > $h) {
870 # ah well, not enough space
871 $_ *= $h / $req_h for @h;
872 } else {
873 my $exp = List::Util::sum map $_->{expand}, @$children;
874 $exp ||= 1;
875
876 for (0 .. $#$children) {
877 my $child = $children->[$_];
878
879 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
880 }
881 }
882
883 my $y = 0;
884 for (0 .. $#$children) {
885 my $child = $children->[$_];
886 my $h = $h[$_];
887 $child->size_allocate (0, $y, $w, $h);
888
889 $y += $h;
890 }
891}
892
893############################################################################# 1482#############################################################################
894 1483
895package CFClient::UI::Label; 1484package CFClient::UI::Label;
896 1485
897our @ISA = CFClient::UI::Base::; 1486our @ISA = CFClient::UI::DrawBG::;
898 1487
899use SDL::OpenGL; 1488use CFClient::OpenGL;
900 1489
901sub new { 1490sub new {
902 my ($class, %arg) = @_; 1491 my ($class, %arg) = @_;
903 1492
904 my $self = $class->SUPER::new ( 1493 my $self = $class->SUPER::new (
905 fg => [1, 1, 1], 1494 fg => [1, 1, 1],
906 height => $::FONTSIZE, 1495 #bg => none
907 text => "", 1496 #active_bg => none
908 align => -1, 1497 #font => default_font
909 padding => 2, 1498 #text => initial text
1499 #markup => initial narkup
1500 #max_w => maximum pixel width
1501 ellipsise => 3, # end
910 layout => new CFClient::Layout, 1502 layout => (new CFClient::Layout),
1503 fontsize => 1,
1504 align => -1,
1505 valign => -1,
1506 padding_x => 2,
1507 padding_y => 2,
1508 can_events => 0,
911 %arg 1509 %arg
912 ); 1510 );
913 1511
1512 if (exists $self->{template}) {
1513 my $layout = new CFClient::Layout;
1514 $layout->set_text (delete $self->{template});
1515 $self->{template} = $layout;
1516 }
1517
1518 if (exists $self->{markup}) {
1519 $self->set_markup (delete $self->{markup});
1520 } else {
914 $self->set_text ($self->{text}); 1521 $self->set_text (delete $self->{text});
1522 }
915 1523
916 $self 1524 $self
917} 1525}
918 1526
919sub escape_text { 1527sub escape($) {
920 local $_ = $_[1]; 1528 local $_ = $_[0];
921 1529
922 s/&/&amp;/g; 1530 s/&/&amp;/g;
923 s/>/&gt;/g; 1531 s/>/&gt;/g;
924 s/</&lt;/g; 1532 s/</&lt;/g;
925 1533
926 $_[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;
927} 1549}
928 1550
929sub set_text { 1551sub set_text {
930 my ($self, $text) = @_; 1552 my ($self, $text) = @_;
931 1553
1554 return if $self->{text} eq "T$text";
932 $self->{text} = $text; 1555 $self->{text} = "T$text";
1556
1557 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1558 $self->{layout}->set_text ($text);
1559
1560 delete $self->{size_req};
1561 $self->realloc;
1562 $self->update;
1563}
1564
1565sub set_markup {
1566 my ($self, $markup) = @_;
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;
933 $self->{layout}->set_markup ($text); 1574 $self->{layout}->set_markup ($markup);
934 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;
935 delete $self->{texture}; 1622 delete $self->{texture};
936# $self->{w} = $self->{h} = -1;
937 $self->update;
938}
939 1623
940sub get_text { 1624 $self->realloc;
1625}
1626
1627sub reconfigure {
941 my ($self, $text) = @_; 1628 my ($self) = @_;
942 1629
943 $self->{text}
944}
945
946sub size_request {
947 my ($self) = @_;
948
949 $self->{layout}->set_width;
950 $self->{layout}->set_height ($self->{height});
951 my ($w, $h) = $self->{layout}->size;
952
953 (
954 $w + $self->{padding} * 2,
955 $h + $self->{padding} * 2,
956 )
957}
958
959sub size_allocate {
960 my ($self, $x, $y, $w, $h) = @_;
961
962 $self->_size_allocate ($x, $y, $w, $h) or return;
963
964 delete $self->{texture}; 1630 delete $self->{size_req};
965}
966 1631
967sub update {
968 my ($self) = @_;
969
970 delete $self->{texture};
971 $self->SUPER::update; 1632 $self->SUPER::reconfigure;
972} 1633}
973 1634
974sub _draw { 1635sub _draw {
975 my ($self) = @_; 1636 my ($self) = @_;
976 1637
1638 $self->SUPER::_draw; # draw background, if applicable
1639
977 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};
978 $self->{layout}->set_width ($self->{w}); 1643 $self->{layout}->set_width ($self->{w});
979 $self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height}); 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
980 new_from_layout CFClient::Texture $self->{layout} 1648 new_from_layout CFClient::Texture $self->{layout}
981 }; 1649 };
982 1650
983 glEnable GL_BLEND; 1651 unless (exists $self->{ox}) {
984 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
985 glEnable GL_TEXTURE_2D; 1661 glEnable GL_TEXTURE_2D;
1662
1663 if ($tex->{format} == GL_ALPHA) {
986 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1664 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
987
988 glColor @{$self->{fg}}; 1665 glColor @{$self->{fg}};
989 1666 $tex->draw_quad_alpha ($self->{ox}, $self->{oy});
990 my $x = 1667 } else {
991 $self->{align} < 0 ? $self->{padding} 1668 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
992 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1669 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
993 : ($self->{w} - $tex->{w}) * 0.5; 1670 }
994
995 glTranslate int $x, int +($self->{h} - $tex->{h}) * 0.5, 0;
996 $tex->draw_quad (0, 0);
997 1671
998 glDisable GL_TEXTURE_2D; 1672 glDisable GL_TEXTURE_2D;
999 glDisable GL_BLEND;
1000} 1673}
1001 1674
1002############################################################################# 1675#############################################################################
1003 1676
1004package CFClient::UI::Entry; 1677package CFClient::UI::EntryBase;
1005 1678
1006our @ISA = CFClient::UI::Label::; 1679our @ISA = CFClient::UI::Label::;
1007 1680
1008use SDL; 1681use CFClient::OpenGL;
1009use SDL::OpenGL;
1010 1682
1011sub new { 1683sub new {
1012 my $class = shift; 1684 my $class = shift;
1013 1685
1014 $class->SUPER::new ( 1686 $class->SUPER::new (
1015 fg => [1, 1, 1], 1687 fg => [1, 1, 1],
1016 bg => [0, 0, 0, 0.2], 1688 bg => [0, 0, 0, 0.2],
1017 active_bg => [1, 1, 1, 0.5], 1689 active_bg => [1, 1, 1, 0.5],
1018 active_fg => [0, 0, 0], 1690 active_fg => [0, 0, 0],
1019 can_hover => 1, 1691 can_hover => 1,
1020 can_focus => 1, 1692 can_focus => 1,
1693 valign => 0,
1694 can_events => 1,
1695 #text => ...
1696 #hidden => "*",
1021 @_ 1697 @_
1022 ) 1698 )
1023} 1699}
1024 1700
1025sub _set_text { 1701sub _set_text {
1026 my ($self, $text) = @_; 1702 my ($self, $text) = @_;
1027 1703
1704 delete $self->{cur_h};
1705
1706 return if $self->{text} eq $text;
1707
1028 $self->{last_activity} = $::NOW; 1708 $self->{last_activity} = $::NOW;
1029
1030 $self->{text} = $text; 1709 $self->{text} = $text;
1031 $self->{layout}->set_width ($self->{w});
1032 $self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height});
1033 1710
1034 $text =~ s/./*/g if $self->{hidden}; 1711 $text =~ s/./*/g if $self->{hidden};
1712 $self->{layout}->set_text ("$text ");
1713 delete $self->{size_req};
1035 1714
1036 $self->{layout}->set_markup ($self->escape_text ($text) . " "); 1715 $self->_emit (changed => $self->{text});
1037 1716
1038 $text = substr $text, 0, $self->{cursor}; 1717 $self->realloc;
1039 utf8::encode $text; 1718 $self->update;
1040
1041 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
1042}
1043
1044sub size_request {
1045 my ($self) = @_;
1046
1047 my ($w, $h) = $self->SUPER::size_request;
1048
1049 ($w + 1, $h) # add 1 for cursor
1050}
1051
1052sub size_allocate {
1053 my ($self, $x, $y, $w, $h) = @_;
1054
1055 $self->SUPER::size_allocate ($x, $y, $w, $h);
1056
1057 $self->_set_text ($self->{text});
1058} 1719}
1059 1720
1060sub set_text { 1721sub set_text {
1061 my ($self, $text) = @_; 1722 my ($self, $text) = @_;
1062 1723
1063 $self->{cursor} = length $text; 1724 $self->{cursor} = length $text;
1064 $self->_set_text ($text); 1725 $self->_set_text ($text);
1065 $self->update; 1726}
1727
1728sub get_text {
1729 $_[0]{text}
1730}
1731
1732sub size_request {
1733 my ($self) = @_;
1734
1735 my ($w, $h) = $self->SUPER::size_request;
1736
1737 ($w + 1, $h) # add 1 for cursor
1066} 1738}
1067 1739
1068sub key_down { 1740sub key_down {
1069 my ($self, $ev) = @_; 1741 my ($self, $ev) = @_;
1070 1742
1071 my $mod = $ev->key_mod; 1743 my $mod = $ev->{mod};
1072 my $sym = $ev->key_sym; 1744 my $sym = $ev->{sym};
1073
1074 my $uni = $ev->key_unicode; 1745 my $uni = $ev->{unicode};
1075 1746
1076 my $text = $self->get_text; 1747 my $text = $self->get_text;
1077 1748
1078 if ($sym == SDLK_BACKSPACE) { 1749 if ($uni == 8) {
1079 substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; 1750 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1080 } elsif ($sym == SDLK_DELETE) { 1751 } elsif ($uni == 127) {
1081 substr $text, $self->{cursor}, 1, ""; 1752 substr $text, $self->{cursor}, 1, "";
1082 } elsif ($sym == SDLK_LEFT) { 1753 } elsif ($sym == CFClient::SDLK_LEFT) {
1083 --$self->{cursor} if $self->{cursor}; 1754 --$self->{cursor} if $self->{cursor};
1084 } elsif ($sym == SDLK_RIGHT) { 1755 } elsif ($sym == CFClient::SDLK_RIGHT) {
1085 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 1756 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1086 } elsif ($sym == SDLK_HOME) { 1757 } elsif ($sym == CFClient::SDLK_HOME) {
1087 $self->{cursor} = 0; 1758 $self->{cursor} = 0;
1088 } elsif ($sym == SDLK_END) { 1759 } elsif ($sym == CFClient::SDLK_END) {
1089 $self->{cursor} = length $text; 1760 $self->{cursor} = length $text;
1761 } elsif ($uni == 27) {
1762 $self->_emit ('escape');
1090 } elsif ($uni) { 1763 } elsif ($uni) {
1091 substr $text, $self->{cursor}++, 0, chr $uni; 1764 substr $text, $self->{cursor}++, 0, chr $uni;
1765 } else {
1766 return 0;
1092 } 1767 }
1093 1768
1094 $self->_set_text ($text); 1769 $self->_set_text ($text);
1095 $self->update; 1770
1771 $self->realloc;
1772
1773 1
1096} 1774}
1097 1775
1098sub focus_in { 1776sub focus_in {
1099 my ($self) = @_; 1777 my ($self) = @_;
1100 1778
… …
1115 utf8::encode $text; 1793 utf8::encode $text;
1116 $self->{cursor} = length substr $text, 0, $idx; 1794 $self->{cursor} = length substr $text, 0, $idx;
1117 1795
1118 $self->_set_text ($self->{text}); 1796 $self->_set_text ($self->{text});
1119 $self->update; 1797 $self->update;
1798
1799 1
1120} 1800}
1121 1801
1122sub mouse_motion { 1802sub mouse_motion {
1123 my ($self, $ev, $x, $y) = @_; 1803 my ($self, $ev, $x, $y) = @_;
1124# 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
1125} 1807}
1126 1808
1127sub _draw { 1809sub _draw {
1128 my ($self) = @_; 1810 my ($self) = @_;
1129 1811
1130 local $self->{fg} = $self->{fg}; 1812 local $self->{fg} = $self->{fg};
1131 1813
1132 if ($FOCUS == $self) { 1814 if ($FOCUS == $self) {
1133 glColor @{$self->{active_bg}}; 1815 glColor_premultiply @{$self->{active_bg}};
1134 $self->{fg} = $self->{active_fg}; 1816 $self->{fg} = $self->{active_fg};
1135 } else { 1817 } else {
1136 glColor @{$self->{bg}}; 1818 glColor_premultiply @{$self->{bg}};
1137 } 1819 }
1138 1820
1139 glEnable GL_BLEND; 1821 glEnable GL_BLEND;
1140 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 1822 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1141 glBegin GL_QUADS; 1823 glBegin GL_QUADS;
1142 glVertex 0 , 0; 1824 glVertex 0 , 0;
1143 glVertex 0 , $self->{h}; 1825 glVertex 0 , $self->{h};
1144 glVertex $self->{w}, $self->{h}; 1826 glVertex $self->{w}, $self->{h};
1145 glVertex $self->{w}, 0; 1827 glVertex $self->{w}, 0;
… …
1148 1830
1149 $self->SUPER::_draw; 1831 $self->SUPER::_draw;
1150 1832
1151 #TODO: force update every cursor change :( 1833 #TODO: force update every cursor change :(
1152 if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) { 1834 if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
1835
1836 unless (exists $self->{cur_h}) {
1837 my $text = substr $self->{text}, 0, $self->{cursor};
1838 utf8::encode $text;
1839
1840 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1841 }
1842
1153 glColor @{$self->{fg}}; 1843 glColor @{$self->{fg}};
1154 glBegin GL_LINES; 1844 glBegin GL_LINES;
1155 glVertex $self->{cur_x}, $self->{cur_y};
1156 glVertex $self->{cur_x}, $self->{cur_y} + $self->{cur_h}; 1845 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1846 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1157 glEnd; 1847 glEnd;
1158 } 1848 }
1159} 1849}
1160 1850
1161package CFClient::UI::LineEntry; 1851package CFClient::UI::Entry;
1162 1852
1163our @ISA = CFClient::UI::Entry::; 1853our @ISA = CFClient::UI::EntryBase::;
1164 1854
1165use SDL; 1855use CFClient::OpenGL;
1166use SDL::OpenGL;
1167 1856
1168sub key_down { 1857sub key_down {
1169 my ($self, $ev) = @_; 1858 my ($self, $ev) = @_;
1170 1859
1171 my $sym = $ev->key_sym; 1860 my $sym = $ev->{sym};
1172 1861
1173 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} = '';
1174 $self->emit (activate => $self->get_text); 1867 $self->_emit (activate => $txt);
1175 $self->update; 1868 $self->update;
1176 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
1177 } else { 1892 } else {
1178 $self->SUPER::key_down ($ev); 1893 return $self->SUPER::key_down ($ev)
1894 }
1895
1179 } 1896 1
1180
1181} 1897}
1182 1898
1183############################################################################# 1899#############################################################################
1184 1900
1185package CFClient::UI::Button; 1901package CFClient::UI::Button;
1186 1902
1187our @ISA = CFClient::UI::Label::; 1903our @ISA = CFClient::UI::Label::;
1188 1904
1189use SDL; 1905use CFClient::OpenGL;
1190use SDL::OpenGL;
1191 1906
1192my @tex = 1907my @tex =
1193 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } 1908 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1194 qw(b1_button_active.png); 1909 qw(b1_button_active.png);
1195 1910
1196sub new { 1911sub new {
1197 my $class = shift; 1912 my $class = shift;
1198 1913
1199 $class->SUPER::new ( 1914 $class->SUPER::new (
1200 padding => 4, 1915 padding_x => 4,
1916 padding_y => 4,
1201 fg => [1, 1, 1], 1917 fg => [1, 1, 1],
1202 bg => [1, 1, 1, 0.2],
1203 active_fg => [1, 1, 0], 1918 active_fg => [0, 0, 1],
1204 can_hover => 1, 1919 can_hover => 1,
1920 align => 0,
1921 valign => 0,
1922 can_events => 1,
1205 @_ 1923 @_
1206 ) 1924 )
1207} 1925}
1208 1926
1927sub activate { }
1928
1209sub button_up { 1929sub button_up {
1210 my ($self, $ev, $x, $y) = @_; 1930 my ($self, $ev, $x, $y) = @_;
1211 1931
1932 $self->emit ("activate")
1212 if ($x >= 0 && $x < $self->{w} 1933 if $x >= 0 && $x < $self->{w}
1213 && $y >= 0 && $y < $self->{h}) { 1934 && $y >= 0 && $y < $self->{h};
1214 $self->emit ("activate"); 1935
1215 } 1936 1
1216} 1937}
1217 1938
1218sub _draw { 1939sub _draw {
1219 my ($self) = @_; 1940 my ($self) = @_;
1220 1941
1221 local $self->{fg} = $self->{fg}; 1942 local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1222 my $tex = $tex[0];
1223 1943
1224 glEnable GL_BLEND;
1225 glEnable GL_TEXTURE_2D; 1944 glEnable GL_TEXTURE_2D;
1226 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1227
1228 if ($GRAB == $self) {
1229 $self->{fg} = $self->{active_fg};
1230 }
1231
1232 glBindTexture GL_TEXTURE_2D, $tex->{name};
1233 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1945 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1946 glColor 0, 0, 0, 1;
1234 1947
1235 $tex->draw_quad (0, 0, $self->{w}, $self->{h}); 1948 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1236 1949
1237 glDisable GL_TEXTURE_2D; 1950 glDisable GL_TEXTURE_2D;
1238 glDisable GL_BLEND;
1239 1951
1240 $self->SUPER::_draw; 1952 $self->SUPER::_draw;
1241} 1953}
1242 1954
1243############################################################################# 1955#############################################################################
1244 1956
1245package CFClient::UI::CheckBox; 1957package CFClient::UI::CheckBox;
1246 1958
1247our @ISA = CFClient::UI::DrawBG::; 1959our @ISA = CFClient::UI::DrawBG::;
1248 1960
1249use SDL; 1961my @tex =
1250use SDL::OpenGL; 1962 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1963 qw(c1_checkbox_bg.png c1_checkbox_active.png);
1964
1965use CFClient::OpenGL;
1251 1966
1252sub new { 1967sub new {
1253 my $class = shift; 1968 my $class = shift;
1254 1969
1255 $class->SUPER::new ( 1970 $class->SUPER::new (
1256 padding => 2, 1971 padding_x => 2,
1972 padding_y => 2,
1257 fg => [1, 1, 1], 1973 fg => [1, 1, 1],
1258 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],
1259 state => 0, 1977 state => 0,
1260 can_hover => 1, 1978 can_hover => 1,
1261 @_ 1979 @_
1262 ) 1980 )
1263} 1981}
1264 1982
1265sub size_request { 1983sub size_request {
1266 my ($self) = @_; 1984 my ($self) = @_;
1267 1985
1268 ($self->{padding} * 2 + 6) x 2 1986 (6) x 2
1269}
1270
1271sub size_allocate {
1272 my ($self, $x, $y, $w, $h) = @_;
1273
1274 $self->_size_allocate ($x, $y, $w, $h);
1275} 1987}
1276 1988
1277sub button_down { 1989sub button_down {
1278 my ($self, $ev, $x, $y) = @_; 1990 my ($self, $ev, $x, $y) = @_;
1279 1991
1280 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1992 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1281 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1993 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1282 $self->{state} = !$self->{state}; 1994 $self->{state} = !$self->{state};
1283 $self->emit (changed => $self->{state}); 1995 $self->_emit (changed => $self->{state});
1996 } else {
1997 return 0
1998 }
1999
1284 } 2000 1
1285} 2001}
1286 2002
1287sub _draw { 2003sub _draw {
1288 my ($self) = @_; 2004 my ($self) = @_;
1289 2005
1290 $self->SUPER::_draw; 2006 $self->SUPER::_draw;
1291 2007
1292 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 2008 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1293 2009
1294 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 2010 my ($w, $h) = @$self{qw(w h)};
1295 2011
2012 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2013
1296 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 2014 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1297 2015
1298 glBegin GL_LINE_LOOP; 2016 my $tex = $self->{state} ? $tex[1] : $tex[0];
1299 glVertex 0 , 0; 2017
1300 glVertex 0 , $s; 2018 glEnable GL_TEXTURE_2D;
1301 glVertex $s, $s; 2019 $tex->draw_quad_alpha (0, 0, $s, $s);
1302 glVertex $s, 0; 2020 glDisable GL_TEXTURE_2D;
2021}
2022
2023#############################################################################
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
2083package CFClient::UI::VGauge;
2084
2085our @ISA = CFClient::UI::Base::;
2086
2087use List::Util qw(min max);
2088
2089use CFClient::OpenGL;
2090
2091my %tex = (
2092 food => [
2093 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2094 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2095 ],
2096 grace => [
2097 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2098 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2099 ],
2100 hp => [
2101 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2102 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2103 ],
2104 mana => [
2105 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2106 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2107 ],
2108);
2109
2110# eg. VGauge->new (gauge => 'food'), default gauge: food
2111sub new {
2112 my $class = shift;
2113
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};
2120
2121 $self
2122}
2123
2124sub size_request {
2125 my ($self) = @_;
2126
2127 #my $tex = $tex{$self->{type}}[0];
2128 #@$tex{qw(w h)}
2129 (0, 0)
2130}
2131
2132sub set_max {
2133 my ($self, $max) = @_;
2134
2135 return if $self->{max_val} == $max;
2136
2137 $self->{max_val} = $max;
2138 $self->update;
2139}
2140
2141sub set_value {
2142 my ($self, $val, $max) = @_;
2143
2144 $self->set_max ($max)
2145 if defined $max;
2146
2147 return if $self->{val} == $val;
2148
2149 $self->{val} = $val;
2150 $self->update;
2151}
2152
2153sub _draw {
2154 my ($self) = @_;
2155
2156 my $tex = $tex{$self->{type}};
2157 my ($t1, $t2, $t3) = @$tex;
2158
2159 my ($w, $h) = ($self->{w}, $self->{h});
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
2168 my $ycut = $self->{val} / ($self->{max_val} || 1);
2169
2170 my $ycut1 = max 0, min 1, $ycut;
2171 my $ycut2 = max 0, min 1, $ycut - 1;
2172
2173 my $h1 = $self->{h} * (1 - $ycut1);
2174 my $h2 = $self->{h} * (1 - $ycut2);
2175
2176 glEnable GL_BLEND;
2177 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2178 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2179 glEnable GL_TEXTURE_2D;
2180 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2181
2182 glBindTexture GL_TEXTURE_2D, $t1->{name};
2183 glBegin GL_QUADS;
2184 glTexCoord 0 , 0; glVertex 0 , 0;
2185 glTexCoord 0 , $t1->{t} * (1 - $ycut1); glVertex 0 , $h1;
2186 glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut1); glVertex $w, $h1;
2187 glTexCoord $t1->{s}, 0; glVertex $w, 0;
1303 glEnd; 2188 glEnd;
1304 2189
1305 if ($self->{state}) { 2190 my $ycut1 = List::Util::min 1, $ycut;
2191 glBindTexture GL_TEXTURE_2D, $t2->{name};
2192 glBegin GL_QUADS;
2193 glTexCoord 0 , $t2->{t} * (1 - $ycut1); glVertex 0 , $h1;
2194 glTexCoord 0 , $t2->{t} * (1 - $ycut2); glVertex 0 , $h2;
2195 glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut2); glVertex $w, $h2;
2196 glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut1); glVertex $w, $h1;
2197 glEnd;
2198
2199 if ($t3) {
2200 glBindTexture GL_TEXTURE_2D, $t3->{name};
1306 glBegin GL_LINES; 2201 glBegin GL_QUADS;
1307 glVertex 0 , 0; 2202 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
1308 glVertex $s, $s; 2203 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};
1309 glVertex $s, 0; 2204 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};
1310 glVertex 0 , $s; 2205 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
1311 glEnd; 2206 glEnd;
1312 } 2207 }
2208
2209 glDisable GL_BLEND;
2210 glDisable GL_TEXTURE_2D;
1313} 2211}
1314 2212
1315############################################################################# 2213#############################################################################
1316 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
1317package CFClient::UI::Slider; 2262package CFClient::UI::Slider;
1318 2263
1319use strict; 2264use strict;
1320 2265
1321use SDL::OpenGL; 2266use CFClient::OpenGL;
1322 2267
1323our @ISA = CFClient::UI::DrawBG::; 2268our @ISA = CFClient::UI::DrawBG::;
1324 2269
1325my @tex = 2270my @tex =
1326 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } 2271 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
1327 qw(s1_slider.png s1_slider_bg.png); 2272 qw(s1_slider.png s1_slider_bg.png);
1328 2273
1329sub new { 2274sub new {
1330 my $class = shift; 2275 my $class = shift;
1331 2276
1332 # range [value, low, high, page] 2277 # range [value, low, high, page, unit]
1333 2278
1334 # TODO: 0-width page 2279 # TODO: 0-width page
1335 # TODO: req_w/h are wrong with vertical 2280 # TODO: req_w/h are wrong with vertical
1336 # TODO: calculations are off 2281 # TODO: calculations are off
1337 my $self = $class->SUPER::new ( 2282 my $self = $class->SUPER::new (
1338 fg => [1, 1, 1], 2283 fg => [1, 1, 1],
1339 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],
1340 range => [0, 0, 100, 10], 2287 range => [0, 0, 100, 10, 0],
1341 req_w => 40, 2288 min_w => $::WIDTH / 80,
1342 req_h => 13, 2289 min_h => $::WIDTH / 80,
1343 vertical => 0, 2290 vertical => 0,
1344 can_hover => 1, 2291 can_hover => 1,
2292 inner_pad => 0.02,
1345 @_ 2293 @_
1346 ); 2294 );
1347 2295
2296 $self->set_value ($self->{range}[0]);
2297 $self->update;
2298
1348 $self 2299 $self
1349} 2300}
1350 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
1351sub size_request { 2336sub size_request {
1352 my ($self) = @_; 2337 my ($self) = @_;
1353 2338
1354 my $w = $self->{req_w}; 2339 ($self->{req_w}, $self->{req_h})
1355 my $h = $self->{req_h};
1356
1357 $self->{vertical} ? ($h, $w) : ($w, $h)
1358} 2340}
1359 2341
1360sub button_down { 2342sub button_down {
1361 my ($self, $ev, $x, $y) = @_; 2343 my ($self, $ev, $x, $y) = @_;
1362 2344
1363 $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
1364 $self->mouse_motion ($ev, $x, $y); 2349 $self->mouse_motion ($ev, $x, $y)
1365} 2350}
1366 2351
1367sub mouse_motion { 2352sub mouse_motion {
1368 my ($self, $ev, $x, $y) = @_; 2353 my ($self, $ev, $x, $y) = @_;
1369 2354
1370 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
1371 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2383 my ($value, $lo, $hi, $page) = @{$self->{range}};
2384 my $range = ($hi - $page - $lo) || 1e-100;
1372 2385
1373 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2386 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
1374 2387
1375 $x = $x * ($hi - $lo) / $w + $lo; 2388 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
1376 $x = $lo if $x < $lo; 2389 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
1377 $x = $hi - $page if $x > $hi - $page;
1378 $self->{range}[0] = $x;
1379 2390
1380 $self->emit (changed => $x); 2391 $value = ($value - $lo) / $range;
1381 $self->update; 2392 $value = $value * $self->{scale} + $self->{offset};
1382 }
1383}
1384 2393
1385sub _draw { 2394 $self->{knob_x} = $value - $knob_w * 0.5;
1386 my ($self) = @_; 2395 $self->{knob_w} = $knob_w;
2396 }
1387 2397
1388 $self->SUPER::_draw (); 2398 $self->SUPER::_draw ();
1389 2399
1390 my ($w, $h) = @$self{qw(w h)}; 2400 glScale $self->{w}, $self->{h};
1391 2401
1392 if ($self->{vertical}) { 2402 if ($self->{vertical}) {
1393 # draw a vertical slider like a rotated horizontal slider 2403 # draw a vertical slider like a rotated horizontal slider
1394 2404
2405 glTranslate 1, 0, 0;
1395 glRotate 90, 0, 0, 1; 2406 glRotate 90, 0, 0, 1;
1396 glTranslate 0, -$self->{w}, 0;
1397
1398 ($w, $h) = ($h, $w);
1399 } 2407 }
1400 2408
1401 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg}; 2409 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
1402 my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg}; 2410 my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
1403 2411
1404 my ($value, $lo, $hi, $page) = @{$self->{range}};
1405
1406 # the inner_* stuff is for generating a padding for the slider handle,
1407 # so that the handle doesn't leave the texture. This calculation isn't 100%
1408 # correct propably, but it does the job for now
1409 my $inner_pad = 5; # 5% of width for slider bg texture border
1410 my $inner_pad_px = ($w / 100) * $inner_pad; # % to pixels
1411 my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
1412
1413 $page = int $page * $inner_w / ($hi - $lo);
1414 $value = int +($value - $lo) * $inner_w / ($hi - $lo);
1415
1416 $w -= $page;
1417 $page &= ~1;
1418 glTranslate $page * 0.5, 0, 0;
1419 $page ||= 2;
1420
1421 my $knob_a = $inner_pad_px + ($value - $page * 0.5);
1422 my $knob_b = $inner_pad_px + ($value + $page * 0.5);
1423
1424 glEnable GL_BLEND;
1425 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1426 glEnable GL_TEXTURE_2D; 2412 glEnable GL_TEXTURE_2D;
1427 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2413 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1428 2414
1429 # draw background 2415 # draw background
1430 $tex[1]->draw_quad (0, 0, $w, $h); 2416 $tex[1]->draw_quad_alpha (0, 0, 1, 1);
1431 2417
1432 # draw handle 2418 # draw handle
1433 $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);
1434 2420
1435 glDisable GL_BLEND;
1436 glDisable GL_TEXTURE_2D; 2421 glDisable GL_TEXTURE_2D;
1437} 2422}
1438 2423
1439############################################################################# 2424#############################################################################
1440 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
1441package CFClient::UI::TextView; 2467package CFClient::UI::TextView;
1442 2468
1443our @ISA = CFClient::UI::HBox::; 2469our @ISA = CFClient::UI::HBox::;
1444 2470
1445use SDL::OpenGL; 2471use CFClient::OpenGL;
1446 2472
1447sub new { 2473sub new {
1448 my $class = shift; 2474 my $class = shift;
1449 2475
1450 my $self = $class->SUPER::new ( 2476 my $self = $class->SUPER::new (
1451 par => [], 2477 fontsize => 1,
2478 can_events => 0,
2479 #font => default_font
1452 @_, 2480 @_,
2481
2482 layout => (new CFClient::Layout 1),
2483 par => [],
2484 height => 0,
1453 children => [ 2485 children => [
1454 (new CFClient::UI::Empty expand => 1), 2486 (new CFClient::UI::Empty expand => 1),
1455 (new CFClient::UI::Slider vertical => 1), 2487 (new CFClient::UI::Slider vertical => 1),
1456 ], 2488 ],
1457 ); 2489 );
1458 2490
2491 $self->{children}[1]->connect (changed => sub { $self->update });
2492
1459 $self 2493 $self
1460} 2494}
1461 2495
2496sub set_fontsize {
2497 my ($self, $fontsize) = @_;
2498
2499 $self->{fontsize} = $fontsize;
2500 $self->reflow;
2501}
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
2516sub text_size {
2517 my ($self, $text, $indent) = @_;
2518
2519 my $layout = $self->{layout};
2520
2521 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2522 $layout->set_width ($self->{children}[0]{w} - $indent);
2523 $layout->set_indent (-$self->{fontsize} * $::FONTSIZE * 4);
2524 $layout->set_markup ($text);
2525
2526 $layout->size
2527}
2528
2529sub reflow {
2530 my ($self) = @_;
2531
2532 $self->{need_reflow}++;
2533 $self->update;
2534}
2535
2536sub set_offset {
2537 my ($self, $offset) = @_;
2538
2539 # todo: base offset on lines or so, not on pixels
2540 $self->{children}[1]->set_value ($offset);
2541}
2542
2543sub clear {
2544 my ($self) = @_;
2545
2546 $self->{par} = [];
2547 $self->{height} = 0;
2548 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2549}
2550
1462sub add_paragraph { 2551sub add_paragraph {
1463 my ($self, $color, $text) = @_; 2552 my ($self, $color, $text, $indent) = @_;
1464 2553
1465 push @{$self->{par}}, [$color, $text]; 2554 for my $line (split /\n/, $text) {
1466 my $count = scalar @{$self->{par}}; 2555 my ($w, $h) = $self->text_size ($line);
1467 $self->{children}[1]{range} = [$count - 1, 0, $count, 1]; 2556 $self->{height} += $h;
1468 $self->{children}[1]->update; 2557 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2558 }
2559
2560 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2561}
2562
2563sub update {
2564 my ($self) = @_;
2565
2566 $self->SUPER::update;
2567
2568 return unless $self->{h} > 0;
2569
2570 delete $self->{texture};
2571
2572 $ROOT->on_post_alloc ($self, sub {
2573 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2574
2575 if (delete $self->{need_reflow}) {
2576 my $height = 0;
2577
2578 my $layout = $self->{layout};
2579
2580 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2581
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 }
2594
2595 $self->{height} = $height;
2596
2597 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2598
2599 delete $self->{texture};
2600 }
2601
2602 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2603 glClearColor 0, 0, 0, 0;
2604 glClear GL_COLOR_BUFFER_BIT;
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
2617 glEnable GL_BLEND;
2618 #TODO# not correct in windows where rgba is forced off
2619 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2620
2621 for my $par (@{$self->{par}}) {
2622 my $h = $par->[1];
2623
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);
2628 $layout->set_markup ($par->[4]);
2629
2630 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2631
2632 glRasterPos $par->[3], $y - $y0;
2633 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2634 }
2635
2636 $y += $h;
2637 }
2638
2639 glDisable GL_BLEND;
2640 };
2641 });
1469} 2642}
1470 2643
1471sub _draw { 2644sub _draw {
1472 my ($self) = @_; 2645 my ($self) = @_;
1473 2646
1474 my $par = $self->{par};
1475
1476 my $bottom = (scalar @$par) - 1;
1477
1478 my $w = $self->{children}[0]{w};
1479 my $y = $self->{h};
1480
1481 glEnable GL_BLEND;
1482 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1483 glEnable GL_TEXTURE_2D; 2647 glEnable GL_TEXTURE_2D;
1484 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 2648 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1485 2649 glColor 0, 0, 0, 1;
1486 # TODO: everything! 2650 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
1487 while ($y > 0 && $bottom >= 0) {
1488 my $par = $par->[$bottom--];
1489
1490 my $layout = new CFClient::Layout;
1491
1492 $layout->set_height ($::FONTSIZE);
1493 $layout->set_width ($w);
1494 $layout->set_text ($par->[1]);
1495 my $tex = new_from_layout CFClient::Texture $layout;
1496 $y -= $tex->{h};
1497
1498 glColor @{ $par->[0] };
1499 $tex->draw_quad (0, $y);
1500 }
1501
1502 glDisable GL_TEXTURE_2D; 2651 glDisable GL_TEXTURE_2D;
1503 glDisable GL_BLEND; 2652
2653 $self->{children}[1]->draw;
2654
1504} 2655}
1505 2656
1506############################################################################# 2657#############################################################################
1507 2658
1508package CFClient::UI::MapWidget;
1509
1510use strict;
1511
1512use List::Util qw(min max);
1513
1514use SDL;
1515use SDL::OpenGL;
1516
1517our @ISA = CFClient::UI::Base::;
1518
1519sub new {
1520 my $class = shift;
1521
1522 $class->SUPER::new (
1523 z => -1,
1524 can_focus => 1,
1525 list => (glGenLists 1),
1526 @_
1527 )
1528}
1529
1530sub key_down {
1531 print "MAPKEYDOWN\n";
1532}
1533
1534sub key_up {
1535}
1536
1537sub size_request {
1538 (
1539 1 + 32 * int $::WIDTH / 32,
1540 1 + 32 * int $::HEIGHT / 32,
1541 )
1542}
1543
1544sub update {
1545 my ($self) = @_;
1546
1547 $self->{need_update} = 1;
1548 $self->SUPER::update;
1549}
1550
1551sub draw {
1552 my ($self) = @_;
1553
1554 $self->{need_update}++;#d#
1555 if (delete $self->{need_update}) {
1556 glNewList $self->{list}, GL_COMPILE;
1557
1558 my $sw = int $::WIDTH / 32;
1559 my $sh = int $::HEIGHT / 32;
1560
1561 if ($::MAP) {
1562 my ($w, $h, $data) = $::MAP->draw (0, 0, $sw, $sh);
1563
1564 if ($::CFG->{fow_enable}) {
1565 if ($::CFG->{fow_smooth}) { # smooth fog of war
1566 glConvolutionParameter GL_CONVOLUTION_2D, GL_CONVOLUTION_BORDER_MODE, GL_CONSTANT_BORDER;
1567 glConvolutionFilter2D
1568 GL_CONVOLUTION_2D,
1569 GL_ALPHA,
1570 3, 3,
1571 GL_ALPHA, GL_FLOAT,
1572 pack "f*",
1573 0.1, 0.1, 0.1,
1574 0.1, 0.2, 0.1,
1575 0.1, 0.1, 0.1,
1576 ;
1577 glEnable GL_CONVOLUTION_2D;
1578 }
1579
1580 my $tex = new CFClient::Texture
1581 w => $w,
1582 h => $h,
1583 data => $data,
1584 internalformat => GL_ALPHA,
1585 format => GL_ALPHA;
1586
1587 glDisable GL_CONVOLUTION_2D if $::CFG->{fow_smooth};
1588
1589 glEnable GL_BLEND;
1590 glEnable GL_TEXTURE_2D;
1591 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1592
1593 glColor +($::CFG->{fow_intensity}) x 3, 1;
1594 $tex->draw_quad (0, 0, $w * 32, $h * 32);
1595
1596 glDisable GL_TEXTURE_2D;
1597 glDisable GL_BLEND;
1598 }
1599 }
1600
1601 glEndList;
1602 }
1603
1604 glCallList $self->{list};
1605
1606 if ($FOCUS != $self) {
1607 glColor 64/255, 64/255, 64/255;
1608 glLogicOp GL_AND;
1609 glEnable GL_COLOR_LOGIC_OP;
1610 glBegin GL_QUADS;
1611 glVertex 0, 0;
1612 glVertex 0, $::HEIGHT;
1613 glVertex $::WIDTH, $::HEIGHT;
1614 glVertex $::WIDTH, 0;
1615 glEnd;
1616 glDisable GL_COLOR_LOGIC_OP;
1617 }
1618}
1619
1620my %DIR = (
1621 SDLK_KP8, [1, "north"],
1622 SDLK_KP9, [2, "northeast"],
1623 SDLK_KP6, [3, "east"],
1624 SDLK_KP3, [4, "southeast"],
1625 SDLK_KP2, [5, "south"],
1626 SDLK_KP1, [6, "southwest"],
1627 SDLK_KP4, [7, "west"],
1628 SDLK_KP7, [8, "northwest"],
1629
1630 SDLK_UP, [1, "north"],
1631 SDLK_RIGHT, [3, "east"],
1632 SDLK_DOWN, [5, "south"],
1633 SDLK_LEFT, [7, "west"],
1634);
1635
1636sub key_down {
1637 my ($self, $ev) = @_;
1638
1639 my $mod = $ev->key_mod;
1640 my $sym = $ev->key_sym;
1641
1642 if ($sym == SDLK_KP5) {
1643 $::CONN->user_send ("command stay fire");
1644 } elsif ($sym == SDLK_a) {
1645 $::CONN->user_send ("command apply");
1646 } elsif (exists $DIR{$sym}) {
1647 if ($mod & KMOD_SHIFT) {
1648 $self->{shft}++;
1649 $::CONN->user_send ("command fire $DIR{$sym}[0]");
1650 } elsif ($mod & KMOD_CTRL) {
1651 $self->{ctrl}++;
1652 $::CONN->user_send ("command run $DIR{$sym}[0]");
1653 } else {
1654 $::CONN->user_send ("command $DIR{$sym}[1]");
1655 }
1656 }
1657}
1658
1659sub key_up {
1660 my ($self, $ev) = @_;
1661
1662 my $mod = $ev->key_mod;
1663 my $sym = $ev->key_sym;
1664
1665 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
1666 $::CONN->user_send ("command fire_stop");
1667 }
1668 if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
1669 $::CONN->user_send ("command run_stop");
1670 }
1671}
1672
1673#############################################################################
1674
1675package CFClient::UI::Animator; 2659package CFClient::UI::Animator;
1676 2660
1677use SDL::OpenGL; 2661use CFClient::OpenGL;
1678 2662
1679our @ISA = CFClient::UI::Bin::; 2663our @ISA = CFClient::UI::Bin::;
1680 2664
1681sub moveto { 2665sub moveto {
1682 my ($self, $x, $y) = @_; 2666 my ($self, $x, $y) = @_;
… …
1720 2704
1721sub new { 2705sub new {
1722 my $class = shift; 2706 my $class = shift;
1723 2707
1724 my $self = $class->SUPER::new ( 2708 my $self = $class->SUPER::new (
1725 state => 0, 2709 state => 0,
1726 connect_activate => \&toggle_flopper, 2710 on_activate => \&toggle_flopper,
1727 @_ 2711 @_
1728 ); 2712 );
1729 2713
1730 if ($self->{state}) {
1731 $self->{state} = 0;
1732 $self->toggle_flopper;
1733 }
1734
1735 $self 2714 $self
1736} 2715}
1737 2716
1738sub toggle_flopper { 2717sub toggle_flopper {
1739 my ($self) = @_; 2718 my ($self) = @_;
1740 2719
1741 # TODO: use animation 2720 $self->{other}->toggle_visibility;
1742 if ($self->{state} = !$self->{state}) { 2721}
1743 $CFClient::UI::TOPLEVEL->add ($self->{other}); 2722
1744 $self->{other}->move ( 2723#############################################################################
1745 ($::WIDTH - $self->{other}{w}) * 0.5, 2724
1746 ($::HEIGHT - $self->{other}{h}) * 0.5, 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 },
1747 ); 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
2980 $self->_emit ("popdown");
2981 $self->{hover}[1]->() if $self->{hover};
1748 } else { 2982 } else {
1749 $CFClient::UI::TOPLEVEL->remove ($self->{other}); 2983 return 0
2984 }
2985
1750 } 2986 1
1751} 2987}
1752 2988
1753############################################################################# 2989#############################################################################
1754 2990
1755package CFClient::UI::Toplevel; 2991package CFClient::UI::Multiplexer;
1756 2992
1757our @ISA = CFClient::UI::Container::; 2993our @ISA = CFClient::UI::Container::;
1758 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
1759sub size_request { 3036sub size_request {
1760 ($::WIDTH, $::HEIGHT) 3037 my ($self) = @_;
3038
3039 $self->{current}->size_request
1761} 3040}
1762 3041
1763sub size_allocate { 3042sub size_allocate {
1764 my ($self, $x, $y, $w, $h) = @_; 3043 my ($self, $w, $h) = @_;
1765 3044
1766 $self->_size_allocate ($x, $y, $w, $h); 3045 $self->{current}->configure (0, 0, $w, $h);
1767
1768 $_->size_allocate ($_->{x}, $_->{y}, $_->size_request)
1769 for @{$self->{children}};
1770} 3046}
1771 3047
1772sub translate { 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
3621package CFClient::UI::Root;
3622
3623our @ISA = CFClient::UI::Container::;
3624
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}
3641
3642sub size_request {
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
3660}
3661
3662sub size_allocate {
3663 my ($self, $w, $h) = @_;
3664
3665 for my $child ($self->children) {
3666 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3667
3668 $X = $child->{force_x} if exists $child->{force_x};
3669 $Y = $child->{force_y} if exists $child->{force_y};
3670
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 {
1773 my ($self, $x, $y) = @_; 3679 my ($self, $x, $y) = @_;
1774 3680
1775 ($x, $y) 3681 ($x, $y)
1776} 3682}
1777 3683
3684sub coord2global {
3685 my ($self, $x, $y) = @_;
3686
3687 ($x, $y)
3688}
3689
1778sub update { 3690sub update {
1779 my ($self) = @_; 3691 my ($self) = @_;
1780 3692
1781 $self->size_allocate (0, 0, $::WIDTH, $::HEIGHT); 3693 $::WANT_REFRESH++;
1782 ::refresh ();
1783} 3694}
1784 3695
1785sub add { 3696sub add {
1786 my ($self, $widget) = @_; 3697 my ($self, @children) = @_;
1787 3698
3699 $_->{is_toplevel} = 1
3700 for @children;
3701
1788 $self->SUPER::add ($widget); 3702 $self->SUPER::add (@children);
1789
1790 $widget->size_allocate ($widget->{x}, $widget->{y}, $widget->size_request);
1791} 3703}
1792 3704
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 }
3718}
3719
3720sub on_refresh {
3721 my ($self, $id, $cb) = @_;
3722
3723 $self->{refresh_hook}{$id} = $cb;
3724}
3725
3726sub on_post_alloc {
3727 my ($self, $id, $cb) = @_;
3728
3729 $self->{post_alloc_hook}{$id} = $cb;
3730}
3731
1793sub draw { 3732sub draw {
1794 my ($self) = @_; 3733 my ($self) = @_;
3734
3735 while ($self->{refresh_hook}) {
3736 $_->()
3737 for values %{delete $self->{refresh_hook}};
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
3831
3832 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3833 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3834 glClear GL_COLOR_BUFFER_BIT;
3835
3836 glMatrixMode GL_PROJECTION;
3837 glLoadIdentity;
3838 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3839 glMatrixMode GL_MODELVIEW;
3840 glLoadIdentity;
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 }
1795 3848
1796 $self->_draw; 3849 $self->_draw;
1797} 3850}
1798 3851
1799############################################################################# 3852#############################################################################
1800 3853
1801package CFClient::UI; 3854package CFClient::UI;
1802 3855
1803$TOPLEVEL = new CFClient::UI::Toplevel; 3856$ROOT = new CFClient::UI::Root;
3857$TOOLTIP = new CFClient::UI::Tooltip z => 900;
1804 3858
18051 38591
1806 3860

Diff Legend

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