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

Diff Legend

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