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.222 by root, Mon May 22 03:59:51 2006 UTC vs.
Revision 1.262 by elmex, Wed May 31 13:44:26 2006 UTC

… …
5 5
6use Scalar::Util (); 6use Scalar::Util ();
7use List::Util (); 7use List::Util ();
8 8
9use CFClient; 9use CFClient;
10use CFClient::Texture;
10 11
11our ($FOCUS, $HOVER, $GRAB); # various widgets 12our ($FOCUS, $HOVER, $GRAB); # various widgets
12 13
14our $LAYOUT;
13our $ROOT; 15our $ROOT;
14our $TOOLTIP; 16our $TOOLTIP;
15our $BUTTON_STATE; 17our $BUTTON_STATE;
16 18
17our %WIDGET; # all widgets, weak-referenced 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}
18 43
19sub check_tooltip { 44sub check_tooltip {
20 if (!$GRAB) { 45 if (!$GRAB) {
21 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 46 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
22 if (length $widget->{tooltip}) { 47 if (length $widget->{tooltip}) {
23 48
24 if ($TOOLTIP->{owner} != $widget) { 49 if ($TOOLTIP->{owner} != $widget) {
50 $TOOLTIP->hide;
51
25 $TOOLTIP->{owner} = $widget; 52 $TOOLTIP->{owner} = $widget;
26 53
27 my $tip = $widget->{tooltip}; 54 my $tip = $widget->{tooltip};
28 55
29 $tip = $tip->($widget) if CODE:: eq ref $tip; 56 $tip = $tip->($widget) if CODE:: eq ref $tip;
30 57
31 $TOOLTIP->set_tooltip_from ($widget); 58 $TOOLTIP->set_tooltip_from ($widget);
32 $TOOLTIP->show; 59 $TOOLTIP->show;
33
34 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
35
36 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
37 if $x + $TOOLTIP->{w} > $::WIDTH;
38
39 $TOOLTIP->move ($x, $y);
40 $TOOLTIP->check_size;
41 $TOOLTIP->update;
42 } 60 }
43 61
44 return; 62 return;
45 } 63 }
46 } 64 }
… …
50 delete $TOOLTIP->{owner}; 68 delete $TOOLTIP->{owner};
51} 69}
52 70
53# class methods for events 71# class methods for events
54sub feed_sdl_key_down_event { 72sub feed_sdl_key_down_event {
55 $FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0]) 73 $FOCUS->emit (key_down => $_[0])
56 if $FOCUS; 74 if $FOCUS;
57} 75}
58 76
59sub feed_sdl_key_up_event { 77sub feed_sdl_key_up_event {
60 $FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0]) 78 $FOCUS->emit (key_up => $_[0])
61 if $FOCUS; 79 if $FOCUS;
62} 80}
63 81
64sub feed_sdl_button_down_event { 82sub feed_sdl_button_down_event {
65 my ($ev) = @_; 83 my ($ev) = @_;
… …
74 check_tooltip; 92 check_tooltip;
75 } 93 }
76 94
77 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 95 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
78 96
79 if ($GRAB) { 97 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
80 ($x, $y) = $GRAB->coord2local ($x, $y); 98 if $GRAB;
81 $GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
82 }
83} 99}
84 100
85sub feed_sdl_button_up_event { 101sub feed_sdl_button_up_event {
86 my ($ev) = @_; 102 my ($ev) = @_;
87 my ($x, $y) = ($ev->{x}, $ev->{y}); 103 my ($x, $y) = ($ev->{x}, $ev->{y});
88 104
89 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 105 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
90 106
91 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 107 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
92 108
93 if ($GRAB) { 109 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
94 ($x, $y) = $GRAB->coord2local ($x, $y); 110 if $GRAB;
95 $GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
96 }
97 111
98 if (!$BUTTON_STATE) { 112 if (!$BUTTON_STATE) {
99 my $grab = $GRAB; undef $GRAB; 113 my $grab = $GRAB; undef $GRAB;
100 $grab->update if $grab; 114 $grab->update if $grab;
101 $GRAB->update if $GRAB; 115 $GRAB->update if $GRAB;
… …
117 $HOVER->update if $HOVER && $HOVER->{can_hover}; 131 $HOVER->update if $HOVER && $HOVER->{can_hover};
118 132
119 check_tooltip; 133 check_tooltip;
120 } 134 }
121 135
122 if ($HOVER) {
123 ($x, $y) = $HOVER->coord2local ($x, $y);
124 $HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y); 136 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
125 } 137 if $HOVER;
126} 138}
127 139
128# convert position array to integers 140# convert position array to integers
129sub harmonize { 141sub harmonize {
130 my ($vals) = @_; 142 my ($vals) = @_;
… …
144 156
145 $_->update 157 $_->update
146 for @widgets; 158 for @widgets;
147} 159}
148 160
161sub reconfigure_widgets {
162 # make a copy, otherwise C<for> complains about freed values.
163 my @widgets = values %WIDGET;
164
165 $_->reconfigure
166 for @widgets;
167}
168
149# call when resolution changes etc. 169# call when resolution changes etc.
150sub rescale_widgets { 170sub rescale_widgets {
151 my ($sx, $sy) = @_; 171 my ($sx, $sy) = @_;
152 172
153 # make a copy, otherwise for complains about freed values.
154 my @widgets = values %WIDGET; 173 for my $widget (values %WIDGET) {
155
156 for my $widget (@widgets) {
157 if ($widget->{toplevel}) { 174 if ($widget->{is_toplevel}) {
175 $widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
176 $widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
177
158 $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x}; 178 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
159 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 179 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
160 $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w}; 180 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
161 $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
162 $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y}; 181 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
163 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 182 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
164 $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h}; 183 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
165 $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h}; 184
185 $widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
186 $widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
187
166 } 188 }
167
168 $widget->reconfigure;
169 } 189 }
190
191 reconfigure_widgets;
170} 192}
171 193
172############################################################################# 194#############################################################################
173 195
174package CFClient::UI::Base; 196package CFClient::UI::Base;
… …
179 201
180sub new { 202sub new {
181 my $class = shift; 203 my $class = shift;
182 204
183 my $self = bless { 205 my $self = bless {
184 x => 0, 206 x => "center",
185 y => 0, 207 y => "center",
186 z => 0, 208 z => 0,
209 w => undef,
210 h => undef,
187 can_events => 1, 211 can_events => 1,
188 @_ 212 @_
189 }, $class; 213 }, $class;
190 214
215 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
216
191 for (keys %$self) { 217 for (keys %$self) {
192 if (/^connect_(.*)$/) { 218 if (/^on_(.*)$/) {
193 $self->connect ($1 => delete $self->{$_}); 219 $self->connect ($1 => delete $self->{$_});
194 } 220 }
195 } 221 }
196 222
197 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 223 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
224 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
225 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
226 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
227 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
228
229 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
230 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
231
232 $self->show if $layout->{show};
233 }
198 234
199 $self 235 $self
200} 236}
201 237
202sub destroy { 238sub destroy {
… …
206 %$self = (); 242 %$self = ();
207} 243}
208 244
209sub show { 245sub show {
210 my ($self) = @_; 246 my ($self) = @_;
247
211 return if $self->{parent}; 248 return if $self->{parent};
212 249
213 $CFClient::UI::ROOT->add ($self); 250 $CFClient::UI::ROOT->add ($self);
214} 251}
215 252
216sub hide { 253sub set_visible {
217 my ($self) = @_; 254 my ($self) = @_;
255
256 return if $self->{visible};
257
258 $self->{root} = $self->{parent}{root};
259 $self->{visible} = $self->{parent}{visible} + 1;
260
261 $self->emit (visibility_change => 1);
262
263 $self->realloc if !exists $self->{req_w};
264
265 $_->set_visible for $self->children;
266}
267
268sub set_invisible {
269 my ($self) = @_;
270
271 return unless $self->{visible};
272
273 $_->set_invisible for $self->children;
274
275 delete $self->{root};
276 delete $self->{visible};
218 277
219 undef $GRAB if $GRAB == $self; 278 undef $GRAB if $GRAB == $self;
220 undef $HOVER if $HOVER == $self; 279 undef $HOVER if $HOVER == $self;
221 280
281 CFClient::UI::check_tooltip
282 if $TOOLTIP->{owner} == $self;
283
284 $self->focus_out;
285
286 $self->emit (visibility_change => 0);
287}
288
289sub set_visibility {
290 my ($self, $visible) = @_;
291
292 return if $self->{visible} == $visible;
293
294 $visible ? $self->hide
295 : $self->show;
296}
297
298sub toggle_visibility {
299 my ($self) = @_;
300
301 $self->{visible}
302 ? $self->hide
303 : $self->show;
304}
305
306sub hide {
307 my ($self) = @_;
308
309 $self->set_invisible;
310
222 $self->{parent}->remove ($self) 311 $self->{parent}->remove ($self)
223 if $self->{parent}; 312 if $self->{parent};
224} 313}
225 314
226sub move { 315sub move_abs {
227 my ($self, $x, $y, $z) = @_; 316 my ($self, $x, $y, $z) = @_;
228 317
229 $self->{x} = int $x; 318 $self->{x} = List::Util::max 0, int $x;
230 $self->{y} = int $y; 319 $self->{y} = List::Util::max 0, int $y;
231 $self->{z} = $z if defined $z; 320 $self->{z} = $z if defined $z;
232 321
233 $self->update; 322 $self->update;
234} 323}
235 324
236sub set_size { 325sub set_size {
237 my ($self, $w, $h) = @_; 326 my ($self, $w, $h) = @_;
238 327
239 $self->{user_w} = $w; 328 $self->{force_w} = $w;
240 $self->{user_h} = $h; 329 $self->{force_h} = $h;
241 330
242 $self->check_size; 331 $self->realloc;
243} 332}
244 333
245sub size_request { 334sub size_request {
246 require Carp; 335 require Carp;
247 Carp::confess "size_request is abstract"; 336 Carp::confess "size_request is abstract";
… …
249 338
250sub configure { 339sub configure {
251 my ($self, $x, $y, $w, $h) = @_; 340 my ($self, $x, $y, $w, $h) = @_;
252 341
253 if ($self->{aspect}) { 342 if ($self->{aspect}) {
343 my ($ow, $oh) = ($w, $h);
344
254 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 345 $w = List::Util::min $w, int $h * $self->{aspect};
255 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 346 $h = List::Util::min $h, int $w / $self->{aspect};
256 347
257 # use alignment to adjust x, y 348 # use alignment to adjust x, y
258 349
259 $x += int +($w - $w2) * 0.5; 350 $x += int 0.5 * ($ow - $w);
260 $y += int +($h - $h2) * 0.5; 351 $y += int 0.5 * ($oh - $h);
261
262 ($w, $h) = ($w2, $h2);
263 } 352 }
264 353
265 if ($self->{x} != $x || $self->{y} != $y) { 354 if ($self->{x} ne $x || $self->{y} ne $y) {
266 $self->{x} = $x; 355 $self->{x} = $x;
267 $self->{y} = $y; 356 $self->{y} = $y;
268 $self->update; 357 $self->update;
269 } 358 }
270 359
271 if ($self->{w} != $w || $self->{h} != $h) { 360 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
272 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h]; 361 return unless $self->{visible};
362
363 $self->{alloc_w} = $w;
364 $self->{alloc_h} = $h;
365
366 $self->{root}{size_alloc}{$self+0} = $self;
273 } 367 }
274} 368}
275 369
276sub size_allocate { 370sub size_allocate {
277 # nothing to be done 371 # nothing to be done
278} 372}
279 373
280sub reconfigure {
281 my ($self) = @_;
282
283 $self->check_size (1);
284 $self->update;
285}
286
287sub children { 374sub children {
288} 375}
289 376
290sub set_max_size { 377sub set_max_size {
291 my ($self, $w, $h) = @_; 378 my ($self, $w, $h) = @_;
… …
294 delete $self->{max_h}; $self->{max_h} = $h if $h; 381 delete $self->{max_h}; $self->{max_h} = $h if $h;
295} 382}
296 383
297sub set_tooltip { 384sub set_tooltip {
298 my ($self, $tooltip) = @_; 385 my ($self, $tooltip) = @_;
386
387 $tooltip =~ s/^\s+//;
388 $tooltip =~ s/\s+$//;
389
390 return if $self->{tooltip} eq $tooltip;
299 391
300 $self->{tooltip} = $tooltip; 392 $self->{tooltip} = $tooltip;
301 393
302 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 394 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
303 delete $CFClient::UI::TOOLTIP->{owner}; 395 delete $CFClient::UI::TOOLTIP->{owner};
… …
325 return if $FOCUS == $self; 417 return if $FOCUS == $self;
326 return unless $self->{can_focus}; 418 return unless $self->{can_focus};
327 419
328 my $focus = $FOCUS; $FOCUS = $self; 420 my $focus = $FOCUS; $FOCUS = $self;
329 421
330 $self->emit (focus_in => $focus); 422 $self->_emit (focus_in => $focus);
331 423
332 $focus->update if $focus; 424 $focus->update if $focus;
333 $FOCUS->update; 425 $FOCUS->update;
334} 426}
335 427
… …
338 430
339 return unless $FOCUS == $self; 431 return unless $FOCUS == $self;
340 432
341 my $focus = $FOCUS; undef $FOCUS; 433 my $focus = $FOCUS; undef $FOCUS;
342 434
343 $self->emit (focus_out => $focus); 435 $self->_emit (focus_out => $focus);
344 436
345 $focus->update if $focus; #? 437 $focus->update if $focus; #?
438
439 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
440 unless $FOCUS;
346} 441}
347 442
348sub mouse_motion { } 443sub mouse_motion { }
349sub button_up { } 444sub button_up { }
350sub key_down { } 445sub key_down { }
351sub key_up { } 446sub key_up { }
352 447
353sub button_down { 448sub button_down {
354 my ($self, $ev, $x, $y) = @_; 449 my ($self, $ev, $x, $y) = @_;
355 450
356 $self->focus_in; 451 $self->focus_in;
… …
359sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 454sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
360sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 455sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
361sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 456sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
362sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 457sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
363sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 458sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
459
460sub find_widget {
461 my ($self, $x, $y) = @_;
462
463 return () unless $self->{can_events};
464
465 return $self
466 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
467 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
468
469 ()
470}
471
472sub set_parent {
473 my ($self, $parent) = @_;
474
475 Scalar::Util::weaken ($self->{parent} = $parent);
476 $self->set_visible if $parent->{visible};
477}
478
479sub connect {
480 my ($self, $signal, $cb) = @_;
481
482 push @{ $self->{signal_cb}{$signal} }, $cb;
483}
484
485sub _emit {
486 my ($self, $signal, @args) = @_;
487
488 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
489}
490
491sub emit {
492 my ($self, $signal, @args) = @_;
493
494 $self->_emit ($signal, @args)
495 || $self->$signal (@args);
496}
497
498sub visibility_change {
499 #my ($self, $visible) = @_;
500}
501
502sub realloc {
503 my ($self) = @_;
504
505 if ($self->{visible}) {
506 return if $self->{root}{realloc}{$self+0};
507
508 $self->{root}{realloc}{$self+0} = $self;
509 $self->{root}->update;
510 } else {
511 delete $self->{req_w};
512 delete $self->{req_h};
513 }
514}
515
516sub update {
517 my ($self) = @_;
518
519 $self->{parent}->update
520 if $self->{parent};
521}
522
523sub reconfigure {
524 my ($self) = @_;
525
526 $self->realloc;
527 $self->update;
528}
364 529
365sub draw { 530sub draw {
366 my ($self) = @_; 531 my ($self) = @_;
367 532
368 return unless $self->{h} && $self->{w}; 533 return unless $self->{h} && $self->{w};
… …
385 glVertex $x , $y + $self->{h}; 550 glVertex $x , $y + $self->{h};
386 glEnd; 551 glEnd;
387 glDisable GL_BLEND; 552 glDisable GL_BLEND;
388 } 553 }
389 554
390 if ($ENV{PCLIENT_DEBUG}) { 555 if ($ENV{CFPLUS_DEBUG} & 1) {
391 glPushMatrix; 556 glPushMatrix;
392 glColor 1, 1, 0, 1; 557 glColor 1, 1, 0, 1;
393 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 558 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
394 glBegin GL_LINE_LOOP; 559 glBegin GL_LINE_LOOP;
395 glVertex 0 , 0; 560 glVertex 0 , 0;
396 glVertex $self->{w}, 0; 561 glVertex $self->{w} - 1, 0;
397 glVertex $self->{w}, $self->{h}; 562 glVertex $self->{w} - 1, $self->{h} - 1;
398 glVertex 0 , $self->{h}; 563 glVertex 0 , $self->{h} - 1;
399 glEnd; 564 glEnd;
400 glPopMatrix; 565 glPopMatrix;
401 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 566 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
402 } 567 }
403} 568}
404 569
405sub _draw { 570sub _draw {
406 my ($self) = @_; 571 my ($self) = @_;
407 572
408 warn "no draw defined for $self\n"; 573 warn "no draw defined for $self\n";
409}
410
411sub find_widget {
412 my ($self, $x, $y) = @_;
413
414 return () unless $self->{can_events};
415
416 return $self
417 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
418 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
419
420 ()
421}
422
423sub set_parent {
424 my ($self, $parent) = @_;
425
426 Scalar::Util::weaken ($self->{parent} = $parent);
427
428 # TODO: req_w _does_change after ->reconfigure
429 $self->check_size
430 unless exists $self->{req_w};
431
432 $self->show;
433}
434
435sub check_size {
436 my ($self, $forced) = @_;
437
438 $self->{force_alloc} = 1 if $forced;
439 $CFClient::UI::ROOT->{check_size}{$self} = $self;
440}
441
442sub update {
443 my ($self) = @_;
444
445 $self->{parent}->update
446 if $self->{parent};
447}
448
449sub connect {
450 my ($self, $signal, $cb) = @_;
451
452 push @{ $self->{signal_cb}{$signal} }, $cb;
453}
454
455sub emit {
456 my ($self, $signal, @args) = @_;
457
458 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
459} 574}
460 575
461sub DESTROY { 576sub DESTROY {
462 my ($self) = @_; 577 my ($self) = @_;
463 578
… …
521 my ($class, %arg) = @_; 636 my ($class, %arg) = @_;
522 $class->SUPER::new (can_events => 0, %arg); 637 $class->SUPER::new (can_events => 0, %arg);
523} 638}
524 639
525sub size_request { 640sub size_request {
526 (0, 0) 641 my ($self) = @_;
642
643 ($self->{w} + 0, $self->{h} + 0)
527} 644}
528 645
529sub draw { } 646sub draw { }
530 647
531############################################################################# 648#############################################################################
… …
560 $self->{children} = [ 677 $self->{children} = [
561 sort { $a->{z} <=> $b->{z} } 678 sort { $a->{z} <=> $b->{z} }
562 @{$self->{children}}, @widgets 679 @{$self->{children}}, @widgets
563 ]; 680 ];
564 681
565 $self->check_size (1); 682 $self->realloc;
566 $self->update;
567} 683}
568 684
569sub children { 685sub children {
570 @{ $_[0]{children} } 686 @{ $_[0]{children} }
571} 687}
… …
576 delete $child->{parent}; 692 delete $child->{parent};
577 $child->hide; 693 $child->hide;
578 694
579 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 695 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
580 696
581 $self->check_size; 697 $self->realloc;
582 $self->update;
583} 698}
584 699
585sub clear { 700sub clear {
586 my ($self) = @_; 701 my ($self) = @_;
587 702
… …
591 for (@$children) { 706 for (@$children) {
592 delete $_->{parent}; 707 delete $_->{parent};
593 $_->hide; 708 $_->hide;
594 } 709 }
595 710
596 $self->check_size; 711 $self->realloc;
597 $self->update;
598} 712}
599 713
600sub find_widget { 714sub find_widget {
601 my ($self, $x, $y) = @_; 715 my ($self, $x, $y) = @_;
602 716
… …
726 840
727package CFClient::UI::ViewPort; 841package CFClient::UI::ViewPort;
728 842
729our @ISA = CFClient::UI::Window::; 843our @ISA = CFClient::UI::Window::;
730 844
845sub new {
846 my $class = shift;
847
848 $class->SUPER::new (
849 scroll_x => 0,
850 scroll_y => 1,
851 @_,
852 )
853}
854
731sub size_request { 855sub size_request {
732 my ($self) = @_; 856 my ($self) = @_;
733 857
734 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 858 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
735 $self->child->configure (0, 0, @$self{qw(child_w child_h)});
736 859
737 @$self{qw(child_w child_h)} 860 $w = 10 if $self->{scroll_x};
861 $h = 10 if $self->{scroll_y};
862
863 ($w, $h)
738} 864}
739 865
740sub size_allocate { 866sub size_allocate {
741 my ($self, $w, $h) = @_; 867 my ($self, $w, $h) = @_;
742 868
869 my $child = $self->child;
870
871 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
872 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
873
874 $self->child->configure (0, 0, $w, $h);
743 $self->update; 875 $self->update;
744} 876}
745 877
746sub set_offset { 878sub set_offset {
747 my ($self, $x, $y) = @_; 879 my ($self, $x, $y) = @_;
… …
798 my $class = shift; 930 my $class = shift;
799 931
800 my $self; 932 my $self;
801 933
802 my $slider = new CFClient::UI::Slider 934 my $slider = new CFClient::UI::Slider
803 vertical => 1, 935 vertical => 1,
804 range => [0, 0, 1, 0.01], # HACK fix 936 range => [0, 0, 1, 0.01], # HACK fix
805 connect_changed => sub { 937 on_changed => sub {
806 $self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h})); 938 $self->{vp}->set_offset (0, $_[1]);
807 }, 939 },
808 ; 940 ;
809 941
810 $self = $class->SUPER::new ( 942 $self = $class->SUPER::new (
811 vp => (new CFClient::UI::ViewPort expand => 1), 943 vp => (new CFClient::UI::ViewPort expand => 1),
… …
816 $self->{vp}->add ($self->{scrolled}); 948 $self->{vp}->add ($self->{scrolled});
817 $self->add ($self->{vp}); 949 $self->add ($self->{vp});
818 $self->add ($self->{slider}); 950 $self->add ($self->{slider});
819 951
820 $self 952 $self
953}
954
955sub update {
956 my ($self) = @_;
957
958 $self->SUPER::update;
959
960 # todo: overwrite size_allocate of child
961 my $child = $self->{vp}->child;
962 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
963}
964
965sub size_allocate {
966 my ($self, $w, $h) = @_;
967
968 $self->SUPER::size_allocate ($w, $h);
969
970 my $child = $self->{vp}->child;
971 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
821} 972}
822 973
823#TODO# update range on size_allocate depending on child 974#TODO# update range on size_allocate depending on child
824# update viewport offset on scroll 975# update viewport offset on scroll
825 976
… …
869 1020
870our @ISA = CFClient::UI::Bin::; 1021our @ISA = CFClient::UI::Bin::;
871 1022
872use CFClient::OpenGL; 1023use CFClient::OpenGL;
873 1024
874my @tex = 1025my $bg =
1026 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1027 mipmap => 1, wrap => 1;
1028
1029my @border =
875 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1030 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
876 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1031 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
877 1032
878sub new { 1033sub new {
879 my $class = shift; 1034 my $class = shift;
880 1035
881 # TODO: user_x, user_y, overwrite moveto?
882
883 my $self = $class->SUPER::new ( 1036 my $self = $class->SUPER::new (
884 bg => [1, 1, 1, 1], 1037 bg => [1, 1, 1, 1],
885 border_bg => [1, 1, 1, 1], 1038 border_bg => [1, 1, 1, 1],
886 border => 0.6, 1039 border => 0.6,
887 toplevel => 1,
888 can_events => 1, 1040 can_events => 1,
1041 min_w => 16,
1042 min_h => 16,
889 @_ 1043 @_
890 ); 1044 );
891 1045
892 $self->{title} &&= new CFClient::UI::Label 1046 $self->{title} &&= new CFClient::UI::Label
893 align => 0, 1047 align => 0,
… …
946 my ($ev, $x, $y) = @_; 1100 my ($ev, $x, $y) = @_;
947 1101
948 my $dx = $ev->{x} - $ox; 1102 my $dx = $ev->{x} - $ox;
949 my $dy = $ev->{y} - $oy; 1103 my $dy = $ev->{y} - $oy;
950 1104
951 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1105 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
952 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1106 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1107
1108 $self->realloc;
953 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1109 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
954 $self->check_size;
955 }; 1110 };
956 1111
957 } elsif ($lr ^ $td) { 1112 } elsif ($lr ^ $td) {
958 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1113 my ($ox, $oy) = ($ev->{x}, $ev->{y});
959 my ($bx, $by) = ($self->{x}, $self->{y}); 1114 my ($bx, $by) = ($self->{x}, $self->{y});
… …
961 $self->{motion} = sub { 1116 $self->{motion} = sub {
962 my ($ev, $x, $y) = @_; 1117 my ($ev, $x, $y) = @_;
963 1118
964 ($x, $y) = ($ev->{x}, $ev->{y}); 1119 ($x, $y) = ($ev->{x}, $ev->{y});
965 1120
966 $self->move ($bx + $x - $ox, $by + $y - $oy); 1121 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
967 $self->update;
968 }; 1122 };
969 } 1123 }
970} 1124}
971 1125
972sub button_up { 1126sub button_up {
… …
991 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1145 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
992 1146
993 my $border = $self->border; 1147 my $border = $self->border;
994 1148
995 glColor @{ $self->{border_bg} }; 1149 glColor @{ $self->{border_bg} };
996 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1150 $border[0]->draw_quad_alpha (0, 0, $w, $border);
997 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1151 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
998 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1152 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
999 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1153 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1000 1154
1001 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1155 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1002 my $bg = $tex[0]; 1156 glColor @{ $self->{bg} };
1003 1157
1004 # TODO: repeat texture not scale 1158 # TODO: repeat texture not scale
1159 # solve this better(?)
1005 my $rep_x = $cw / $bg->{w}; 1160 $bg->{s} = $cw / $bg->{w};
1006 my $rep_y = $ch / $bg->{h}; 1161 $bg->{t} = $ch / $bg->{h};
1007
1008 glColor @{ $self->{bg} };
1009
1010 $bg->{s} = $rep_x;
1011 $bg->{t} = $rep_y;
1012 $bg->{wrap_mode} = 1;
1013 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1162 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1014 } 1163 }
1015 1164
1016 glDisable GL_TEXTURE_2D; 1165 glDisable GL_TEXTURE_2D;
1017 1166
… …
1033sub new { 1182sub new {
1034 my $class = shift; 1183 my $class = shift;
1035 1184
1036 $class->SUPER::new ( 1185 $class->SUPER::new (
1037 col_expand => [], 1186 col_expand => [],
1038 @_ 1187 @_,
1039 ) 1188 )
1189}
1190
1191sub children {
1192 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1040} 1193}
1041 1194
1042sub add { 1195sub add {
1043 my ($self, $x, $y, $child) = @_; 1196 my ($self, $x, $y, $child) = @_;
1044 1197
1045 $child->set_parent ($self); 1198 $child->set_parent ($self);
1046 $self->{children}[$y][$x] = $child; 1199 $self->{children}[$y][$x] = $child;
1047 1200
1048 $child->check_size; 1201 $self->realloc;
1049} 1202}
1050 1203
1051sub children {
1052 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1053}
1054
1055# TODO: move to container class maybe? send childs a signal on removal? 1204# TODO: move to container class maybe? send children a signal on removal?
1056sub clear { 1205sub clear {
1057 my ($self) = @_; 1206 my ($self) = @_;
1058 1207
1059 my @children = $self->children; 1208 my @children = $self->children;
1060 delete $self->{children}; 1209 delete $self->{children};
… …
1062 for (@children) { 1211 for (@children) {
1063 delete $_->{parent}; 1212 delete $_->{parent};
1064 $_->hide; 1213 $_->hide;
1065 } 1214 }
1066 1215
1067 $self->update; 1216 $self->realloc;
1068} 1217}
1069 1218
1070sub get_wh { 1219sub get_wh {
1071 my ($self) = @_; 1220 my ($self) = @_;
1072 1221
… …
1103sub size_allocate { 1252sub size_allocate {
1104 my ($self, $w, $h) = @_; 1253 my ($self, $w, $h) = @_;
1105 1254
1106 my ($ws, $hs) = $self->get_wh; 1255 my ($ws, $hs) = $self->get_wh;
1107 1256
1108 my $req_w = sum @$ws; 1257 my $req_w = (sum @$ws) || 1;
1109 my $req_h = sum @$hs; 1258 my $req_h = (sum @$hs) || 1;
1110 1259
1111 # TODO: nicer code && do row_expand 1260 # TODO: nicer code && do row_expand
1112 my @col_expand = @{$self->{col_expand}}; 1261 my @col_expand = @{$self->{col_expand}};
1113 @col_expand = (1) x @$ws unless @col_expand; 1262 @col_expand = (1) x @$ws unless @col_expand;
1114 my $col_expand = (sum @col_expand) || 1; 1263 my $col_expand = (sum @col_expand) || 1;
… …
1168 } 1317 }
1169} 1318}
1170 1319
1171############################################################################# 1320#############################################################################
1172 1321
1173package CFClient::UI::HBox; 1322package CFClient::UI::Box;
1174
1175# TODO: wrap into common Box base class
1176 1323
1177our @ISA = CFClient::UI::Container::; 1324our @ISA = CFClient::UI::Container::;
1178 1325
1179sub size_request { 1326sub size_request {
1180 my ($self) = @_; 1327 my ($self) = @_;
1181 1328
1182 my @alloc = map [$_->size_request], @{$self->{children}}; 1329 $self->{vertical}
1183 1330 ? (
1184 ( 1331 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1185 (List::Util::sum map $_->[0], @alloc), 1332 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1186 (List::Util::max map $_->[1], @alloc), 1333 )
1187 ) 1334 : (
1335 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1336 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1337 )
1188} 1338}
1189 1339
1190sub size_allocate { 1340sub size_allocate {
1191 my ($self, $w, $h) = @_; 1341 my ($self, $w, $h) = @_;
1192 1342
1193 ($h, $w) = ($w, $h); 1343 my $space = $self->{vertical} ? $h : $w;
1194
1195 my $children = $self->{children}; 1344 my $children = $self->{children};
1196 1345
1197 my @h = map $_->{req_w}, @$children; 1346 my @req;
1198 1347
1199 my $req_h = List::Util::sum @h; 1348 if ($self->{homogeneous}) {
1200 1349 @req = ($space / (@$children || 1)) x @$children;
1201 if ($req_h > $h) {
1202 # ah well, not enough space
1203 $_ *= $h / $req_h for @h;
1204 } else { 1350 } else {
1351 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1352 my $req = List::Util::sum @req;
1353
1354 if ($req > $space) {
1355 # ah well, not enough space
1356 $_ *= $space / $req for @req;
1357 } else {
1205 my $exp = List::Util::sum map $_->{expand}, @$children; 1358 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1206 $exp ||= 1;
1207 1359
1360 $space = ($space - $req) / $expand; # remaining space to give away
1361
1362 $req[$_] += $space * $children->[$_]{expand}
1208 for (0 .. $#$children) { 1363 for 0 .. $#$children;
1209 my $child = $children->[$_];
1210
1211 my $alloc_h = $h[$_];
1212 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1213 $h[$_] = $alloc_h;
1214 } 1364 }
1215 } 1365 }
1216 1366
1217 CFClient::UI::harmonize \@h; 1367 CFClient::UI::harmonize \@req;
1218 1368
1219 my $y = 0; 1369 my $pos = 0;
1220 for (0 .. $#$children) { 1370 for (0 .. $#$children) {
1221 my $child = $children->[$_];
1222 my $h = $h[$_]; 1371 my $alloc = $req[$_];
1223 $child->configure ($y, 0, $h, $w); 1372 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1224 1373
1225 $y += $h; 1374 $pos += $alloc;
1226 } 1375 }
1227 1376
1228 1 1377 1
1229} 1378}
1230 1379
1231############################################################################# 1380#############################################################################
1232 1381
1382package CFClient::UI::HBox;
1383
1384our @ISA = CFClient::UI::Box::;
1385
1386sub new {
1387 my $class = shift;
1388
1389 $class->SUPER::new (
1390 vertical => 0,
1391 @_,
1392 )
1393}
1394
1395#############################################################################
1396
1233package CFClient::UI::VBox; 1397package CFClient::UI::VBox;
1234 1398
1235# TODO: wrap into common Box base class
1236
1237our @ISA = CFClient::UI::Container::; 1399our @ISA = CFClient::UI::Box::;
1238 1400
1239sub size_request { 1401sub new {
1240 my ($self) = @_; 1402 my $class = shift;
1241 1403
1242 my @alloc = map [$_->size_request], @{$self->{children}}; 1404 $class->SUPER::new (
1243 1405 vertical => 1,
1244 ( 1406 @_,
1245 (List::Util::max map $_->[0], @alloc),
1246 (List::Util::sum map $_->[1], @alloc),
1247 ) 1407 )
1248}
1249
1250sub size_allocate {
1251 my ($self, $w, $h) = @_;
1252
1253 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1254
1255 my $children = $self->{children};
1256
1257 my @h = map $_->{req_h}, @$children;
1258
1259 my $req_h = List::Util::sum @h;
1260
1261 if ($req_h > $h) {
1262 # ah well, not enough space
1263 $_ *= $h / $req_h for @h;
1264 } else {
1265 my $exp = List::Util::sum map $_->{expand}, @$children;
1266 $exp ||= 1;
1267
1268 for (0 .. $#$children) {
1269 my $child = $children->[$_];
1270
1271 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1272 }
1273 }
1274
1275 CFClient::UI::harmonize \@h;
1276
1277 my $y = 0;
1278 for (0 .. $#$children) {
1279 my $child = $children->[$_];
1280 my $h = $h[$_];
1281 $child->configure (0, $y, $w, $h);
1282
1283 $y += $h;
1284 }
1285
1286 1
1287} 1408}
1288 1409
1289############################################################################# 1410#############################################################################
1290 1411
1291package CFClient::UI::Label; 1412package CFClient::UI::Label;
… …
1308 ellipsise => 3, # end 1429 ellipsise => 3, # end
1309 layout => (new CFClient::Layout), 1430 layout => (new CFClient::Layout),
1310 fontsize => 1, 1431 fontsize => 1,
1311 align => -1, 1432 align => -1,
1312 valign => -1, 1433 valign => -1,
1313 padding => 2, 1434 padding_x => 2,
1435 padding_y => 2,
1314 can_events => 0, 1436 can_events => 0,
1315 %arg 1437 %arg
1316 ); 1438 );
1317 1439
1318 if (exists $self->{template}) { 1440 if (exists $self->{template}) {
… …
1354 $self->{text} = "T$text"; 1476 $self->{text} = "T$text";
1355 1477
1356 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1478 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1357 $self->{layout}->set_text ($text); 1479 $self->{layout}->set_text ($text);
1358 1480
1481 $self->realloc;
1359 $self->update; 1482 $self->update;
1360 $self->check_size;
1361} 1483}
1362 1484
1363sub set_markup { 1485sub set_markup {
1364 my ($self, $markup) = @_; 1486 my ($self, $markup) = @_;
1365 1487
… …
1369 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1491 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1370 1492
1371 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1493 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1372 $self->{layout}->set_markup ($markup); 1494 $self->{layout}->set_markup ($markup);
1373 1495
1496 $self->realloc;
1374 $self->update; 1497 $self->update;
1375 $self->check_size;
1376} 1498}
1377 1499
1378sub size_request { 1500sub size_request {
1379 my ($self) = @_; 1501 my ($self) = @_;
1380 1502
… …
1394 1516
1395 $w = List::Util::max $w, $w2; 1517 $w = List::Util::max $w, $w2;
1396 $h = List::Util::max $h, $h2; 1518 $h = List::Util::max $h, $h2;
1397 } 1519 }
1398 1520
1399 ( 1521 ($w, $h)
1400 $w + $self->{padding} * 2,
1401 $h + $self->{padding} * 2,
1402 )
1403} 1522}
1404 1523
1405sub size_allocate { 1524sub size_allocate {
1406 my ($self, $w, $h) = @_; 1525 my ($self, $w, $h) = @_;
1407 1526
… …
1412 my ($self, $fontsize) = @_; 1531 my ($self, $fontsize) = @_;
1413 1532
1414 $self->{fontsize} = $fontsize; 1533 $self->{fontsize} = $fontsize;
1415 delete $self->{texture}; 1534 delete $self->{texture};
1416 1535
1417 $self->update; 1536 $self->realloc;
1418 $self->check_size;
1419} 1537}
1420 1538
1421sub _draw { 1539sub _draw {
1422 my ($self) = @_; 1540 my ($self) = @_;
1423 1541
… …
1431 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1549 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1432 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1550 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1433 1551
1434 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1552 my $tex = new_from_layout CFClient::Texture $self->{layout};
1435 1553
1436 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1554 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1437 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1555 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1438 : ($self->{w} - $tex->{w}) * 0.5); 1556 : ($self->{w} - $tex->{w}) * 0.5);
1439 1557
1440 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1558 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1441 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1559 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1442 : ($self->{h} - $tex->{h}) * 0.5); 1560 : ($self->{h} - $tex->{h}) * 0.5);
1443 1561
1444 $tex 1562 $tex
1445 }; 1563 };
1446 1564
… …
1475 active_fg => [0, 0, 0], 1593 active_fg => [0, 0, 0],
1476 can_hover => 1, 1594 can_hover => 1,
1477 can_focus => 1, 1595 can_focus => 1,
1478 valign => 0, 1596 valign => 0,
1479 can_events => 1, 1597 can_events => 1,
1598 #text => ...
1480 @_ 1599 @_
1481 ) 1600 )
1482} 1601}
1483 1602
1484sub _set_text { 1603sub _set_text {
… …
1494 $self->{text} = $text; 1613 $self->{text} = $text;
1495 1614
1496 $text =~ s/./*/g if $self->{hidden}; 1615 $text =~ s/./*/g if $self->{hidden};
1497 $self->{layout}->set_text ("$text "); 1616 $self->{layout}->set_text ("$text ");
1498 1617
1499 $self->emit (changed => $self->{text}); 1618 $self->_emit (changed => $self->{text});
1500} 1619}
1501 1620
1502sub set_text { 1621sub set_text {
1503 my ($self, $text) = @_; 1622 my ($self, $text) = @_;
1504 1623
1505 $self->{cursor} = length $text; 1624 $self->{cursor} = length $text;
1506 $self->_set_text ($text); 1625 $self->_set_text ($text);
1507 $self->update; 1626
1508 $self->check_size; 1627 $self->realloc;
1509} 1628}
1510 1629
1511sub get_text { 1630sub get_text {
1512 $_[0]{text} 1631 $_[0]{text}
1513} 1632}
… …
1516 my ($self) = @_; 1635 my ($self) = @_;
1517 1636
1518 my ($w, $h) = $self->SUPER::size_request; 1637 my ($w, $h) = $self->SUPER::size_request;
1519 1638
1520 ($w + 1, $h) # add 1 for cursor 1639 ($w + 1, $h) # add 1 for cursor
1521}
1522
1523sub size_allocate {
1524 my ($self, $w, $h) = @_;
1525
1526 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1527} 1640}
1528 1641
1529sub key_down { 1642sub key_down {
1530 my ($self, $ev) = @_; 1643 my ($self, $ev) = @_;
1531 1644
… …
1546 } elsif ($sym == CFClient::SDLK_HOME) { 1659 } elsif ($sym == CFClient::SDLK_HOME) {
1547 $self->{cursor} = 0; 1660 $self->{cursor} = 0;
1548 } elsif ($sym == CFClient::SDLK_END) { 1661 } elsif ($sym == CFClient::SDLK_END) {
1549 $self->{cursor} = length $text; 1662 $self->{cursor} = length $text;
1550 } elsif ($uni == 27) { 1663 } elsif ($uni == 27) {
1551 $self->emit ('escape'); 1664 $self->_emit ('escape');
1552 } elsif ($uni) { 1665 } elsif ($uni) {
1553 substr $text, $self->{cursor}++, 0, chr $uni; 1666 substr $text, $self->{cursor}++, 0, chr $uni;
1554 } 1667 }
1555 1668
1556 $self->_set_text ($text); 1669 $self->_set_text ($text);
1557 $self->update; 1670
1558 $self->check_size; 1671 $self->realloc;
1559} 1672}
1560 1673
1561sub focus_in { 1674sub focus_in {
1562 my ($self) = @_; 1675 my ($self) = @_;
1563 1676
… …
1643 if ($sym == 13) { 1756 if ($sym == 13) {
1644 unshift @{$self->{history}}, 1757 unshift @{$self->{history}},
1645 my $txt = $self->get_text; 1758 my $txt = $self->get_text;
1646 $self->{history_pointer} = -1; 1759 $self->{history_pointer} = -1;
1647 $self->{history_saveback} = ''; 1760 $self->{history_saveback} = '';
1648 $self->emit (activate => $txt); 1761 $self->_emit (activate => $txt);
1649 $self->update; 1762 $self->update;
1650 1763
1651 } elsif ($sym == CFClient::SDLK_UP) { 1764 } elsif ($sym == CFClient::SDLK_UP) {
1652 if ($self->{history_pointer} < 0) { 1765 if ($self->{history_pointer} < 0) {
1653 $self->{history_saveback} = $self->get_text; 1766 $self->{history_saveback} = $self->get_text;
… …
1690 1803
1691sub new { 1804sub new {
1692 my $class = shift; 1805 my $class = shift;
1693 1806
1694 $class->SUPER::new ( 1807 $class->SUPER::new (
1695 padding => 4, 1808 padding_x => 4,
1809 padding_y => 4,
1696 fg => [1, 1, 1], 1810 fg => [1, 1, 1],
1697 active_fg => [0, 0, 1], 1811 active_fg => [0, 0, 1],
1698 can_hover => 1, 1812 can_hover => 1,
1699 align => 0, 1813 align => 0,
1700 valign => 0, 1814 valign => 0,
1701 can_events => 1, 1815 can_events => 1,
1702 @_ 1816 @_
1703 ) 1817 )
1704} 1818}
1705 1819
1820sub activate { }
1821
1706sub button_up { 1822sub button_up {
1707 my ($self, $ev, $x, $y) = @_; 1823 my ($self, $ev, $x, $y) = @_;
1708 1824
1825 $self->emit ("activate")
1709 if ($x >= 0 && $x < $self->{w} 1826 if $x >= 0 && $x < $self->{w}
1710 && $y >= 0 && $y < $self->{h}) { 1827 && $y >= 0 && $y < $self->{h};
1711 $self->emit ("activate");
1712 }
1713} 1828}
1714 1829
1715sub _draw { 1830sub _draw {
1716 my ($self) = @_; 1831 my ($self) = @_;
1717 1832
… …
1746 1861
1747sub new { 1862sub new {
1748 my $class = shift; 1863 my $class = shift;
1749 1864
1750 $class->SUPER::new ( 1865 $class->SUPER::new (
1751 padding => 2, 1866 padding_x => 2,
1867 padding_y => 2,
1752 fg => [1, 1, 1], 1868 fg => [1, 1, 1],
1753 active_fg => [1, 1, 0], 1869 active_fg => [1, 1, 0],
1754 bg => [0, 0, 0, 0.2], 1870 bg => [0, 0, 0, 0.2],
1755 active_bg => [1, 1, 1, 0.5], 1871 active_bg => [1, 1, 1, 0.5],
1756 state => 0, 1872 state => 0,
… …
1760} 1876}
1761 1877
1762sub size_request { 1878sub size_request {
1763 my ($self) = @_; 1879 my ($self) = @_;
1764 1880
1765 ($self->{padding} * 2 + 6) x 2 1881 (6) x 2
1766} 1882}
1767 1883
1768sub button_down { 1884sub button_down {
1769 my ($self, $ev, $x, $y) = @_; 1885 my ($self, $ev, $x, $y) = @_;
1770 1886
1771 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1887 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1772 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1888 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1773 $self->{state} = !$self->{state}; 1889 $self->{state} = !$self->{state};
1774 $self->emit (changed => $self->{state}); 1890 $self->_emit (changed => $self->{state});
1775 } 1891 }
1776} 1892}
1777 1893
1778sub _draw { 1894sub _draw {
1779 my ($self) = @_; 1895 my ($self) = @_;
1780 1896
1781 $self->SUPER::_draw; 1897 $self->SUPER::_draw;
1782 1898
1783 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1899 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1784 1900
1785 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1901 my ($w, $h) = @$self{qw(w h)};
1902
1903 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1786 1904
1787 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1905 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1788 1906
1789 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1907 my $tex = $self->{state} ? $tex[1] : $tex[0];
1790 1908
… …
2054 my $self = $class->SUPER::new ( 2172 my $self = $class->SUPER::new (
2055 fg => [1, 1, 1], 2173 fg => [1, 1, 1],
2056 active_fg => [0, 0, 0], 2174 active_fg => [0, 0, 0],
2057 bg => [0, 0, 0, 0.2], 2175 bg => [0, 0, 0, 0.2],
2058 active_bg => [1, 1, 1, 0.5], 2176 active_bg => [1, 1, 1, 0.5],
2059 range => [0, 0, 100, 10], 2177 range => [0, 0, 100, 10, 0],
2060 req_w => $::WIDTH / 80, 2178 min_w => $::WIDTH / 80,
2061 req_h => $::WIDTH / 80, 2179 min_h => $::WIDTH / 80,
2062 vertical => 0, 2180 vertical => 0,
2063 can_hover => 1, 2181 can_hover => 1,
2064 inner_pad => 0.02, 2182 inner_pad => 0.02,
2065 @_ 2183 @_
2066 ); 2184 );
… …
2069 $self->update; 2187 $self->update;
2070 2188
2071 $self 2189 $self
2072} 2190}
2073 2191
2192sub changed { }
2193
2194sub set_range {
2195 my ($self, $range) = @_;
2196
2197 ($range, $self->{range}) = ($self->{range}, $range);
2198
2199 $self->update
2200 if "@$range" ne "@{$self->{range}}";
2201}
2202
2074sub set_value { 2203sub set_value {
2075 my ($self, $value) = @_; 2204 my ($self, $value) = @_;
2076 2205
2077 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; 2206 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2078 2207
2079 $hi = $lo + 1 if $hi <= $lo; 2208 $hi = $lo + 1 if $hi <= $lo;
2080 2209
2210 $page = $hi - $lo if $page > $hi - $lo;
2211
2081 $value = $lo if $value < $lo; 2212 $value = $lo if $value < $lo;
2082 $value = $hi if $value > $hi; 2213 $value = $hi - $page if $value > $hi - $page;
2083 2214
2084 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit 2215 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2085 if $unit; 2216 if $unit;
2086 2217
2087 $page = $hi - $lo if $page > $hi - $lo;
2088
2089 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2218 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2090 2219
2091 if ($value != $old_value) { 2220 if ($value != $old_value) {
2092 $self->emit (changed => $value); 2221 $self->_emit (changed => $value);
2093 $self->update; 2222 $self->update;
2094 } 2223 }
2095} 2224}
2096 2225
2097sub size_request { 2226sub size_request {
2098 my ($self) = @_; 2227 my ($self) = @_;
2099 2228
2100 my $w = $self->{req_w}; 2229 ($self->{req_w}, $self->{req_h})
2101 my $h = $self->{req_h};
2102
2103 $self->{vertical} ? ($h, $w) : ($w, $h)
2104} 2230}
2105 2231
2106sub button_down { 2232sub button_down {
2107 my ($self, $ev, $x, $y) = @_; 2233 my ($self, $ev, $x, $y) = @_;
2108 2234
2109 $self->SUPER::button_down ($ev, $x, $y); 2235 $self->SUPER::button_down ($ev, $x, $y);
2236
2237 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2238
2110 $self->mouse_motion ($ev, $x, $y); 2239 $self->mouse_motion ($ev, $x, $y);
2111} 2240}
2112 2241
2113sub mouse_motion { 2242sub mouse_motion {
2114 my ($self, $ev, $x, $y) = @_; 2243 my ($self, $ev, $x, $y) = @_;
… …
2116 if ($GRAB == $self) { 2245 if ($GRAB == $self) {
2117 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2246 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2118 2247
2119 my (undef, $lo, $hi, $page) = @{$self->{range}}; 2248 my (undef, $lo, $hi, $page) = @{$self->{range}};
2120 2249
2121 $x = $x / ($w * (1 - 2 * $self->{inner_pad})) - $self->{inner_pad}; 2250 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2122 2251
2123 $self->set_value ($x * ($hi - $lo) + $lo); 2252 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2124 } 2253 }
2125} 2254}
2126 2255
2127sub update { 2256sub update {
2128 my ($self) = @_; 2257 my ($self) = @_;
2129 2258
2130 $CFClient::UI::ROOT->on_post_alloc ($self => sub { 2259 $CFClient::UI::ROOT->on_post_alloc ($self => sub {
2131 $self->set_value ($self->{range}[0]); 2260 $self->set_value ($self->{range}[0]);
2132 2261
2133 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2262 my ($value, $lo, $hi, $page) = @{$self->{range}};
2263 my $range = ($hi - $page - $lo) || 1e-100;
2134 2264
2135 my $inner_w = 1 - 2 * $self->{inner_pad}; 2265 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2136 2266
2137 $self->{scale} = ($inner_w / ($hi - $lo)) || 1; 2267 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2268 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2138 2269
2139 $page = $self->{scale} * $page || 10 / ($self->{w} || 1); 2270 $value = ($value - $lo) / $range;
2140 $value = $self->{scale} * ($value - $lo); 2271 $value = $value * $self->{scale} + $self->{offset};
2141 2272
2142 $value = $self->{inner_pad} + ($value - $page * 0.5);
2143
2144 $value = 0 if $value < 0;
2145 $page = 1 - $value if $value + $page > 1;
2146
2147 $self->{knob_x} = $value; 2273 $self->{knob_x} = $value - $knob_w * 0.5;
2148 $self->{knob_w} = $page; 2274 $self->{knob_w} = $knob_w;
2149 }); 2275 });
2150 2276
2151 $self->SUPER::update; 2277 $self->SUPER::update;
2152} 2278}
2153 2279
… …
2177 # draw handle 2303 # draw handle
2178 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1); 2304 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2179 2305
2180 glDisable GL_TEXTURE_2D; 2306 glDisable GL_TEXTURE_2D;
2181} 2307}
2308
2309#############################################################################
2310
2311package CFClient::UI::ValSlider;
2312
2313our @ISA = CFClient::UI::HBox::;
2314
2315sub new {
2316 my ($class, %arg) = @_;
2317
2318 my $range = delete $arg{range};
2319
2320 my $self = $class->SUPER::new (
2321 slider => (new CFClient::UI::Slider expand => 1, range => $range),
2322 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
2323 to_value => sub { shift },
2324 from_value => sub { shift },
2325 %arg,
2326 );
2327
2328 $self->{slider}->connect (changed => sub {
2329 my ($self, $value) = @_;
2330 $self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
2331 $self->{parent}->emit (changed => $value);
2332 });
2333
2334# $self->{entry}->connect (changed => sub {
2335# my ($self, $value) = @_;
2336# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
2337# $self->{parent}->emit (changed => $value);
2338# });
2339
2340 $self->add ($self->{slider}, $self->{entry});
2341
2342 $self->{slider}->emit (changed => $self->{slider}{range}[0]);
2343
2344 $self
2345}
2346
2347sub set_range { shift->{slider}->set_range (@_) }
2348sub set_value { shift->{slider}->set_value (@_) }
2182 2349
2183############################################################################# 2350#############################################################################
2184 2351
2185package CFClient::UI::TextView; 2352package CFClient::UI::TextView;
2186 2353
… …
2228 $self->{layout}->set_width ($self->{children}[0]{w}); 2395 $self->{layout}->set_width ($self->{children}[0]{w});
2229 2396
2230 $self->reflow; 2397 $self->reflow;
2231} 2398}
2232 2399
2233sub text_height { 2400sub text_size {
2234 my ($self, $text, $indent) = @_; 2401 my ($self, $text, $indent) = @_;
2235 2402
2236 my $layout = $self->{layout}; 2403 my $layout = $self->{layout};
2237 2404
2238 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2405 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2239 $layout->set_width ($self->{children}[0]{w} - $indent); 2406 $layout->set_width ($self->{children}[0]{w} - $indent);
2240 $layout->set_markup ($text); 2407 $layout->set_markup ($text);
2241 2408
2242 ($layout->size)[1] 2409 $layout->size
2243} 2410}
2244 2411
2245sub reflow { 2412sub reflow {
2246 my ($self) = @_; 2413 my ($self) = @_;
2247 2414
2248 $self->{need_reflow}++; 2415 $self->{need_reflow}++;
2249 $self->update; 2416 $self->update;
2250} 2417}
2251 2418
2419sub set_offset {
2420 my ($self, $offset) = @_;
2421
2422 # todo: base offset on lines or so, not on pixels
2423 $self->{children}[1]->set_value ($offset);
2424}
2425
2426sub clear {
2427 my ($self) = @_;
2428
2429 $self->{par} = [];
2430 $self->{height} = 0;
2431 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2432}
2433
2252sub add_paragraph { 2434sub add_paragraph {
2253 my ($self, $color, $text, $indent) = @_; 2435 my ($self, $color, $text, $indent) = @_;
2254 2436
2255 #TODO: intelligently "reformat" paragraph
2256
2257 for my $line (split /\n/, $text) { 2437 for my $line (split /\n/, $text) {
2258 my $height = $self->text_height ($line); 2438 my ($w, $h) = $self->text_size ($line);
2259 $self->{height} += $height; 2439 $self->{height} += $h;
2260 push @{$self->{par}}, [$height, $color, $indent, $line]; 2440 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2261 } 2441 }
2262 2442
2263 $self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}]; 2443 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2264 $self->{children}[1]->update;
2265} 2444}
2266 2445
2267sub update { 2446sub update {
2268 my ($self) = @_; 2447 my ($self) = @_;
2269 2448
… …
2272 return unless $self->{h} > 0; 2451 return unless $self->{h} > 0;
2273 2452
2274 delete $self->{texture}; 2453 delete $self->{texture};
2275 2454
2276 $ROOT->on_post_alloc ($self, sub { 2455 $ROOT->on_post_alloc ($self, sub {
2456 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2457
2277 if (delete $self->{need_reflow}) { 2458 if (delete $self->{need_reflow}) {
2278 my $height = 0; 2459 my $height = 0;
2279 2460
2280 $height += $_->[0] = $self->text_height ($_->[3], $_->[2]) 2461 my $layout = $self->{layout};
2462
2463 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2464
2281 for @{$self->{par}}; 2465 for (@{$self->{par}}) {
2466 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2467 $layout->set_width ($W - $_->[3]);
2468 $layout->set_markup ($_->[4]);
2469 my ($w, $h) = $layout->size;
2470 $_->[0] = $w + $_->[3];
2471 $_->[1] = $h;
2472 }
2473
2474 $height += $_->[1];
2475 }
2282 2476
2283 $self->{height} = $height; 2477 $self->{height} = $height;
2284 2478
2285 $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}]; 2479 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2286 $self->{children}[1]->update;
2287 2480
2288 delete $self->{texture}; 2481 delete $self->{texture};
2289 } 2482 }
2290 2483
2291 $self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub { 2484 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2292 glClearColor 0.5, 0.5, 0.5, 0; 2485 glClearColor 0.5, 0.5, 0.5, 0;
2293 glClear GL_COLOR_BUFFER_BIT; 2486 glClear GL_COLOR_BUFFER_BIT;
2294 2487
2295 my $top = int $self->{children}[1]{range}[0]; 2488 my $top = int $self->{children}[1]{range}[0];
2296 2489
2297 my $y0 = $top; 2490 my $y0 = $top;
2298 my $y1 = $top + $self->{h}; 2491 my $y1 = $top + $H;
2299 2492
2300 my $y = 0; 2493 my $y = 0;
2301 2494
2302 my $layout = $self->{layout}; 2495 my $layout = $self->{layout};
2303 2496
2304 $layout->set_font ($self->{font}) if $self->{font}; 2497 $layout->set_font ($self->{font}) if $self->{font};
2305 2498
2306 glEnable GL_BLEND; 2499 glEnable GL_BLEND;
2500 #TODO# not correct in windows where rgba is forced off
2307 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2501 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2308 2502
2309 for my $par (@{$self->{par}}) { 2503 for my $par (@{$self->{par}}) {
2310 my $h = $par->[0]; 2504 my $h = $par->[1];
2311 2505
2312 if ($y0 < $y + $h && $y < $y1) { 2506 if ($y0 < $y + $h && $y < $y1) {
2313 $layout->set_foreground (@{ $par->[1] }); 2507 $layout->set_foreground (@{ $par->[2] });
2314 $layout->set_width ($self->{w} - $par->[2]); 2508 $layout->set_width ($W - $par->[3]);
2315 $layout->set_markup ($par->[3]); 2509 $layout->set_markup ($par->[4]);
2316 2510
2317 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2511 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2318 2512
2319 glRasterPos $par->[2], $y - $y0; 2513 glRasterPos $par->[3], $y - $y0;
2320 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2514 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2321 } 2515 }
2322 2516
2323 $y += $h; 2517 $y += $h;
2324 } 2518 }
… …
2391 2585
2392sub new { 2586sub new {
2393 my $class = shift; 2587 my $class = shift;
2394 2588
2395 my $self = $class->SUPER::new ( 2589 my $self = $class->SUPER::new (
2396 state => 0, 2590 state => 0,
2397 connect_activate => \&toggle_flopper, 2591 on_activate => \&toggle_flopper,
2398 @_ 2592 @_
2399 ); 2593 );
2400 2594
2401 if ($self->{state}) {
2402 $self->{state} = 0;
2403 $self->toggle_flopper;
2404 }
2405
2406 $self 2595 $self
2407} 2596}
2408 2597
2409sub toggle_flopper { 2598sub toggle_flopper {
2410 my ($self) = @_; 2599 my ($self) = @_;
2411 2600
2412 # TODO: use animation 2601 $self->{other}->toggle_visibility;
2413 if ($self->{state} = !$self->{state}) {
2414 $CFClient::UI::ROOT->add ($self->{other});
2415 $self->{other}->move ($self->coord2global (0, $self->{h}));
2416 $self->emit ("open");
2417 } else {
2418 $CFClient::UI::ROOT->remove ($self->{other});
2419 $self->emit ("close");
2420 }
2421
2422 $self->emit (changed => $self->{state});
2423} 2602}
2424 2603
2425############################################################################# 2604#############################################################################
2426 2605
2427package CFClient::UI::Tooltip; 2606package CFClient::UI::Tooltip;
… …
2440} 2619}
2441 2620
2442sub set_tooltip_from { 2621sub set_tooltip_from {
2443 my ($self, $widget) = @_; 2622 my ($self, $widget) = @_;
2444 2623
2624 my $tooltip = $widget->{tooltip};
2625
2626 if ($ENV{CFPLUS_DEBUG} & 2) {
2627 $tooltip .= "\n\n" . (ref $widget) . "\n"
2628 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2629 . "req $widget->{req_w} $widget->{req_h}\n"
2630 . "visible $widget->{visible}";
2631 }
2632
2445 $self->add (new CFClient::UI::Label 2633 $self->add (new CFClient::UI::Label
2446 markup => $widget->{tooltip}, 2634 markup => $tooltip,
2447 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2635 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2448 fontsize => 0.8, 2636 fontsize => 0.8,
2449 fg => [0, 0, 0, 1], 2637 fg => [0, 0, 0, 1],
2450 ellipsise => 0, 2638 ellipsise => 0,
2451 font => ($widget->{tooltip_font} || $::FONT_PROP), 2639 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2462 2650
2463sub size_allocate { 2651sub size_allocate {
2464 my ($self, $w, $h) = @_; 2652 my ($self, $w, $h) = @_;
2465 2653
2466 $self->SUPER::size_allocate ($w - 4, $h - 4); 2654 $self->SUPER::size_allocate ($w - 4, $h - 4);
2655}
2656
2657sub visibility_change {
2658 my ($self, $visible) = @_;
2659
2660 return unless $visible;
2661
2662 $self->{root}->on_post_alloc ("move_$self" => sub {
2663 my $widget = $self->{owner}
2664 or return;
2665
2666 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2667
2668 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2669 if $x + $self->{w} > $::WIDTH;
2670
2671 $self->move_abs ($x, $y);
2672 });
2467} 2673}
2468 2674
2469sub _draw { 2675sub _draw {
2470 my ($self) = @_; 2676 my ($self) = @_;
2471 2677
… …
2488 glVertex $w, $h; 2694 glVertex $w, $h;
2489 glVertex $w, 0; 2695 glVertex $w, 0;
2490 glEnd; 2696 glEnd;
2491 2697
2492 glTranslate 2 - 0.375, 2 - 0.375; 2698 glTranslate 2 - 0.375, 2 - 0.375;
2699
2493 $self->SUPER::_draw; 2700 $self->SUPER::_draw;
2494} 2701}
2495 2702
2496############################################################################# 2703#############################################################################
2497 2704
… …
2503 2710
2504sub new { 2711sub new {
2505 my $class = shift; 2712 my $class = shift;
2506 2713
2507 my $self = $class->SUPER::new ( 2714 my $self = $class->SUPER::new (
2508 aspect => 1, 2715 aspect => 1,
2716 can_events => 0,
2509 @_, 2717 @_,
2510 ); 2718 );
2511 2719
2512 if ($self->{anim} && $self->{animspeed}) { 2720 if ($self->{anim} && $self->{animspeed}) {
2513 Scalar::Util::weaken (my $widget = $self); 2721 Scalar::Util::weaken (my $widget = $self);
… …
2539} 2747}
2540 2748
2541sub _draw { 2749sub _draw {
2542 my ($self) = @_; 2750 my ($self) = @_;
2543 2751
2544 return unless $::CONN;#d# manage and cache textures differently 2752 return unless $::CONN;
2545 2753
2546 my $face; 2754 my $face;
2547 2755
2548 if ($self->{frame}) { 2756 if ($self->{frame}) {
2549 my $anim = $::CONN->{anim}[$self->{anim}]; 2757 my $anim = $::CONN->{anim}[$self->{anim}];
… …
2572 $self->SUPER::DESTROY; 2780 $self->SUPER::DESTROY;
2573} 2781}
2574 2782
2575############################################################################# 2783#############################################################################
2576 2784
2577package CFClient::UI::InventoryItem; 2785package CFClient::UI::Inventory;
2578 2786
2579our @ISA = CFClient::UI::HBox::; 2787our @ISA = CFClient::UI::ScrolledWindow::;
2580
2581sub _item_to_desc {
2582 my ($item) = @_;
2583
2584 my $desc =
2585 $item->{nrof} < 2
2586 ? $item->{name}
2587 : "$item->{nrof} × $item->{name_pl}";
2588
2589 $item->{flags} & Crossfire::Protocol::F_OPEN
2590 and $desc .= " (open)";
2591 $item->{flags} & Crossfire::Protocol::F_APPLIED
2592 and $desc .= " (applied)";
2593 $item->{flags} & Crossfire::Protocol::F_UNPAID
2594 and $desc .= " (unpaid)";
2595 $item->{flags} & Crossfire::Protocol::F_MAGIC
2596 and $desc .= " (magic)";
2597 $item->{flags} & Crossfire::Protocol::F_CURSED
2598 and $desc .= " (cursed)";
2599 $item->{flags} & Crossfire::Protocol::F_DAMNED
2600 and $desc .= " (damned)";
2601 $item->{flags} & Crossfire::Protocol::F_LOCKED
2602 and $desc .= " *";
2603
2604 $desc
2605}
2606 2788
2607sub new { 2789sub new {
2608 my $class = shift; 2790 my $class = shift;
2609 2791
2610 my %args = @_;
2611
2612 my $item = delete $args{item};
2613
2614 my $desc = _item_to_desc ($item);
2615
2616 my $self = $class->SUPER::new ( 2792 my $self = $class->SUPER::new (
2617 can_hover => 1, 2793 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2618 can_events => 1,
2619 tooltip => ((CFClient::UI::Label::escape $desc)
2620 . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
2621 connect_button_down => sub {
2622 my ($self, $ev, $x, $y) = @_;
2623
2624 # todo: maybe put examine on 1? but should just be a tooltip :(
2625 if ($ev->{button} == 1) {
2626 my $targ = $::CONN->{player}{tag};
2627
2628 if ($item->{container} == $::CONN->{player}{tag}) {
2629 $targ = $main::OPENCONT;
2630 }
2631
2632 $::CONN->send ("move $targ $item->{tag} 0");
2633 } elsif ($ev->{button} == 2) {
2634 $::CONN->send ("apply $item->{tag}");
2635 } elsif ($ev->{button} == 3) {
2636 my @menu_items = (
2637 ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2638 ["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2639 ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2640 (
2641 $item->{flags} & Crossfire::Protocol::F_LOCKED
2642 ? (
2643 ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2644 )
2645 : (
2646 ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2647 ["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2648 )
2649 ),
2650 );
2651
2652 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2653 }
2654
2655 1
2656 },
2657 %args
2658 );
2659
2660
2661 $self->add (new CFClient::UI::Face
2662 can_events => 0,
2663 face => $item->{face},
2664 anim => $item->{anim},
2665 animspeed => $item->{animspeed},
2666 );
2667
2668 $self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2669
2670 $self->{item} = $item;
2671
2672 $self->update_item;
2673
2674 $self
2675}
2676
2677sub update_item {
2678 my ($self) = @_;
2679
2680 my $desc = _item_to_desc ($self->{item});
2681
2682 $self->{name_lbl}->set_text ($desc);
2683}
2684
2685#############################################################################
2686
2687package CFClient::UI::Inventory;
2688
2689our @ISA = CFClient::UI::ScrolledWindow::;
2690
2691sub new {
2692 my $class = shift;
2693
2694 my $self = $class->SUPER::new (
2695 scrolled => (new CFClient::UI::VBox),
2696 @_, 2794 @_,
2697 ); 2795 );
2698 2796
2699 $self 2797 $self
2700} 2798}
… …
2710 or ($a->{name} cmp $b->{name}) 2808 or ($a->{name} cmp $b->{name})
2711 } @$items; 2809 } @$items;
2712 2810
2713 $self->{real_items} = \@items; 2811 $self->{real_items} = \@items;
2714 2812
2813 my $row = 0;
2715 for my $item (@items) { 2814 for my $item (@items) {
2716 $item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item; 2815 CFClient::Item::update_widgets $item;
2717 $item->update_item ();
2718 }
2719 2816
2720 $self->{scrolled}->add (@items); 2817 $self->{scrolled}->add (0, $row, $item->{face_widget});
2818 $self->{scrolled}->add (1, $row, $item->{desc_widget});
2819 $self->{scrolled}->add (2, $row, $item->{weight_widget});
2721 2820
2722# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page]; 2821 $row++;
2723} 2822 }
2724
2725sub size_request {
2726 my ($self) = @_;
2727 ($self->{req_w}, $self->{req_h});
2728} 2823}
2729 2824
2730############################################################################# 2825#############################################################################
2731 2826
2732package CFClient::UI::Menu; 2827package CFClient::UI::Menu;
… …
2767 2862
2768# popup given the event (must be a mouse button down event currently) 2863# popup given the event (must be a mouse button down event currently)
2769sub popup { 2864sub popup {
2770 my ($self, $ev) = @_; 2865 my ($self, $ev) = @_;
2771 2866
2772 $self->emit ("popdown"); 2867 $self->_emit ("popdown");
2773 2868
2774 # maybe save $GRAB? must be careful about events... 2869 # maybe save $GRAB? must be careful about events...
2775 $GRAB = $self; 2870 $GRAB = $self;
2776 $self->{button} = $ev->{button}; 2871 $self->{button} = $ev->{button};
2777 2872
2778 $self->show; 2873 $self->show;
2779 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2874 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2780} 2875}
2781 2876
2782sub mouse_motion { 2877sub mouse_motion {
2783 my ($self, $ev, $x, $y) = @_; 2878 my ($self, $ev, $x, $y) = @_;
2784 2879
… …
2792 2887
2793 if ($ev->{button} == $self->{button}) { 2888 if ($ev->{button} == $self->{button}) {
2794 undef $GRAB; 2889 undef $GRAB;
2795 $self->hide; 2890 $self->hide;
2796 2891
2797 $self->emit ("popdown"); 2892 $self->_emit ("popdown");
2798 $self->{hover}[1]->() if $self->{hover}; 2893 $self->{hover}[1]->() if $self->{hover};
2799 } 2894 }
2800} 2895}
2801 2896
2802############################################################################# 2897#############################################################################
… …
2864sub add { 2959sub add {
2865 my ($self, $text, %arg) = @_; 2960 my ($self, $text, %arg) = @_;
2866 2961
2867 $text =~ s/^\s+//; 2962 $text =~ s/^\s+//;
2868 $text =~ s/\s+$//; 2963 $text =~ s/\s+$//;
2964
2965 return unless $text;
2869 2966
2870 my $timeout = time + ((delete $arg{timeout}) || 60); 2967 my $timeout = time + ((delete $arg{timeout}) || 60);
2871 2968
2872 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 2969 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2873 2970
… …
2916use CFClient::OpenGL; 3013use CFClient::OpenGL;
2917 3014
2918sub new { 3015sub new {
2919 my $class = shift; 3016 my $class = shift;
2920 3017
2921 $class->SUPER::new ( 3018 my $self = $class->SUPER::new (
3019 visible => 1,
2922 @_, 3020 @_,
2923 ) 3021 );
2924}
2925 3022
2926sub configure { 3023 Scalar::Util::weaken ($self->{root} = $self);
2927 my ($self, $x, $y, $w, $h) = @_;
2928 3024
2929 $self->{w} = $w; 3025 $self
2930 $self->{h} = $h;
2931}
2932
2933sub check_size {
2934 my ($self) = @_;
2935
2936 $self->size_allocate ($self->{w}, $self->{h})
2937 if $self->{w};
2938} 3026}
2939 3027
2940sub size_request { 3028sub size_request {
2941 my ($self) = @_; 3029 my ($self) = @_;
2942 3030
2943 ($self->{w}, $self->{h}) 3031 ($self->{w}, $self->{h})
3032}
3033
3034sub _to_pixel {
3035 my ($coord, $size, $max) = @_;
3036
3037 $coord =
3038 $coord eq "center" ? ($max - $size) * 0.5
3039 : $coord eq "max" ? $max
3040 : $coord;
3041
3042 $coord = 0 if $coord < 0;
3043 $coord = $max - $size if $coord > $max - $size;
3044
3045 int $coord + 0.5
2944} 3046}
2945 3047
2946sub size_allocate { 3048sub size_allocate {
2947 my ($self, $w, $h) = @_; 3049 my ($self, $w, $h) = @_;
2948 3050
2949 my $old_w = $self->{old_w}; $self->{old_w} = $w;
2950 my $old_h = $self->{old_h}; $self->{old_h} = $h;
2951
2952 CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
2953 if $old_w && $old_h && ($old_w != $w || $old_h != $h);
2954
2955 for my $child ($self->children) { 3051 for my $child ($self->children) {
2956 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3052 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2957 3053
2958 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3054 $X = $child->{force_x} if exists $child->{force_x};
2959 if exists $child->{req_x}; 3055 $Y = $child->{force_y} if exists $child->{force_y};
2960 3056
2961 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3057 $X = _to_pixel $X, $W, $self->{w};
2962 if exists $child->{req_y}; 3058 $Y = _to_pixel $Y, $H, $self->{h};
2963
2964 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
2965 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
2966 3059
2967 $child->configure ($X, $Y, $W, $H); 3060 $child->configure ($X, $Y, $W, $H);
2968 } 3061 }
2969} 3062}
2970 3063
… …
2981} 3074}
2982 3075
2983sub update { 3076sub update {
2984 my ($self) = @_; 3077 my ($self) = @_;
2985 3078
2986 $self->check_size;
2987 $::WANT_REFRESH++; 3079 $::WANT_REFRESH++;
2988} 3080}
2989 3081
2990sub add { 3082sub add {
2991 my ($self, @children) = @_; 3083 my ($self, @children) = @_;
2992 3084
2993 for my $child (@children) {
2994 $child->{toplevel} = 1; 3085 $_->{is_toplevel} = 1
2995 3086 for @children;
2996 # integerise window positions
2997 $child->{x} = int $child->{x};
2998 $child->{y} = int $child->{y};
2999 }
3000 3087
3001 $self->SUPER::add (@children); 3088 $self->SUPER::add (@children);
3089}
3090
3091sub remove {
3092 my ($self, @children) = @_;
3093
3094 $self->SUPER::remove (@children);
3095
3096 delete $self->{is_toplevel}
3097 for @children;
3002 3098
3003 while (@children) { 3099 while (@children) {
3004 my $w = pop @children; 3100 my $w = pop @children;
3005 push @children, $w->children; 3101 push @children, $w->children;
3006 $w->{visible} = 1; 3102 $w->set_invisible;
3007 }
3008}
3009
3010sub remove {
3011 my ($self, @children) = @_;
3012
3013 $self->SUPER::remove (@children);
3014
3015 while (@children) {
3016 my $w = pop @children;
3017 push @children, $w->children;
3018 delete $w->{visible};
3019 } 3103 }
3020} 3104}
3021 3105
3022sub on_refresh { 3106sub on_refresh {
3023 my ($self, $id, $cb) = @_; 3107 my ($self, $id, $cb) = @_;
… …
3037 while ($self->{refresh_hook}) { 3121 while ($self->{refresh_hook}) {
3038 $_->() 3122 $_->()
3039 for values %{delete $self->{refresh_hook}}; 3123 for values %{delete $self->{refresh_hook}};
3040 } 3124 }
3041 3125
3042 if ($self->{check_size}) { 3126 if ($self->{realloc}) {
3043 my @queue = ([], []); 3127 my @queue;
3044 3128
3045 for (;;) { 3129 while () {
3046 if ($self->{check_size}) { 3130 if ($self->{realloc}) {
3047 # heuristic: check containers last 3131 #TODO use array-of-depth approach
3048 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3132
3049 for values %{delete $self->{check_size}} 3133 use sort 'stable';
3134
3135 @queue = sort { $a->{visible} <=> $b->{visible} }
3136 @queue, values %{delete $self->{realloc}};
3050 } 3137 }
3051 3138
3052 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3139 my $widget = pop @queue || last;
3053 3140
3054 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3141 $widget->{visible} or last; # do not resize invisible widgets
3055 ? @$widget{qw(user_w user_h)} 3142
3056 : $widget->size_request; 3143 my ($w, $h) = $widget->size_request;
3057 3144
3145 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3146 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3147
3148 $w = $widget->{force_w} if exists $widget->{force_w};
3149 $h = $widget->{force_h} if exists $widget->{force_h};
3150
3151 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3058 if (delete $widget->{force_alloc} 3152 || delete $widget->{force_realloc}) {
3059 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3060 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3061
3062 $widget->{req_w} = $w; 3153 $widget->{req_w} = $w;
3063 $widget->{req_h} = $h; 3154 $widget->{req_h} = $h;
3064 3155
3065 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3156 $self->{size_alloc}{$widget+0} = $widget;
3066 3157
3067 $widget->{parent}->check_size
3068 if $widget->{parent}; 3158 if (my $parent = $widget->{parent}) {
3159 $self->{realloc}{$parent+0} = $parent;
3160 #unshift @queue, $parent;
3161 $parent->{force_size_alloc} = 1;
3162 $self->{size_alloc}{$parent+0} = $parent;
3163 }
3069 } 3164 }
3165
3166 delete $self->{realloc}{$widget+0};
3070 } 3167 }
3071 } 3168 }
3072 3169
3073 while ($self->{size_alloc}) { 3170 while (my $size_alloc = delete $self->{size_alloc}) {
3074 for (values %{delete $self->{size_alloc}}) { 3171 my @queue = sort { $b->{visible} <=> $a->{visible} }
3075 my ($widget, $w, $h) = @$_; 3172 values %$size_alloc;
3173
3174 while () {
3175 my $widget = pop @queue || last;
3176
3177 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3076 3178
3077 $w = 0 if $w < 0; 3179 $w = 0 if $w < 0;
3078 $h = 0 if $h < 0; 3180 $h = 0 if $h < 0;
3079 3181
3182 $w = int $w + 0.5;
3183 $h = int $h + 0.5;
3184
3185 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3080 $widget->{w} = $w; 3186 $widget->{w} = $w;
3081 $widget->{h} = $h; 3187 $widget->{h} = $h;
3082 $widget->size_allocate ($w, $h); 3188
3083 $widget->emit (size_allocate => $w, $h); 3189 $widget->emit (size_allocate => $w, $h);
3190 }
3084 } 3191 }
3085 } 3192 }
3086 3193
3087 while ($self->{post_alloc_hook}) { 3194 while ($self->{post_alloc_hook}) {
3088 $_->() 3195 $_->()
3089 for values %{delete $self->{post_alloc_hook}}; 3196 for values %{delete $self->{post_alloc_hook}};
3090 } 3197 }
3198
3091 3199
3092 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3200 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3093 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3201 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3094 glClear GL_COLOR_BUFFER_BIT; 3202 glClear GL_COLOR_BUFFER_BIT;
3095 3203
… …
3102 $self->_draw; 3210 $self->_draw;
3103} 3211}
3104 3212
3105############################################################################# 3213#############################################################################
3106 3214
3215package CFClient::UI::BindEditor;
3216
3217our @ISA = CFClient::UI::FancyFrame::;
3218
3219sub new {
3220 my $class = shift;
3221
3222 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3223
3224 $self->add (my $vb = new CFClient::UI::VBox);
3225
3226
3227 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3228 text => "start recording",
3229 tooltip => "Start/Stops recording of actions."
3230 ."All subsequent actions after the recording started will be captured."
3231 ."The actions are displayed after the record was stopped."
3232 ."To bind the action you have to click on the 'Bind' button",
3233 on_activate => sub {
3234 unless ($self->{recording}) {
3235 $self->start;
3236 } else {
3237 $self->stop;
3238 }
3239 });
3240
3241 $vb->add (new CFClient::UI::Label text => "Actions:");
3242 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3243
3244 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3245 $vb->add (my $hb = new CFClient::UI::HBox);
3246 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3247 $hb->add (new CFClient::UI::Button
3248 text => "bind",
3249 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3250 on_activate => sub {
3251 $self->ask_for_bind;
3252 });
3253
3254 $vb->add (my $hb = new CFClient::UI::HBox);
3255 $hb->add (new CFClient::UI::Button
3256 text => "ok",
3257 expand => 1,
3258 tooltip => "This closes the binding editor and saves the binding",
3259 on_activate => sub {
3260 $self->hide;
3261 $self->commit;
3262 });
3263
3264 $hb->add (new CFClient::UI::Button
3265 text => "cancel",
3266 expand => 1,
3267 tooltip => "This closes the binding editor without saving",
3268 on_activate => sub {
3269 $self->hide;
3270 $self->{binding_cancel}->()
3271 if $self->{binding_cancel};
3272 });
3273
3274 $self->update_binding_widgets;
3275
3276 $self
3277}
3278
3279sub commit {
3280 my ($self) = @_;
3281 my ($mod, $sym, $cmds) = $self->get_binding;
3282 if ($sym != 0 && @$cmds > 0) {
3283 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3284 ."'. Don't forget 'Save Config'!");
3285 $self->{binding_change}->($mod, $sym, $cmds)
3286 if $self->{binding_change};
3287 } else {
3288 $::STATUSBOX->add ("No action bound, no key or action specified!");
3289 $self->{binding_cancel}->()
3290 if $self->{binding_cancel};
3291 }
3292}
3293
3294sub start {
3295 my ($self) = @_;
3296
3297 $self->{rec_btn}->set_text ("stop recording");
3298 $self->{recording} = 1;
3299 $self->clear_command_list;
3300 $::CONN->start_record if $::CONN;
3301}
3302
3303sub stop {
3304 my ($self) = @_;
3305
3306 $self->{rec_btn}->set_text ("start recording");
3307 $self->{recording} = 0;
3308
3309 my $rec;
3310 $rec = $::CONN->stop_record if $::CONN;
3311 return unless ref $rec eq 'ARRAY';
3312 $self->set_command_list ($rec);
3313}
3314
3315# if $commit is true, the binding will be set after the user entered a key combo
3316sub ask_for_bind {
3317 my ($self, $commit) = @_;
3318
3319 CFClient::Binder::open_binding_dialog (sub {
3320 my ($mod, $sym) = @_;
3321 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3322 $self->update_binding_widgets;
3323 $self->commit if $commit;
3324 });
3325}
3326
3327# $mod and $sym are the modifiers and key symbol
3328# $cmds is a array ref of strings (the commands)
3329# $cb is the callback that is executed on OK
3330# $ccb is the callback that is executed on CANCEL and
3331# when the binding was unsuccessful on OK
3332sub set_binding {
3333 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3334
3335 $self->clear_command_list;
3336 $self->{recording} = 0;
3337 $self->{rec_btn}->set_text ("start recording");
3338
3339 $self->{binding} = [$mod, $sym];
3340 $self->{commands} = $cmds;
3341
3342 $self->{binding_change} = $cb;
3343 $self->{binding_cancel} = $ccb;
3344
3345 $self->update_binding_widgets;
3346}
3347
3348# this is a shortcut method that asks for a binding
3349# and then just binds it.
3350sub do_quick_binding {
3351 my ($self, $cmds) = @_;
3352 $self->set_binding (undef, undef, $cmds, sub {
3353 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3354 });
3355 $self->ask_for_bind (1);
3356}
3357
3358sub update_binding_widgets {
3359 my ($self) = @_;
3360 my ($mod, $sym, $cmds) = $self->get_binding;
3361 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3362 $self->set_command_list ($cmds);
3363}
3364
3365sub get_binding {
3366 my ($self) = @_;
3367 return (
3368 $self->{binding}->[0],
3369 $self->{binding}->[1],
3370 [ grep { defined $_ } @{$self->{commands}} ]
3371 );
3372}
3373
3374sub clear_command_list {
3375 my ($self) = @_;
3376 $self->{cmdbox}->clear ();
3377}
3378
3379sub set_command_list {
3380 my ($self, $cmds) = @_;
3381
3382 $self->{cmdbox}->clear ();
3383 $self->{commands} = $cmds;
3384
3385 my $idx = 0;
3386
3387 for (@$cmds) {
3388 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3389
3390 my $i = $idx;
3391 $hb->add (new CFClient::UI::Button
3392 text => "delete",
3393 tooltip => "Deletes the action from the record",
3394 on_activate => sub {
3395 $self->{cmdbox}->remove ($hb);
3396 $cmds->[$i] = undef;
3397 });
3398
3399 $hb->add (new CFClient::UI::Label text => $_);
3400
3401 $idx++
3402 }
3403}
3404
3405
3406#############################################################################
3407
3408package CFClient::UI::SpellList;
3409
3410our @ISA = CFClient::UI::FancyFrame::;
3411
3412sub new {
3413 my $class = shift;
3414
3415 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3416
3417 $self->add (new CFClient::UI::ScrolledWindow
3418 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3419
3420 $self;
3421}
3422
3423# XXX: Do sorting? Argl...
3424sub add_spell {
3425 my ($self, $spell) = @_;
3426 $self->{spells}->{$spell->{name}} = $spell;
3427
3428 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3429 face => $spell->{face},
3430 can_hover => 1,
3431 can_events => 1,
3432 tooltip => $spell->{message});
3433
3434 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3435 text => $spell->{name},
3436 can_hover => 1,
3437 can_events => 1,
3438 tooltip => $spell->{message},
3439 expand => 1);
3440 $self->{spellbox}->add (2, $self->{tbl_idx}++, new CFClient::UI::Button
3441 text => "bind to key",
3442 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3443}
3444
3445sub rebuild_spell_list {
3446 my ($self) = @_;
3447 $self->{tbl_idx} = 0;
3448 $self->add_spell ($_) for values %{$self->{spells}};
3449}
3450
3451sub remove_spell {
3452 my ($self, $spell) = @_;
3453 delete $self->{spells}->{$spell->{name}};
3454 $self->rebuild_spell_list;
3455}
3456
3457#############################################################################
3458
3107package CFClient::UI; 3459package CFClient::UI;
3108 3460
3109$ROOT = new CFClient::UI::Root; 3461$ROOT = new CFClient::UI::Root;
3110$TOOLTIP = new CFClient::UI::Tooltip z => 900; 3462$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3111 3463

Diff Legend

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