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

Diff Legend

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