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

Diff Legend

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