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.121 by root, Mon Apr 17 19:21:00 2006 UTC vs.
Revision 1.292 by root, Tue Jun 6 03:02:15 2006 UTC

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

Diff Legend

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