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.296 by root, Wed Jun 7 05:48:53 2006 UTC vs.
Revision 1.482 by root, Sat Aug 13 23:18:19 2011 UTC

1package CFClient::UI; 1package DC::UI;
2 2
3use utf8; 3use common::sense;
4use strict;
5 4
6use Scalar::Util ();
7use List::Util (); 5use List::Util ();
6
8use Event; 7use AnyEvent ();
8use Guard ();
9 9
10use CFClient; 10use DC;
11use DC::Pod;
11use CFClient::Texture; 12use DC::Texture;
12 13
13our ($FOCUS, $HOVER, $GRAB); # various widgets 14our ($FOCUS, $HOVER, $GRAB); # various widgets
14 15
15our $LAYOUT; 16our $LAYOUT;
16our $ROOT; 17our $ROOT;
17our $TOOLTIP; 18our $TOOLTIP;
18our $BUTTON_STATE; 19our $BUTTON_STATE;
19 20
20our %WIDGET; # all widgets, weak-referenced 21our %WIDGET; # all widgets, weak-referenced
21 22
22our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub { 23our $TOOLTIP_WATCHER = EV::timer_ns 0, 0.03, sub {
24 $_[0]->stop;
25
23 if (!$GRAB) { 26 if (!$GRAB) {
24 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 27 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
25 if (length $widget->{tooltip}) { 28 if (length $widget->{tooltip}) {
26 if ($TOOLTIP->{owner} != $widget) { 29 if ($TOOLTIP->{owner} != $widget) {
30 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
27 $TOOLTIP->hide; 31 $TOOLTIP->hide;
28 32
29 $TOOLTIP->{owner} = $widget; 33 $TOOLTIP->{owner} = $widget;
34 $TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner};
30 35
31 return if $ENV{CFPLUS_DEBUG} & 8; 36 return if $ENV{CFPLUS_DEBUG} & 8;
32 37
33 my $tip = $widget->{tooltip};
34
35 $tip = $tip->($widget) if CODE:: eq ref $tip;
36
37 $TOOLTIP->set_tooltip_from ($widget); 38 $TOOLTIP->set_tooltip_from ($widget);
38 $TOOLTIP->show; 39 $TOOLTIP->show;
39 } 40 }
40 41
41 return; 42 return;
42 } 43 }
43 } 44 }
44 } 45 }
45 46
46 $TOOLTIP->hide; 47 $TOOLTIP->hide;
48 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
47 delete $TOOLTIP->{owner}; 49 delete $TOOLTIP->{owner};
48}); 50};
49 51
50sub get_layout { 52sub get_layout {
51 my $layout; 53 my $layout;
52 54
53 for (grep { $_->{name} } values %WIDGET) { 55 for (grep { $_->{name} } values %WIDGET) {
… …
79sub feed_sdl_key_up_event { 81sub feed_sdl_key_up_event {
80 $FOCUS->emit (key_up => $_[0]) 82 $FOCUS->emit (key_up => $_[0])
81 if $FOCUS; 83 if $FOCUS;
82} 84}
83 85
86sub check_hover {
87 my ($widget) = @_;
88
89 if ($widget != $HOVER) {
90 my $hover = $HOVER; $HOVER = $widget;
91
92 $hover->update if $hover && $hover->{can_hover};
93 $HOVER->update if $HOVER && $HOVER->{can_hover};
94
95 $TOOLTIP_WATCHER->again;
96 }
97}
98
84sub feed_sdl_button_down_event { 99sub feed_sdl_button_down_event {
85 my ($ev) = @_; 100 my ($ev) = @_;
86 my ($x, $y) = ($ev->{x}, $ev->{y}); 101 my ($x, $y) = ($ev->{x}, $ev->{y});
87 102
88 if (!$BUTTON_STATE) { 103 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
104
105 unless ($GRAB) {
89 my $widget = $ROOT->find_widget ($x, $y); 106 my $widget = $ROOT->find_widget ($x, $y);
90 107
91 $GRAB = $widget; 108 $GRAB = $widget;
92 $GRAB->update if $GRAB; 109 $GRAB->update if $GRAB;
93 110
94 $TOOLTIP_WATCHER->cb->(); 111 $TOOLTIP_WATCHER->invoke;
95 } 112 }
96 113
97 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 114 if ($GRAB) {
115 if ($ev->{button} == 4 || $ev->{button} == 5) {
116 # mousewheel
117 my $delta = $ev->{button} * 2 - 9;
118 my $shift = $ev->{mod} & DC::KMOD_SHIFT;
98 119
99 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y)) 120 $ev->{dx} = $shift ? $delta : 0;
100 if $GRAB; 121 $ev->{dy} = $shift ? 0 : $delta;
122
123 $GRAB->emit (mouse_wheel => $ev);
124 } else {
125 $GRAB->emit (button_down => $ev)
126 }
127 }
101} 128}
102 129
103sub feed_sdl_button_up_event { 130sub feed_sdl_button_up_event {
104 my ($ev) = @_; 131 my ($ev) = @_;
105 my ($x, $y) = ($ev->{x}, $ev->{y});
106 132
107 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 133 my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108 134
109 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 135 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110 136
111 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y)) 137 $GRAB->emit (button_up => $ev)
112 if $GRAB; 138 if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113 139
114 if (!$BUTTON_STATE) { 140 unless ($BUTTON_STATE) {
115 my $grab = $GRAB; undef $GRAB; 141 my $grab = $GRAB; undef $GRAB;
116 $grab->update if $grab; 142 $grab->update if $grab;
117 $GRAB->update if $GRAB; 143 $GRAB->update if $GRAB;
118 144
145 check_hover $widget;
119 $TOOLTIP_WATCHER->cb->(); 146 $TOOLTIP_WATCHER->invoke;
120 } 147 }
121} 148}
122 149
123sub feed_sdl_motion_event { 150sub feed_sdl_motion_event {
124 my ($ev) = @_; 151 my ($ev) = @_;
125 my ($x, $y) = ($ev->{x}, $ev->{y}); 152 my ($x, $y) = ($ev->{x}, $ev->{y});
126 153
127 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 154 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128 155
129 if ($widget != $HOVER) { 156 check_hover $widget;
130 my $hover = $HOVER; $HOVER = $widget;
131 157
132 $hover->update if $hover && $hover->{can_hover}; 158 $HOVER->emit (mouse_motion => $ev)
133 $HOVER->update if $HOVER && $HOVER->{can_hover};
134
135 $TOOLTIP_WATCHER->start;
136 }
137
138 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
139 if $HOVER; 159 if $HOVER;
140} 160}
141 161
142# convert position array to integers 162# convert position array to integers
143sub harmonize { 163sub harmonize {
… …
171# call when resolution changes etc. 191# call when resolution changes etc.
172sub rescale_widgets { 192sub rescale_widgets {
173 my ($sx, $sy) = @_; 193 my ($sx, $sy) = @_;
174 194
175 for my $widget (values %WIDGET) { 195 for my $widget (values %WIDGET) {
176 if ($widget->{is_toplevel}) { 196 if ($widget->{is_toplevel} || $widget->{c_rescale}) {
177 $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; 197 $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
178 $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; 198 $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
179 199
180 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/; 200 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
181 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 201 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
… …
193 reconfigure_widgets; 213 reconfigure_widgets;
194} 214}
195 215
196############################################################################# 216#############################################################################
197 217
218package DC::UI::Event;
219
220sub xy {
221 $_[1]->coord2local ($_[0]{x}, $_[0]{y})
222}
223
224#############################################################################
225
198package CFClient::UI::Base; 226package DC::UI::Base;
199 227
200use strict; 228use common::sense;
201 229
202use CFClient::OpenGL; 230use DC::OpenGL;
203 231
204sub new { 232sub new {
205 my $class = shift; 233 my $class = shift;
206 234
207 my $self = bless { 235 my $self = bless {
… …
212 h => undef, 240 h => undef,
213 can_events => 1, 241 can_events => 1,
214 @_ 242 @_
215 }, $class; 243 }, $class;
216 244
217 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 245 DC::weaken ($DC::UI::WIDGET{$self+0} = $self);
218 246
219 for (keys %$self) { 247 for (keys %$self) {
220 if (/^on_(.*)$/) { 248 if (/^on_(.*)$/) {
221 $self->connect ($1 => delete $self->{$_}); 249 $self->connect ($1 => delete $self->{$_});
222 } 250 }
223 } 251 }
224 252
225 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) { 253 if (my $layout = $DC::UI::LAYOUT->{$self->{name}}) {
226 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x}; 254 $self->{x} = $layout->{x} * $DC::UI::ROOT->{alloc_w} if exists $layout->{x};
227 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y}; 255 $self->{y} = $layout->{y} * $DC::UI::ROOT->{alloc_h} if exists $layout->{y};
228 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w}; 256 $self->{force_w} = $layout->{w} * $DC::UI::ROOT->{alloc_w} if exists $layout->{w};
229 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h}; 257 $self->{force_h} = $layout->{h} * $DC::UI::ROOT->{alloc_h} if exists $layout->{h};
230 258
231 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x}; 259 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
232 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y}; 260 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
233 261
234 $self->show if $layout->{show}; 262 $self->show if $layout->{show};
… …
239 267
240sub destroy { 268sub destroy {
241 my ($self) = @_; 269 my ($self) = @_;
242 270
243 $self->hide; 271 $self->hide;
272 $self->emit ("destroy");
244 %$self = (); 273 %$self = ();
245} 274}
246 275
276sub TO_JSON {
277 { "\fw" => $_[0]{s_id} }
278}
279
247sub show { 280sub show {
248 my ($self) = @_; 281 my ($self) = @_;
249 282
250 return if $self->{parent}; 283 return if $self->{parent};
251 284
252 $CFClient::UI::ROOT->add ($self); 285 $DC::UI::ROOT->add ($self);
253} 286}
254 287
255sub set_visible { 288sub set_visible {
256 my ($self) = @_; 289 my ($self) = @_;
257 290
258 return if $self->{visible}; 291 return if $self->{visible};
292
293 $self->{parent} && $self->{parent}{root}#d#
294 or return ::clienterror ("set_visible called without parent ($self->{parent}) or root\n" => 1);
259 295
260 $self->{root} = $self->{parent}{root}; 296 $self->{root} = $self->{parent}{root};
261 $self->{visible} = $self->{parent}{visible} + 1; 297 $self->{visible} = $self->{parent}{visible} + 1;
262 298
263 $self->emit (visibility_change => 1); 299 $self->emit (visibility_change => 1);
264 300
265 $self->realloc if !exists $self->{req_w}; 301 $self->realloc if !exists $self->{req_w};
266 302
267 $_->set_visible for $self->children; 303 $_->set_visible for $self->visible_children;
268} 304}
269 305
270sub set_invisible { 306sub set_invisible {
271 my ($self) = @_; 307 my ($self) = @_;
272 308
273 return unless $self->{visible}; 309 return unless $self->{visible};
274 310
275 $_->set_invisible for $self->children; 311 $_->set_invisible for $self->children;
276 312
313 delete $self->{visible};
277 delete $self->{root}; 314 delete $self->{root};
278 delete $self->{visible};
279 315
280 undef $GRAB if $GRAB == $self; 316 undef $GRAB if $GRAB == $self;
281 undef $HOVER if $HOVER == $self; 317 undef $HOVER if $HOVER == $self;
282 318
283 $CFClient::UI::TOOLTIP_WATCHER->cb->() 319 $DC::UI::TOOLTIP_WATCHER->invoke
284 if $TOOLTIP->{owner} == $self; 320 if $TOOLTIP->{owner} == $self;
285 321
286 $self->focus_out; 322 $self->emit ("focus_out");
287
288 $self->emit (visibility_change => 0); 323 $self->emit (visibility_change => 0);
289} 324}
290 325
291sub set_visibility { 326sub set_visibility {
292 my ($self, $visible) = @_; 327 my ($self, $visible) = @_;
293 328
294 return if $self->{visible} == $visible; 329 return if $self->{visible} == $visible;
295 330
296 $visible ? $self->hide 331 $visible ? $self->show
297 : $self->show; 332 : $self->hide;
298} 333}
299 334
300sub toggle_visibility { 335sub toggle_visibility {
301 my ($self) = @_; 336 my ($self) = @_;
302 337
… …
308sub hide { 343sub hide {
309 my ($self) = @_; 344 my ($self) = @_;
310 345
311 $self->set_invisible; 346 $self->set_invisible;
312 347
348 # extra $parent copy for 5.8.8+ bug workaround
349 # (otherwise $_[0] in remove gets freed
350 if (my $parent = $self->{parent}) {
313 $self->{parent}->remove ($self) 351 $parent->remove ($self);
314 if $self->{parent}; 352 }
315} 353}
316 354
317sub move_abs { 355sub move_abs {
318 my ($self, $x, $y, $z) = @_; 356 my ($self, $x, $y, $z) = @_;
319 357
… …
331 $self->{force_h} = $h; 369 $self->{force_h} = $h;
332 370
333 $self->realloc; 371 $self->realloc;
334} 372}
335 373
374# traverse the widget chain up to find the maximum "physical" size constraints
375sub get_max_wh {
376 my ($self) = @_;
377
378 my ($w, $h) = @$self{qw(max_w max_h)};
379
380 if ($w <= 0 || $h <= 0) {
381 my ($mw, $mh) = $self->{parent}
382 ? $self->{parent}->get_max_wh
383 : ($::WIDTH, $::HEIGHT);
384
385 $w = $mw if $w <= 0;
386 $h = $mh if $h <= 0;
387 }
388
389 ($w, $h)
390}
391
336sub size_request { 392sub size_request {
337 require Carp; 393 require Carp;
338 Carp::confess "size_request is abstract"; 394 Carp::confess "size_request is abstract";
339} 395}
340 396
397sub baseline_shift {
398 0
399}
400
341sub configure { 401sub configure {
342 my ($self, $x, $y, $w, $h) = @_; 402 my ($self, $x, $y, $w, $h) = @_;
343 403
344 if ($self->{aspect}) { 404 if ($self->{aspect}) {
345 my ($ow, $oh) = ($w, $h); 405 my ($ow, $oh) = ($w, $h);
346 406
347 $w = List::Util::min $w, int $h * $self->{aspect}; 407 $w = List::Util::min $w, DC::ceil $h * $self->{aspect};
348 $h = List::Util::min $h, int $w / $self->{aspect}; 408 $h = List::Util::min $h, DC::ceil $w / $self->{aspect};
349 409
350 # use alignment to adjust x, y 410 # use alignment to adjust x, y
351 411
352 $x += int 0.5 * ($ow - $w); 412 $x += int 0.5 * ($ow - $w);
353 $y += int 0.5 * ($oh - $h); 413 $y += int 0.5 * ($oh - $h);
… …
367 427
368 $self->{root}{size_alloc}{$self+0} = $self; 428 $self->{root}{size_alloc}{$self+0} = $self;
369 } 429 }
370} 430}
371 431
372sub size_allocate {
373 # nothing to be done
374}
375
376sub children { 432sub children {
377 # nop 433 # nop
378} 434}
379 435
380sub visible_children { 436sub visible_children {
… …
398 454
399 return if $self->{tooltip} eq $tooltip; 455 return if $self->{tooltip} eq $tooltip;
400 456
401 $self->{tooltip} = $tooltip; 457 $self->{tooltip} = $tooltip;
402 458
403 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 459 if ($DC::UI::TOOLTIP->{owner} == $self) {
404 delete $CFClient::UI::TOOLTIP->{owner}; 460 delete $DC::UI::TOOLTIP->{owner};
405 $CFClient::UI::TOOLTIP_WATCHER->cb->(); 461 $DC::UI::TOOLTIP_WATCHER->invoke;
406 } 462 }
407} 463}
408 464
409# translate global coordinates to local coordinate system 465# translate global coordinates to local coordinate system
410sub coord2local { 466sub coord2local {
411 my ($self, $x, $y) = @_; 467 my ($self, $x, $y) = @_;
412 468
469 return (undef, undef) unless $self->{parent};
470
413 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) 471 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
414} 472}
415 473
416# translate local coordinates to global coordinate system 474# translate local coordinates to global coordinate system
417sub coord2global { 475sub coord2global {
418 my ($self, $x, $y) = @_; 476 my ($self, $x, $y) = @_;
419 477
478 return (undef, undef) unless $self->{parent};
479
420 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 480 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421} 481}
422 482
423sub focus_in { 483sub invoke_focus_in {
424 my ($self) = @_; 484 my ($self) = @_;
425 485
426 return if $FOCUS == $self; 486 return if $FOCUS == $self;
427 return unless $self->{can_focus}; 487 return unless $self->{can_focus};
428 488
429 my $focus = $FOCUS; $FOCUS = $self; 489 $FOCUS = $self;
430 490
431 $self->_emit (focus_in => $focus); 491 $self->update;
432 492
433 $focus->update if $focus; 493 0
434 $FOCUS->update;
435} 494}
436 495
437sub focus_out { 496sub invoke_focus_out {
438 my ($self) = @_; 497 my ($self) = @_;
439 498
440 return unless $FOCUS == $self; 499 return unless $FOCUS == $self;
441 500
442 my $focus = $FOCUS; undef $FOCUS; 501 undef $FOCUS;
443 502
444 $self->_emit (focus_out => $focus); 503 $self->update;
445 504
446 $focus->update if $focus; #?
447
448 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus 505 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449 unless $FOCUS; 506 unless $FOCUS;
450}
451 507
508 0
509}
510
511sub grab_focus {
512 my ($self) = @_;
513
514 $FOCUS->emit ("focus_out") if $FOCUS;
515 $self->emit ("focus_in");
516}
517
452sub mouse_motion { 0 } 518sub invoke_mouse_motion { 0 }
453sub button_up { 0 } 519sub invoke_button_up { 0 }
454sub key_down { 0 } 520sub invoke_key_down { 0 }
455sub key_up { 0 } 521sub invoke_key_up { 0 }
522sub invoke_mouse_wheel { 0 }
456 523
457sub button_down { 524sub invoke_button_down {
458 my ($self, $ev, $x, $y) = @_; 525 my ($self, $ev, $x, $y) = @_;
459 526
460 $self->focus_in; 527 $self->grab_focus;
461 528
462 0 529 0
463} 530}
464 531
532sub connect {
533 my ($self, $signal, $cb) = @_;
534
535 push @{ $self->{signal_cb}{$signal} }, $cb;
536
537 defined wantarray and Guard::guard {
538 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
539 @{ $self->{signal_cb}{$signal} };
540 }
541}
542
543sub disconnect_all {
544 my ($self, $signal) = @_;
545
546 delete $self->{signal_cb}{$signal};
547}
548
549my %has_coords = (
550 button_down => 1,
551 button_up => 1,
552 mouse_motion => 1,
553 mouse_wheel => 1,
554);
555
556sub emit {
557 my ($self, $signal, @args) = @_;
558
559 # I do not really like this solution, but I do not like duplication
560 # and needlessly verbose code, either.
561 my @append
562 = $has_coords{$signal}
563 ? $args[0]->xy ($self)
564 : ();
565
566 #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
567
568 for my $cb (
569 @{$self->{signal_cb}{$signal} || []}, # before
570 ($self->can ("invoke_$signal") || sub { 1 }), # closure
571 ) {
572 return $cb->($self, @args, @append) || next;
573 }
574
575 # parent
576 $self->{parent} && $self->{parent}->emit ($signal, @args)
577}
578
465sub find_widget { 579#sub find_widget {
466 my ($self, $x, $y) = @_; 580# in .xs
467
468 return () unless $self->{can_events};
469
470 return $self
471 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
472 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
473
474 ()
475}
476 581
477sub set_parent { 582sub set_parent {
478 my ($self, $parent) = @_; 583 my ($self, $parent) = @_;
479 584
480 Scalar::Util::weaken ($self->{parent} = $parent); 585 DC::weaken ($self->{parent} = $parent);
481 $self->set_visible if $parent->{visible}; 586 $self->set_visible if $parent->{visible};
482}
483
484sub connect {
485 my ($self, $signal, $cb) = @_;
486
487 push @{ $self->{signal_cb}{$signal} }, $cb;
488}
489
490sub _emit {
491 my ($self, $signal, @args) = @_;
492
493 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
494}
495
496sub emit {
497 my ($self, $signal, @args) = @_;
498
499 $self->_emit ($signal, @args)
500 || $self->$signal (@args);
501}
502
503sub visibility_change {
504 #my ($self, $visible) = @_;
505} 587}
506 588
507sub realloc { 589sub realloc {
508 my ($self) = @_; 590 my ($self) = @_;
509 591
… …
534 616
535# using global variables seems a bit hacky, but passing through all drawing 617# using global variables seems a bit hacky, but passing through all drawing
536# functions seems pointless. 618# functions seems pointless.
537our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn 619our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
538 620
539sub draw { 621#sub draw {
540 my ($self) = @_; 622#CFPlus.xs
541
542 return unless $self->{h} && $self->{w};
543
544 # update screen rectangle
545 local $draw_x = $draw_x + $self->{x};
546 local $draw_y = $draw_y + $self->{y};
547 local $draw_w = $draw_x + $self->{w};
548 local $draw_h = $draw_y + $self->{h};
549
550 # skip widgets that are entirely outside the drawing area
551 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
553
554 glPushMatrix;
555 glTranslate $self->{x}, $self->{y}, 0;
556
557 if ($self == $HOVER && $self->{can_hover}) {
558 glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
559 glEnable GL_BLEND;
560 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
561 glBegin GL_QUADS;
562 glVertex 0 , 0;
563 glVertex $self->{w}, 0;
564 glVertex $self->{w}, $self->{h};
565 glVertex 0 , $self->{h};
566 glEnd;
567 glDisable GL_BLEND;
568 }
569
570 if ($ENV{CFPLUS_DEBUG} & 1) {
571 glPushMatrix;
572 glColor 1, 1, 0, 1;
573 glTranslate 0.375, 0.375;
574 glBegin GL_LINE_LOOP;
575 glVertex 0 , 0;
576 glVertex $self->{w} - 1, 0;
577 glVertex $self->{w} - 1, $self->{h} - 1;
578 glVertex 0 , $self->{h} - 1;
579 glEnd;
580 glPopMatrix;
581 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
582 }
583
584 $self->_draw;
585 glPopMatrix;
586}
587 623
588sub _draw { 624sub _draw {
589 my ($self) = @_; 625 my ($self) = @_;
590 626
591 warn "no draw defined for $self\n"; 627 warn "no draw defined for $self\n";
592} 628}
593 629
594sub DESTROY { 630sub DESTROY {
595 my ($self) = @_; 631 my ($self) = @_;
596 632
633 return if DC::in_destruct;
634
635 local $@;
636 eval { $self->destroy };
637 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
638
597 delete $WIDGET{$self+0}; 639 delete $WIDGET{$self+0};
598 #$self->deactivate;
599} 640}
600 641
601############################################################################# 642#############################################################################
602 643
603package CFClient::UI::DrawBG; 644package DC::UI::DrawBG;
604 645
605our @ISA = CFClient::UI::Base::; 646our @ISA = DC::UI::Base::;
606 647
607use strict; 648use common::sense;
649
608use CFClient::OpenGL; 650use DC::OpenGL;
609 651
610sub new { 652sub new {
611 my $class = shift; 653 my $class = shift;
612
613 # range [value, low, high, page]
614 654
615 $class->SUPER::new ( 655 $class->SUPER::new (
616 #bg => [0, 0, 0, 0.2], 656 #bg => [0, 0, 0, 0.2],
617 #active_bg => [1, 1, 1, 0.5], 657 #active_bg => [1, 1, 1, 0.5],
618 @_ 658 @_
619 ) 659 )
620} 660}
621 661
662sub set_bg {
663 my ($self, $bg) = @_;
664
665 $self->{bg} = $bg;
666 $self->update;
667}
668
622sub _draw { 669sub _draw {
623 my ($self) = @_; 670 my ($self) = @_;
624 671
625 my $color = $FOCUS == $self && $self->{active_bg} 672 my $color = $FOCUS == $self
626 ? $self->{active_bg} 673 ? $self->{active_bg} || $self->{bg}
627 : $self->{bg}; 674 : $self->{bg};
628 675
629 if ($color && (@$color < 4 || $color->[3])) { 676 if ($color && (@$color < 4 || $color->[3])) {
630 my ($w, $h) = @$self{qw(w h)}; 677 my ($w, $h) = @$self{qw(w h)};
631 678
632 glEnable GL_BLEND; 679 glEnable GL_BLEND;
633 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 680 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
634 glColor_premultiply @$color; 681 glColor_premultiply @$color;
635
636 glBegin GL_QUADS;
637 glVertex 0 , 0;
638 glVertex 0 , $h;
639 glVertex $w, $h; 682 glRect 0, 0, $w, $h;
640 glVertex $w, 0;
641 glEnd;
642
643 glDisable GL_BLEND; 683 glDisable GL_BLEND;
644 } 684 }
645} 685}
646 686
647############################################################################# 687#############################################################################
648 688
649package CFClient::UI::Empty; 689package DC::UI::Empty;
650 690
651our @ISA = CFClient::UI::Base::; 691our @ISA = DC::UI::Base::;
652 692
653sub new { 693sub new {
654 my ($class, %arg) = @_; 694 my ($class, %arg) = @_;
655 $class->SUPER::new (can_events => 0, %arg); 695 $class->SUPER::new (can_events => 0, %arg);
656} 696}
… …
663 703
664sub draw { } 704sub draw { }
665 705
666############################################################################# 706#############################################################################
667 707
668package CFClient::UI::Container; 708package DC::UI::Container;
669 709
670our @ISA = CFClient::UI::Base::; 710our @ISA = DC::UI::Base::;
671 711
672sub new { 712sub new {
673 my ($class, %arg) = @_; 713 my ($class, %arg) = @_;
674 714
675 my $children = delete $arg{children}; 715 my $children = delete $arg{children};
… …
679 can_events => 0, 719 can_events => 0,
680 %arg, 720 %arg,
681 ); 721 );
682 722
683 $self->add (@$children) 723 $self->add (@$children)
684 if $children; 724 if $children && @$children;
685 725
686 $self 726 $self
727}
728
729sub realloc {
730 my ($self) = @_;
731
732 $self->{force_realloc} = 1;
733 $self->{force_size_alloc} = 1;
734 $self->SUPER::realloc;
687} 735}
688 736
689sub add { 737sub add {
690 my ($self, @widgets) = @_; 738 my ($self, @widgets) = @_;
691 739
692 $_->set_parent ($self) 740 $_->set_parent ($self)
693 for @widgets; 741 for @widgets;
694 742
743 # TODO: only do this in widgets that need it, e.g. root, fixed
695 use sort 'stable'; 744 use sort 'stable';
696 745
697 $self->{children} = [ 746 $self->{children} = [
698 sort { $a->{z} <=> $b->{z} } 747 sort { $a->{z} <=> $b->{z} }
699 @{$self->{children}}, @widgets 748 @{$self->{children}}, @widgets
700 ]; 749 ];
701 750
702 $self->realloc; 751 $self->realloc;
752
753 $self->emit (c_add => \@widgets);
754
755 map $_+0, @widgets
703} 756}
704 757
705sub children { 758sub children {
706 @{ $_[0]{children} } 759 @{ $_[0]{children} }
707} 760}
708 761
709sub remove { 762sub remove {
710 my ($self, $child) = @_; 763 my ($self, @widgets) = @_;
711 764
765 $self->emit (c_remove => \@widgets);
766
767 for my $child (@widgets) {
712 delete $child->{parent}; 768 delete $child->{parent};
713 $child->hide; 769 $child->hide;
714
715 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 770 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
771 }
716 772
717 $self->realloc; 773 $self->realloc;
718} 774}
719 775
720sub clear { 776sub clear {
721 my ($self) = @_; 777 my ($self) = @_;
722 778
723 my $children = delete $self->{children}; 779 my $children = $self->{children};
724 $self->{children} = []; 780 $self->{children} = [];
725 781
726 for (@$children) { 782 for (@$children) {
727 delete $_->{parent}; 783 delete $_->{parent};
728 $_->hide; 784 $_->hide;
… …
748} 804}
749 805
750sub _draw { 806sub _draw {
751 my ($self) = @_; 807 my ($self) = @_;
752 808
753 $_->draw for @{$self->{children}}; 809 $_->draw for $self->visible_children;
754} 810}
755 811
756############################################################################# 812#############################################################################
757 813
758package CFClient::UI::Bin; 814package DC::UI::Bin;
759 815
760our @ISA = CFClient::UI::Container::; 816our @ISA = DC::UI::Container::;
761 817
762sub new { 818sub new {
763 my ($class, %arg) = @_; 819 my ($class, %arg) = @_;
764 820
765 my $child = (delete $arg{child}) || new CFClient::UI::Empty::; 821 my $child = (delete $arg{child}) || new DC::UI::Empty::;
766 822
767 $class->SUPER::new (children => [$child], %arg) 823 $class->SUPER::new (children => [$child], %arg)
768} 824}
769 825
770sub add { 826sub add {
771 my ($self, $child) = @_; 827 my ($self, $child) = @_;
772 828
773 $self->{children} = []; 829 $self->clear;
774
775 $self->SUPER::add ($child); 830 $self->SUPER::add ($child);
776} 831}
777 832
778sub remove { 833sub remove {
779 my ($self, $widget) = @_; 834 my ($self, $widget) = @_;
780 835
781 $self->SUPER::remove ($widget); 836 $self->SUPER::remove ($widget);
782 837
783 $self->{children} = [new CFClient::UI::Empty] 838 $self->{children} = [new DC::UI::Empty]
784 unless @{$self->{children}}; 839 unless @{$self->{children}};
785} 840}
786 841
787sub child { $_[0]->{children}[0] } 842sub child { $_[0]->{children}[0] }
788 843
789sub size_request { 844sub size_request {
790 $_[0]{children}[0]->size_request 845 $_[0]{children}[0]->size_request
791} 846}
792 847
793sub size_allocate { 848sub invoke_size_allocate {
794 my ($self, $w, $h) = @_; 849 my ($self, $w, $h) = @_;
795 850
796 $self->{children}[0]->configure (0, 0, $w, $h); 851 $self->{children}[0]->configure (0, 0, $w, $h);
852
853 1
797} 854}
798 855
799############################################################################# 856#############################################################################
800
801# back-buffered drawing area 857# back-buffered drawing area
802 858
803package CFClient::UI::Window; 859package DC::UI::Window;
804 860
805our @ISA = CFClient::UI::Bin::; 861our @ISA = DC::UI::Bin::;
806 862
807use CFClient::OpenGL; 863use DC::OpenGL;
808 864
809sub new { 865sub new {
810 my ($class, %arg) = @_; 866 my ($class, %arg) = @_;
811 867
812 my $self = $class->SUPER::new (%arg); 868 my $self = $class->SUPER::new (%arg);
… …
817 873
818 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 874 $ROOT->on_post_alloc ($self => sub { $self->render_child });
819 $self->SUPER::update; 875 $self->SUPER::update;
820} 876}
821 877
822sub size_allocate { 878sub invoke_size_allocate {
823 my ($self, $w, $h) = @_; 879 my ($self, $w, $h) = @_;
824 880
825 $self->SUPER::size_allocate ($w, $h);
826 $self->update; 881 $self->update;
882
883 $self->SUPER::invoke_size_allocate ($w, $h)
827} 884}
828 885
829sub _render { 886sub _render {
830 my ($self) = @_; 887 my ($self) = @_;
831 888
… …
833} 890}
834 891
835sub render_child { 892sub render_child {
836 my ($self) = @_; 893 my ($self) = @_;
837 894
838 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 895 $self->{texture} = new_from_opengl DC::Texture $self->{w}, $self->{h}, sub {
839 glClearColor 0, 0, 0, 0; 896 glClearColor 0, 0, 0, 0;
840 glClear GL_COLOR_BUFFER_BIT; 897 glClear GL_COLOR_BUFFER_BIT;
841 898
842 { 899 {
843 package CFClient::UI::Base; 900 package DC::UI::Base;
844 901
845 ($draw_x, $draw_y, $draw_w, $draw_h) = 902 local ($draw_x, $draw_y, $draw_w, $draw_h) =
846 (0, 0, $self->{w}, $self->{h}); 903 (0, 0, $self->{w}, $self->{h});
904
905 $self->_render;
847 } 906 }
848
849 $self->_render;
850 }; 907 };
851} 908}
852 909
853sub _draw { 910sub _draw {
854 my ($self) = @_; 911 my ($self) = @_;
855
856 my ($w, $h) = @$self{qw(w h)};
857 912
858 my $tex = $self->{texture} 913 my $tex = $self->{texture}
859 or return; 914 or return;
860 915
861 glEnable GL_TEXTURE_2D; 916 glEnable GL_TEXTURE_2D;
862 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 917 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
863 glColor 0, 0, 0, 1; 918 glColor 0, 0, 0, 1;
864 919
865 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h); 920 $tex->draw_quad_alpha_premultiplied (0, 0);
866 921
867 glDisable GL_TEXTURE_2D; 922 glDisable GL_TEXTURE_2D;
868} 923}
869 924
870############################################################################# 925#############################################################################
871 926
872package CFClient::UI::ViewPort; 927package DC::UI::ViewPort;
873 928
929use List::Util qw(min max);
930
874our @ISA = CFClient::UI::Window::; 931our @ISA = DC::UI::Window::;
875 932
876sub new { 933sub new {
877 my $class = shift; 934 my $class = shift;
878 935
879 $class->SUPER::new ( 936 $class->SUPER::new (
… …
886sub size_request { 943sub size_request {
887 my ($self) = @_; 944 my ($self) = @_;
888 945
889 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 946 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
890 947
891 $w = 10 if $self->{scroll_x}; 948 $w = 1 if $self->{scroll_x};
892 $h = 10 if $self->{scroll_y}; 949 $h = 1 if $self->{scroll_y};
893 950
894 ($w, $h) 951 ($w, $h)
895} 952}
896 953
897sub size_allocate { 954sub invoke_size_allocate {
898 my ($self, $w, $h) = @_; 955 my ($self, $w, $h) = @_;
899 956
900 my $child = $self->child; 957 my $child = $self->child;
901 958
902 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w}; 959 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
903 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h}; 960 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
904 961
905 $self->child->configure (0, 0, $w, $h); 962 $self->child->configure (0, 0, $w, $h);
906 $self->update; 963 $self->update;
964
965 1
907} 966}
908 967
909sub set_offset { 968sub set_offset {
910 my ($self, $x, $y) = @_; 969 my ($self, $x, $y) = @_;
911 970
971 my $x = max 0, min $self->child->{w} - $self->{w}, int $x;
972 my $y = max 0, min $self->child->{h} - $self->{h}, int $y;
973
974 if ($x != $self->{view_x} or $y != $self->{view_y}) {
912 $self->{view_x} = int $x; 975 $self->{view_x} = $x;
913 $self->{view_y} = int $y; 976 $self->{view_y} = $y;
914 977
978 $self->emit (changed => $x, $y);
915 $self->update; 979 $self->update;
980 }
981}
982
983sub set_center {
984 my ($self, $x, $y) = @_;
985
986 $self->set_offset ($x - $self->{w} * .5, $y - $self->{h} * .5);
987}
988
989sub make_visible {
990 my ($self, $x, $y, $border) = @_;
991
992 if ( $x < $self->{view_x} + $self->{w} * $border
993 || $x > $self->{view_x} + $self->{w} * (1 - $border)
994 || $y < $self->{view_y} + $self->{h} * $border
995 || $y > $self->{view_y} + $self->{h} * (1 - $border)
996 ) {
997 $self->set_center ($x, $y);
998 }
916} 999}
917 1000
918# hmm, this does not work for topleft of $self... but we should not ask for that 1001# hmm, this does not work for topleft of $self... but we should not ask for that
919sub coord2local { 1002sub coord2local {
920 my ($self, $x, $y) = @_; 1003 my ($self, $x, $y) = @_;
… …
935 my ($self, $x, $y) = @_; 1018 my ($self, $x, $y) = @_;
936 1019
937 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w} 1020 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
938 && $y >= $self->{y} && $y < $self->{y} + $self->{h} 1021 && $y >= $self->{y} && $y < $self->{y} + $self->{h}
939 ) { 1022 ) {
940 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y}) 1023 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
941 } else { 1024 } else {
942 $self->CFClient::UI::Base::find_widget ($x, $y) 1025 $self->DC::UI::Base::find_widget ($x, $y)
943 } 1026 }
944} 1027}
945 1028
946sub _render { 1029sub _render {
947 my ($self) = @_; 1030 my ($self) = @_;
948 1031
949 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x}; 1032 local $DC::UI::Base::draw_x = $DC::UI::Base::draw_x - $self->{view_x};
950 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y}; 1033 local $DC::UI::Base::draw_y = $DC::UI::Base::draw_y - $self->{view_y};
951 1034
952 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 1035 DC::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
953 1036
954 $self->SUPER::_render; 1037 $self->SUPER::_render;
955} 1038}
956 1039
957############################################################################# 1040#############################################################################
958 1041
959package CFClient::UI::ScrolledWindow; 1042package DC::UI::ScrolledWindow;
960 1043
961our @ISA = CFClient::UI::HBox::; 1044our @ISA = DC::UI::Table::;
962 1045
963sub new { 1046sub new {
964 my ($class, %arg) = @_; 1047 my ($class, %arg) = @_;
965 1048
966 my $child = delete $arg{child}; 1049 my $child = delete $arg{child};
967 1050
968 my $self; 1051 my $self;
969 1052
970 my $slider = new CFClient::UI::Slider 1053 my $hslider = new DC::UI::Slider
1054 c_col => 0,
1055 c_row => 1,
1056 vertical => 0,
1057 range => [0, 0, 1, 0.01], # HACK fix
1058 on_changed => sub {
1059 $self->{hpos} = $_[1];
1060 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
1061 },
1062 ;
1063
1064 my $vslider = new DC::UI::Slider
1065 c_col => 1,
1066 c_row => 0,
971 vertical => 1, 1067 vertical => 1,
972 range => [0, 0, 1, 0.01], # HACK fix 1068 range => [0, 0, 1, 0.01], # HACK fix
973 on_changed => sub { 1069 on_changed => sub {
974 $self->{vp}->set_offset (0, $_[1]); 1070 $self->{vpos} = $_[1];
1071 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
975 }, 1072 },
976 ; 1073 ;
977 1074
978 $self = $class->SUPER::new ( 1075 $self = $class->SUPER::new (
979 vp => (new CFClient::UI::ViewPort expand => 1), 1076 scroll_x => 0,
1077 scroll_y => 1,
1078 can_events => 1,
980 slider => $slider, 1079 hslider => $hslider,
1080 vslider => $vslider,
1081 col_expand => [1, 0],
1082 row_expand => [1, 0],
981 %arg, 1083 %arg,
982 ); 1084 );
983 1085
1086 $self->{vp} = new DC::UI::ViewPort
1087 c_col => 0,
1088 c_row => 0,
1089 expand => 1,
1090 scroll_x => $self->{scroll_x},
1091 scroll_y => $self->{scroll_y},
1092 on_changed => sub {
1093 my ($vp, $x, $y) = @_;
1094
1095 $vp->{parent}{hslider}->set_value ($x);
1096 $vp->{parent}{vslider}->set_value ($y);
1097
1098 0
1099 },
1100 on_size_allocate => sub {
1101 my ($vp, $w, $h) = @_;
1102 $vp->{parent}->update_slider;
1103 0
1104 },
1105 ;
1106
984 $self->SUPER::add ($self->{vp}, $self->{slider}); 1107 $self->SUPER::add ($self->{vp});
1108
985 $self->add ($child) if $child; 1109 $self->add ($child) if $child;
986 1110
987 $self 1111 $self
988} 1112}
989 1113
… …
991 my ($self, $widget) = @_; 1115 my ($self, $widget) = @_;
992 1116
993 $self->{vp}->add ($self->{child} = $widget); 1117 $self->{vp}->add ($self->{child} = $widget);
994} 1118}
995 1119
1120sub set_offset { shift->{vp}->set_offset (@_) }
1121sub set_center { shift->{vp}->set_center (@_) }
1122sub make_visible { shift->{vp}->make_visible (@_) }
1123
996sub update { 1124sub update_slider {
1125 my ($self) = @_;
1126
1127 my $child = ($self->{vp} or return)->child;
1128
1129 if ($self->{scroll_x}) {
1130 my ($w1, $w2) = ($child->{req_w}, $self->{vp}{w});
1131 $self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);
1132
1133 my $visible = $w1 > $w2;
1134 if ($visible != $self->{hslider_visible}) {
1135 $self->{hslider_visible} = $visible;
1136 $visible ? $self->SUPER::add ($self->{hslider})
1137 : $self->SUPER::remove ($self->{hslider});
1138 }
1139 }
1140
1141 if ($self->{scroll_y}) {
1142 my ($h1, $h2) = ($child->{req_h}, $self->{vp}{h});
1143 $self->{vslider}->set_range ([$self->{vslider}{range}[0], 0, $h1, $h2, 1]);
1144
1145 my $visible = $h1 > $h2;
1146 if ($visible != $self->{vslider_visible}) {
1147 $self->{vslider_visible} = $visible;
1148 $visible ? $self->SUPER::add ($self->{vslider})
1149 : $self->SUPER::remove ($self->{vslider});
1150 }
1151 }
1152}
1153
1154sub start_dragging {
997 my ($self) = @_; 1155 my ($self, $ev) = @_;
998 1156
999 $self->SUPER::update; 1157 $self->grab_focus;
1000 1158
1001 # todo: overwrite size_allocate of child 1159 my $ox = $self->{vp}{view_x};
1002 my $child = $self->{vp}->child; 1160 my $oy = $self->{vp}{view_y};
1003 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); 1161
1004} 1162 $self->{motion} = sub {
1163 my ($ev, $x, $y) = @_;
1005 1164
1165 $ox -= $ev->{xrel};
1166 $oy -= $ev->{yrel};
1167
1168 $self->{vp}->set_offset ($ox, $oy);
1169 };
1170}
1171
1172sub invoke_mouse_wheel {
1173 my ($self, $ev) = @_;
1174
1175 $self->{vslider}->emit (mouse_wheel => $ev) if $self->{vslider_visible};
1176 $self->{hslider}->emit (mouse_wheel => $ev) if $self->{hslider_visible};
1177
1178 1
1179}
1180
1181sub invoke_button_down {
1182 my ($self, $ev, $x, $y) = @_;
1183
1184 if ($ev->{button} == 2) {
1185 $self->start_dragging ($ev);
1186 return 1;
1187 }
1188
1189 0
1190}
1191
1192sub invoke_button_up {
1193 my ($self, $ev, $x, $y) = @_;
1194
1195 if (delete $self->{motion}) {
1196 return 1;
1197 }
1198
1199 0
1200}
1201
1202sub invoke_mouse_motion {
1203 my ($self, $ev, $x, $y) = @_;
1204
1205 if ($self->{motion}) {
1206 $self->{motion}->($ev, $x, $y);
1207 return 1;
1208 }
1209
1210 0
1211}
1212
1006sub size_allocate { 1213sub invoke_size_allocate {
1007 my ($self, $w, $h) = @_; 1214 my ($self, $w, $h) = @_;
1008 1215
1216 $self->update_slider;
1009 $self->SUPER::size_allocate ($w, $h); 1217 $self->SUPER::invoke_size_allocate ($w, $h)
1010
1011 my $child = $self->{vp}->child;
1012 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1013} 1218}
1014
1015#TODO# update range on size_allocate depending on child
1016# update viewport offset on scroll
1017 1219
1018############################################################################# 1220#############################################################################
1019 1221
1020package CFClient::UI::Frame; 1222package DC::UI::Frame;
1021 1223
1022our @ISA = CFClient::UI::Bin::; 1224our @ISA = DC::UI::Bin::;
1023 1225
1024use CFClient::OpenGL; 1226use DC::OpenGL;
1025 1227
1026sub new { 1228sub new {
1027 my $class = shift; 1229 my $class = shift;
1028 1230
1029 $class->SUPER::new ( 1231 $class->SUPER::new (
… …
1039 my ($w, $h) = @$self{qw(w h)}; 1241 my ($w, $h) = @$self{qw(w h)};
1040 1242
1041 glEnable GL_BLEND; 1243 glEnable GL_BLEND;
1042 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 1244 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1043 glColor_premultiply @{ $self->{bg} }; 1245 glColor_premultiply @{ $self->{bg} };
1044
1045 glBegin GL_QUADS;
1046 glVertex 0 , 0;
1047 glVertex 0 , $h;
1048 glVertex $w, $h; 1246 glRect 0, 0, $w, $h;
1049 glVertex $w, 0;
1050 glEnd;
1051
1052 glDisable GL_BLEND; 1247 glDisable GL_BLEND;
1053 } 1248 }
1054 1249
1055 $self->SUPER::_draw; 1250 $self->SUPER::_draw;
1056} 1251}
1057 1252
1058############################################################################# 1253#############################################################################
1059 1254
1060package CFClient::UI::FancyFrame; 1255package DC::UI::FancyFrame;
1061 1256
1062our @ISA = CFClient::UI::Bin::; 1257our @ISA = DC::UI::Bin::;
1063 1258
1064use CFClient::OpenGL; 1259use DC::OpenGL;
1065
1066my $bg =
1067 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1068 mipmap => 1, wrap => 1;
1069
1070my @border =
1071 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1072 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1073 1260
1074sub new { 1261sub new {
1075 my ($class, %arg) = @_; 1262 my ($class, %arg) = @_;
1076 1263
1077 my $title = delete $arg{title}; 1264 if ((exists $arg{label}) && !ref $arg{label}) {
1265 $arg{label} = new DC::UI::Label
1266 align => 1,
1267 valign => 0.5,
1268 text => $arg{label},
1269 fontsize => ($arg{border} || 0.8) * 0.75;
1270 }
1078 1271
1079 my $self = $class->SUPER::new ( 1272 my $self = $class->SUPER::new (
1080 bg => [1, 1, 1, 1], 1273 # label => "",
1081 border_bg => [1, 1, 1, 1], 1274 fg => undef,
1082 border => 0.6, 1275 border => 0.8,
1083 can_events => 1, 1276 style => 'single',
1084 min_w => 16,
1085 min_h => 16,
1086 %arg, 1277 %arg,
1087 ); 1278 );
1088 1279
1089 $self->{title} = new CFClient::UI::Label
1090 align => 0,
1091 valign => 1,
1092 text => $title,
1093 fontsize => $self->{border}
1094 if defined $title;
1095
1096 $self 1280 $self
1097} 1281}
1098 1282
1099sub add { 1283sub add {
1100 my ($self, @widgets) = @_; 1284 my ($self, @widgets) = @_;
1101 1285
1102 $self->SUPER::add (@widgets); 1286 $self->SUPER::add (@widgets);
1103 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title}; 1287 $self->DC::UI::Container::add ($self->{label}) if $self->{label};
1104} 1288}
1105 1289
1106sub border { 1290sub border {
1107 int $_[0]{border} * $::FONTSIZE 1291 int $_[0]{border} * $::FONTSIZE
1108} 1292}
1109 1293
1110sub size_request { 1294sub size_request {
1111 my ($self) = @_; 1295 my ($self) = @_;
1112 1296
1113 $self->{title}->size_request 1297 ($self->{label_w}, undef) = $self->{label}->size_request
1114 if $self->{title}; 1298 if $self->{label};
1115 1299
1116 my ($w, $h) = $self->SUPER::size_request; 1300 my ($w, $h) = $self->SUPER::size_request;
1117 1301
1118 ( 1302 (
1119 $w + $self->border * 2, 1303 $w + $self->border * 2,
1120 $h + $self->border * 2, 1304 $h + $self->border * 2,
1121 ) 1305 )
1122} 1306}
1123 1307
1124sub size_allocate { 1308sub invoke_size_allocate {
1125 my ($self, $w, $h) = @_; 1309 my ($self, $w, $h) = @_;
1126 1310
1311 my $border = $self->border;
1312
1313 $w -= List::Util::max 0, $border * 2;
1314 $h -= List::Util::max 0, $border * 2;
1315
1316 if (my $label = $self->{label}) {
1317 $label->{w} = List::Util::max 0, List::Util::min $self->{label_w}, $w - $border * 2;
1318 $label->{h} = List::Util::min $h, $border;
1319 $label->invoke_size_allocate ($label->{w}, $label->{h});
1320 }
1321
1322 $self->child->configure ($border, $border, $w, $h);
1323
1324 1
1325}
1326
1327sub _draw {
1328 my ($self) = @_;
1329
1330 my $child = $self->{children}[0];
1331
1332 my $border = $self->border;
1333 my ($w, $h) = ($self->{w}, $self->{h});
1334
1335 $child->draw;
1336
1337 glColor @{$self->{fg} || $DC::THEME{fancyframe}};
1338 glBegin GL_LINE_STRIP;
1339 glVertex $border * 1.5 , $border * 0.5 + 0.5;
1340 glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5;
1341 glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
1342 glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
1343 glVertex $w - $border * 0.5 + 0.5, $border * 0.5 + 0.5;
1344 glVertex $self->{label} ? $border * 2 + $self->{label}{w} : $border * 1.5, $border * 0.5 + 0.5;
1345 glEnd;
1346
1127 if ($self->{title}) { 1347 if ($self->{label}) {
1348 glTranslate $border * 2, 0;
1349 $self->{label}->_draw;
1350 }
1351}
1352
1353#############################################################################
1354
1355package DC::UI::Toplevel;
1356
1357our @ISA = DC::UI::Bin::;
1358
1359use DC::OpenGL;
1360
1361my $bg =
1362 new_from_resource DC::Texture "d1_bg.png",
1363 mipmap => 1, wrap => 1;
1364
1365my @border =
1366 map { new_from_resource DC::Texture $_, mipmap => 1 }
1367 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1368
1369my @icon =
1370 map { new_from_resource DC::Texture $_, mipmap => 1 }
1371 qw(x1_move.png x1_resize.png);
1372
1373sub new {
1374 my ($class, %arg) = @_;
1375
1376 my $self = $class->SUPER::new (
1377 bg => [1, 1, 1, 1],
1378 border_bg => [1, 1, 1, 1],
1379 border => 0.8,
1380 can_events => 1,
1381 min_w => 64,
1382 min_h => 32,
1383 %arg,
1384 );
1385
1386 $self->{title_widget} = new DC::UI::Label
1387 align => 0.5,
1388 valign => 1,
1389 text => $self->{title},
1390 fontsize => $self->{border},
1391 if exists $self->{title};
1392
1393 if ($self->{has_close_button}) {
1394 $self->{close_button} =
1395 new DC::UI::ImageButton
1396 path => 'x1_close.png',
1397 on_activate => sub { $self->emit ("delete") };
1398
1399 $self->DC::UI::Container::add ($self->{close_button});
1400 }
1401
1402 $self
1403}
1404
1405sub add {
1406 my ($self, @widgets) = @_;
1407
1408 $self->SUPER::add (@widgets);
1409 $self->DC::UI::Container::add ($self->{close_button}) if $self->{close_button};
1410 $self->DC::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1411}
1412
1413sub border {
1414 int $_[0]{border} * $::FONTSIZE
1415}
1416
1417sub get_max_wh {
1418 my ($self) = @_;
1419
1420 return ($self->{w}, $self->{h})
1421 if $self->{visible} && $self->{w};
1422
1423 $self->SUPER::get_max_wh
1424}
1425
1426sub size_request {
1427 my ($self) = @_;
1428
1429 $self->{title_widget}->size_request
1430 if $self->{title_widget};
1431
1432 $self->{close_button}->size_request
1433 if $self->{close_button};
1434
1435 my ($w, $h) = $self->SUPER::size_request;
1436
1437 (
1438 $w + $self->border * 2,
1439 $h + $self->border * 2,
1440 )
1441}
1442
1443sub invoke_size_allocate {
1444 my ($self, $w, $h) = @_;
1445
1446 if ($self->{title_widget}) {
1128 $self->{title}{w} = $w; 1447 $self->{title_widget}{w} = $w;
1129 $self->{title}{h} = $h; 1448 $self->{title_widget}{h} = $h;
1130 $self->{title}->size_allocate ($w, $h); 1449 $self->{title_widget}->invoke_size_allocate ($w, $h);
1131 } 1450 }
1132 1451
1133 my $border = $self->border; 1452 my $border = $self->border;
1134 1453
1135 $h -= List::Util::max 0, $border * 2; 1454 $h -= List::Util::max 0, $border * 2;
1136 $w -= List::Util::max 0, $border * 2; 1455 $w -= List::Util::max 0, $border * 2;
1456
1457 $self->child->configure ($border, $border, $w, $h);
1458
1459 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1460 if $self->{close_button};
1461
1462 1
1463}
1464
1465sub invoke_delete {
1466 my ($self) = @_;
1467
1468 $self->hide;
1137 1469
1138 $self->child->configure ($border, $border, $w, $h); 1470 1
1139} 1471}
1140 1472
1141sub button_down { 1473sub invoke_button_down {
1142 my ($self, $ev, $x, $y) = @_; 1474 my ($self, $ev, $x, $y) = @_;
1143 1475
1144 my ($w, $h) = @$self{qw(w h)}; 1476 my ($w, $h) = @$self{qw(w h)};
1145 my $border = $self->border; 1477 my $border = $self->border;
1146 1478
… …
1177 1509
1178 ($x, $y) = ($ev->{x}, $ev->{y}); 1510 ($x, $y) = ($ev->{x}, $ev->{y});
1179 1511
1180 $self->move_abs ($bx + $x - $ox, $by + $y - $oy); 1512 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1181 # HACK: the next line is required to enforce placement 1513 # HACK: the next line is required to enforce placement
1182 $self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h}); 1514 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1183 }; 1515 };
1184 } else { 1516 } else {
1185 return 0; 1517 return 0;
1186 } 1518 }
1187 1519
1188 1 1520 1
1189} 1521}
1190 1522
1191sub button_up { 1523sub invoke_button_up {
1192 my ($self, $ev, $x, $y) = @_; 1524 my ($self, $ev, $x, $y) = @_;
1193 1525
1194 !!delete $self->{motion} 1526 ! ! delete $self->{motion}
1195} 1527}
1196 1528
1197sub mouse_motion { 1529sub invoke_mouse_motion {
1198 my ($self, $ev, $x, $y) = @_; 1530 my ($self, $ev, $x, $y) = @_;
1199 1531
1200 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1532 $self->{motion}->($ev, $x, $y) if $self->{motion};
1201 1533
1202 !!$self->{motion} 1534 ! ! $self->{motion}
1535}
1536
1537sub invoke_visibility_change {
1538 my ($self, $visible) = @_;
1539
1540 delete $self->{motion} unless $visible;
1541
1542 0
1203} 1543}
1204 1544
1205sub _draw { 1545sub _draw {
1206 my ($self) = @_; 1546 my ($self) = @_;
1207 1547
… …
1213 glEnable GL_TEXTURE_2D; 1553 glEnable GL_TEXTURE_2D;
1214 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1554 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1215 1555
1216 my $border = $self->border; 1556 my $border = $self->border;
1217 1557
1558 if ($border) {
1218 glColor @{ $self->{border_bg} }; 1559 glColor @{ $self->{border_bg} };
1219 $border[0]->draw_quad_alpha (0, 0, $w, $border); 1560 $border[0]->draw_quad_alpha ( 0, 0, $w, $border);
1220 $border[1]->draw_quad_alpha (0, $border, $border, $ch); 1561 $border[1]->draw_quad_alpha ( 0, $border, $border, $ch);
1221 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1562 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1222 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border); 1563 $border[3]->draw_quad_alpha ( 0, $h - $border, $w, $border);
1564
1565 # move
1566 my $w2 = ($w - $border) * .5;
1567 my $h2 = ($h - $border) * .5;
1568 $icon[0]->draw_quad_alpha ( 0, $h2, $border, $border);
1569 $icon[0]->draw_quad_alpha ($w - $border, $h2, $border, $border);
1570 $icon[0]->draw_quad_alpha ($w2 , $h - $border, $border, $border);
1571
1572 # resize
1573 $icon[1]->draw_quad_alpha ( 0, 0, $border, $border);
1574 $icon[1]->draw_quad_alpha ($w - $border, 0, $border, $border)
1575 unless $self->{has_close_button};
1576 $icon[1]->draw_quad_alpha ( 0, $h - $border, $border, $border);
1577 $icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border);
1578 }
1223 1579
1224 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1580 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1225 glColor @{ $self->{bg} }; 1581 glColor @{ $self->{bg} };
1226 1582
1227 # TODO: repeat texture not scale 1583 # TODO: repeat texture not scale
… …
1233 1589
1234 glDisable GL_TEXTURE_2D; 1590 glDisable GL_TEXTURE_2D;
1235 1591
1236 $child->draw; 1592 $child->draw;
1237 1593
1238 if ($self->{title}) { 1594 if ($self->{title_widget}) {
1239 glTranslate 0, $border - $self->{h}; 1595 glTranslate 0, $border - $self->{h};
1240 $self->{title}->_draw; 1596 $self->{title_widget}->_draw;
1597
1598 glTranslate 0, - ($border - $self->{h});
1241 } 1599 }
1600
1601 $self->{close_button}->draw
1602 if $self->{close_button};
1242} 1603}
1243 1604
1244############################################################################# 1605#############################################################################
1245 1606
1246package CFClient::UI::Table; 1607package DC::UI::Table;
1247 1608
1248our @ISA = CFClient::UI::Base::; 1609our @ISA = DC::UI::Container::;
1249 1610
1250use List::Util qw(max sum); 1611use List::Util qw(max sum);
1251 1612
1252use CFClient::OpenGL; 1613use DC::OpenGL;
1253 1614
1254sub new { 1615sub new {
1255 my $class = shift; 1616 my $class = shift;
1256 1617
1257 $class->SUPER::new ( 1618 $class->SUPER::new (
1258 col_expand => [], 1619 col_expand => [],
1620 row_expand => [],
1259 @_, 1621 @_,
1260 ) 1622 )
1261} 1623}
1262 1624
1263sub children {
1264 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1265}
1266
1267sub add { 1625sub add {
1268 my ($self, $x, $y, $child) = @_;
1269
1270 $child->set_parent ($self);
1271 $self->{children}[$y][$x] = $child;
1272
1273 $self->realloc;
1274}
1275
1276# TODO: move to container class maybe? send children a signal on removal?
1277sub clear {
1278 my ($self) = @_; 1626 my ($self, @widgets) = @_;
1627
1628 for my $child (@widgets) {
1629 $child->{c_rowspan} ||= 1;
1630 $child->{c_colspan} ||= 1;
1631 }
1632
1633 $self->SUPER::add (@widgets);
1634}
1635
1636sub add_at {
1637 my $self = shift;
1638
1639 my @widgets;
1640
1641 while (@_) {
1642 my ($col, $row, $child) = splice @_, 0, 3, ();
1643
1644 $child->{c_row} = $row;
1645 $child->{c_col} = $col;
1646
1647 push @widgets, $child;
1648 }
1649
1650 $self->add (@widgets);
1651}
1652
1653sub get_wh {
1654 my ($self) = @_;
1655
1656 my (@w, @h);
1279 1657
1280 my @children = $self->children; 1658 my @children = $self->children;
1281 delete $self->{children}; 1659
1660 # first pass, columns
1661 for my $widget (sort { $a->{c_colspan} <=> $b->{c_colspan} } @children) {
1662 my ($c, $w, $cs) = @$widget{qw(c_col req_w c_colspan)};
1663
1664 my $sw = sum @w[$c .. $c + $cs - 1];
1665
1666 if ($w > $sw) {
1667 $_ += ($w - $sw) / ($_ ? $sw / $_ : $cs) for @w[$c .. $c + $cs - 1];
1668 }
1282 1669 }
1283 for (@children) {
1284 delete $_->{parent};
1285 $_->hide;
1286 }
1287 1670
1288 $self->realloc; 1671 # second pass, rows
1289} 1672 for my $widget (sort { $a->{c_rowspan} <=> $b->{c_rowspan} } @children) {
1290
1291sub get_wh {
1292 my ($self) = @_;
1293
1294 my (@w, @h);
1295
1296 for my $y (0 .. $#{$self->{children}}) {
1297 my $row = $self->{children}[$y]
1298 or next;
1299
1300 for my $x (0 .. $#$row) {
1301 my $widget = $row->[$x]
1302 or next;
1303 my ($w, $h) = @$widget{qw(req_w req_h)}; 1673 my ($r, $h, $rs) = @$widget{qw(c_row req_h c_rowspan)};
1304 1674
1305 $w[$x] = max $w[$x], $w; 1675 my $sh = sum @h[$r .. $r + $rs - 1];
1306 $h[$y] = max $h[$y], $h; 1676
1677 if ($h > $sh) {
1678 $_ += ($h - $sh) / ($_ ? $sh / $_ : $rs) for @h[$r .. $r + $rs - 1];
1307 } 1679 }
1308 } 1680 }
1309 1681
1310 (\@w, \@h) 1682 (\@w, \@h)
1311} 1683}
… …
1319 (sum @$ws), 1691 (sum @$ws),
1320 (sum @$hs), 1692 (sum @$hs),
1321 ) 1693 )
1322} 1694}
1323 1695
1324sub size_allocate { 1696sub invoke_size_allocate {
1325 my ($self, $w, $h) = @_; 1697 my ($self, $w, $h) = @_;
1326 1698
1327 my ($ws, $hs) = $self->get_wh; 1699 my ($ws, $hs) = $self->get_wh;
1328 1700
1329 my $req_w = (sum @$ws) || 1; 1701 my $req_w = (sum @$ws) || 1;
1330 my $req_h = (sum @$hs) || 1; 1702 my $req_h = (sum @$hs) || 1;
1331 1703
1332 # TODO: nicer code && do row_expand 1704 # now linearly scale the rows/columns to the allocated size
1333 my @col_expand = @{$self->{col_expand}}; 1705 my @col_expand = @{$self->{col_expand}};
1334 @col_expand = (1) x @$ws unless @col_expand; 1706 @col_expand = (1) x @$ws unless @col_expand;
1335 my $col_expand = (sum @col_expand) || 1; 1707 my $col_expand = (sum @col_expand) || 1;
1336 1708
1337 # linearly scale sizes
1338 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws; 1709 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1339 $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1340 1710
1341 CFClient::UI::harmonize $ws; 1711 DC::UI::harmonize $ws;
1712
1713 my @row_expand = @{$self->{row_expand}};
1714 @row_expand = (1) x @$ws unless @row_expand;
1715 my $row_expand = (sum @row_expand) || 1;
1716
1717 $hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs;
1718
1342 CFClient::UI::harmonize $hs; 1719 DC::UI::harmonize $hs;
1343 1720
1344 my $y; 1721 my @x; for (0 .. $#$ws) { $x[$_ + 1] = $x[$_] + $ws->[$_] }
1722 my @y; for (0 .. $#$hs) { $y[$_ + 1] = $y[$_] + $hs->[$_] }
1345 1723
1346 for my $r (0 .. $#{$self->{children}}) { 1724 for my $widget ($self->children) {
1347 my $row = $self->{children}[$r] 1725 my ($r, $c, $w, $h, $rs, $cs) = @$widget{qw(c_row c_col req_w req_h c_rowspan c_colspan)};
1348 or next;
1349 1726
1350 my $x = 0; 1727 $widget->configure (
1351 my $row_h = $hs->[$r]; 1728 $x[$c], $y[$r],
1729 $x[$c + $cs] - $x[$c], $y[$r + $rs] - $y[$r],
1352 1730 );
1353 for my $c (0 .. $#$row) { 1731 }
1354 my $col_w = $ws->[$c];
1355 1732
1356 if (my $widget = $row->[$c]) { 1733 1
1357 $widget->configure ($x, $y, $col_w, $row_h); 1734}
1358 }
1359 1735
1360 $x += $col_w; 1736#############################################################################
1737
1738package DC::UI::Fixed;
1739
1740use List::Util qw(min max);
1741
1742our @ISA = DC::UI::Container::;
1743
1744sub _scale($$$) {
1745 my ($rel, $val, $max) = @_;
1746
1747 $rel ? $val * $max : $val
1748}
1749
1750sub size_request {
1751 my ($self) = @_;
1752
1753 my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0);
1754
1755 # determine overall size by querying abs widgets
1756 for my $child ($self->visible_children) {
1757 unless ($child->{c_rel}) {
1758 my $x = $child->{c_x};
1759 my $y = $child->{c_y};
1760
1761 $x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
1762 $y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
1361 } 1763 }
1362
1363 $y += $row_h;
1364 } 1764 }
1365 1765
1366} 1766 my $W = $x2 - $x1;
1767 my $H = $y2 - $y1;
1367 1768
1368sub find_widget { 1769 # now layout remaining widgets
1770 for my $child ($self->visible_children) {
1771 if ($child->{c_rel}) {
1772 my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
1773 my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
1774
1775 $x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
1776 $y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
1777 }
1778 }
1779
1780 my $W = $x2 - $x1;
1781 my $H = $y2 - $y1;
1782
1783 ($W, $H)
1784}
1785
1786sub invoke_size_allocate {
1369 my ($self, $x, $y) = @_; 1787 my ($self, $W, $H) = @_;
1370 1788
1371 $x -= $self->{x}; 1789 for my $child ($self->visible_children) {
1372 $y -= $self->{y}; 1790 my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
1791 my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
1373 1792
1374 my $res; 1793 $x += $child->{c_halign} * $child->{req_w};
1794 $y += $child->{c_valign} * $child->{req_h};
1375 1795
1376 for (grep $_, map @$_, grep $_, @{ $self->{children} }) { 1796 $child->configure (int $x, int $y, $child->{req_w}, $child->{req_h});
1377 $res = $_->find_widget ($x, $y) 1797 }
1378 and return $res; 1798
1379 } 1799 1
1380
1381 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
1382}
1383
1384sub _draw {
1385 my ($self) = @_;
1386
1387 for (grep $_, @{$self->{children}}) {
1388 $_->draw for grep $_, @$_;
1389 }
1390} 1800}
1391 1801
1392############################################################################# 1802#############################################################################
1393 1803
1394package CFClient::UI::Box; 1804package DC::UI::Box;
1395 1805
1396our @ISA = CFClient::UI::Container::; 1806our @ISA = DC::UI::Container::;
1397 1807
1398sub size_request { 1808sub size_request {
1399 my ($self) = @_; 1809 my ($self) = @_;
1810
1811 my @children = $self->visible_children;
1400 1812
1401 $self->{vertical} 1813 $self->{vertical}
1402 ? ( 1814 ? (
1403 (List::Util::max map $_->{req_w}, @{$self->{children}}), 1815 (List::Util::max map $_->{req_w}, @children),
1404 (List::Util::sum map $_->{req_h}, @{$self->{children}}), 1816 (List::Util::sum map $_->{req_h}, @children),
1405 ) 1817 )
1406 : ( 1818 : (
1407 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1819 (List::Util::sum map $_->{req_w}, @children),
1408 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1820 (List::Util::max map $_->{req_h}, @children),
1409 ) 1821 )
1410} 1822}
1411 1823
1412sub size_allocate { 1824sub invoke_size_allocate {
1413 my ($self, $w, $h) = @_; 1825 my ($self, $w, $h) = @_;
1414 1826
1415 my $space = $self->{vertical} ? $h : $w; 1827 my $space = $self->{vertical} ? $h : $w;
1416 my $children = $self->{children}; 1828 my @children = $self->visible_children;
1417 1829
1418 my @req; 1830 my @req;
1419 1831
1420 if ($self->{homogeneous}) { 1832 if ($self->{homogeneous}) {
1421 @req = ($space / (@$children || 1)) x @$children; 1833 @req = ($space / (@children || 1)) x @children;
1422 } else { 1834 } else {
1423 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children; 1835 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1424 my $req = List::Util::sum @req; 1836 my $req = List::Util::sum @req;
1425 1837
1426 if ($req > $space) { 1838 if ($req > $space) {
1427 # ah well, not enough space 1839 # ah well, not enough space
1428 $_ *= $space / $req for @req; 1840 $_ *= $space / $req for @req;
1429 } else { 1841 } else {
1430 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1; 1842 my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1431 1843
1432 $space = ($space - $req) / $expand; # remaining space to give away 1844 $space = ($space - $req) / $expand; # remaining space to give away
1433 1845
1434 $req[$_] += $space * $children->[$_]{expand} 1846 $req[$_] += $space * $children[$_]{expand}
1435 for 0 .. $#$children; 1847 for 0 .. $#children;
1436 } 1848 }
1437 } 1849 }
1438 1850
1439 CFClient::UI::harmonize \@req; 1851 DC::UI::harmonize \@req;
1440 1852
1441 my $pos = 0; 1853 my $pos = 0;
1442 for (0 .. $#$children) { 1854 for (0 .. $#children) {
1443 my $alloc = $req[$_]; 1855 my $alloc = $req[$_];
1444 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1856 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1445 1857
1446 $pos += $alloc; 1858 $pos += $alloc;
1447 } 1859 }
1448 1860
1449 1 1861 1
1450} 1862}
1451 1863
1452############################################################################# 1864#############################################################################
1453 1865
1454package CFClient::UI::HBox; 1866package DC::UI::HBox;
1455 1867
1456our @ISA = CFClient::UI::Box::; 1868our @ISA = DC::UI::Box::;
1457 1869
1458sub new { 1870sub new {
1459 my $class = shift; 1871 my $class = shift;
1460 1872
1461 $class->SUPER::new ( 1873 $class->SUPER::new (
… …
1464 ) 1876 )
1465} 1877}
1466 1878
1467############################################################################# 1879#############################################################################
1468 1880
1469package CFClient::UI::VBox; 1881package DC::UI::VBox;
1470 1882
1471our @ISA = CFClient::UI::Box::; 1883our @ISA = DC::UI::Box::;
1472 1884
1473sub new { 1885sub new {
1474 my $class = shift; 1886 my $class = shift;
1475 1887
1476 $class->SUPER::new ( 1888 $class->SUPER::new (
… …
1479 ) 1891 )
1480} 1892}
1481 1893
1482############################################################################# 1894#############################################################################
1483 1895
1484package CFClient::UI::Label; 1896package DC::UI::Label;
1485 1897
1486our @ISA = CFClient::UI::DrawBG::; 1898our @ISA = DC::UI::DrawBG::;
1487 1899
1488use CFClient::OpenGL; 1900use DC::OpenGL;
1489 1901
1490sub new { 1902sub new {
1491 my ($class, %arg) = @_; 1903 my ($class, %arg) = @_;
1492 1904
1493 my $self = $class->SUPER::new ( 1905 my $self = $class->SUPER::new (
… …
1496 #active_bg => none 1908 #active_bg => none
1497 #font => default_font 1909 #font => default_font
1498 #text => initial text 1910 #text => initial text
1499 #markup => initial narkup 1911 #markup => initial narkup
1500 #max_w => maximum pixel width 1912 #max_w => maximum pixel width
1913 #style => 0, # render flags
1501 ellipsise => 3, # end 1914 ellipsise => 3, # end
1502 layout => (new CFClient::Layout), 1915 layout => (new DC::Layout),
1503 fontsize => 1, 1916 fontsize => 1,
1504 align => -1, 1917 align => 0.5,
1505 valign => -1, 1918 valign => 0.5,
1506 padding_x => 2, 1919 padding_x => 4,
1507 padding_y => 2, 1920 padding_y => 2,
1508 can_events => 0, 1921 can_events => 0,
1509 %arg 1922 %arg
1510 ); 1923 );
1511 1924
1512 if (exists $self->{template}) { 1925 if (exists $self->{template}) {
1513 my $layout = new CFClient::Layout; 1926 my $layout = new DC::Layout;
1514 $layout->set_text (delete $self->{template}); 1927 $layout->set_text (delete $self->{template});
1515 $self->{template} = $layout; 1928 $self->{template} = $layout;
1516 } 1929 }
1517 1930
1518 if (exists $self->{markup}) { 1931 if (exists $self->{markup}) {
… …
1522 } 1935 }
1523 1936
1524 $self 1937 $self
1525} 1938}
1526 1939
1527sub escape($) {
1528 local $_ = $_[0];
1529
1530 s/&/&amp;/g;
1531 s/>/&gt;/g;
1532 s/</&lt;/g;
1533
1534 $_
1535}
1536
1537sub update { 1940sub update {
1538 my ($self) = @_; 1941 my ($self) = @_;
1539 1942
1540 delete $self->{texture}; 1943 delete $self->{texture};
1541 $self->SUPER::update; 1944 $self->SUPER::update;
… …
1546 1949
1547 delete $self->{ox}; 1950 delete $self->{ox};
1548 $self->SUPER::realloc; 1951 $self->SUPER::realloc;
1549} 1952}
1550 1953
1954sub clear {
1955 my ($self) = @_;
1956
1957 $self->set_text ("");
1958}
1959
1551sub set_text { 1960sub set_text {
1552 my ($self, $text) = @_; 1961 my ($self, $text) = @_;
1553 1962
1554 return if $self->{text} eq "T$text"; 1963 return if $self->{text} eq "T$text";
1555 $self->{text} = "T$text"; 1964 $self->{text} = "T$text";
1556 1965
1557 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1558 $self->{layout}->set_text ($text); 1966 $self->{layout}->set_text ($text);
1559 1967
1560 delete $self->{size_req}; 1968 delete $self->{size_req};
1561 $self->realloc; 1969 $self->realloc;
1562 $self->update; 1970 $self->update;
… …
1568 return if $self->{text} eq "M$markup"; 1976 return if $self->{text} eq "M$markup";
1569 $self->{text} = "M$markup"; 1977 $self->{text} = "M$markup";
1570 1978
1571 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1979 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1572 1980
1573 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1574 $self->{layout}->set_markup ($markup); 1981 $self->{layout}->set_markup ($markup);
1575 1982
1576 delete $self->{size_req}; 1983 delete $self->{size_req};
1577 $self->realloc; 1984 $self->realloc;
1578 $self->update; 1985 $self->update;
… …
1580 1987
1581sub size_request { 1988sub size_request {
1582 my ($self) = @_; 1989 my ($self) = @_;
1583 1990
1584 $self->{size_req} ||= do { 1991 $self->{size_req} ||= do {
1992 my ($max_w, $max_h) = $self->get_max_wh;
1993
1585 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1994 $self->{layout}->set_font ($self->{font}) if $self->{font};
1586 $self->{layout}->set_width ($self->{max_w} || -1); 1995 $self->{layout}->set_width ($max_w);
1587 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1996 $self->{layout}->set_ellipsise ($self->{ellipsise});
1588 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1997 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1589 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1998 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1590 1999
1591 my ($w, $h) = $self->{layout}->size; 2000 my ($w, $h) = $self->{layout}->size;
1592 2001
1593 if (exists $self->{template}) { 2002 if (exists $self->{template}) {
1594 $self->{template}->set_font ($self->{font}) if $self->{font}; 2003 $self->{template}->set_font ($self->{font}) if $self->{font};
2004 $self->{template}->set_width ($max_w);
1595 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 2005 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1596 2006
1597 my ($w2, $h2) = $self->{template}->size; 2007 my ($w2, $h2) = $self->{template}->size;
1598 2008
1599 $w = List::Util::max $w, $w2; 2009 $w = List::Util::max $w, $w2;
… …
1604 }; 2014 };
1605 2015
1606 @{ $self->{size_req} } 2016 @{ $self->{size_req} }
1607} 2017}
1608 2018
2019sub baseline_shift {
2020 $_[0]{layout}->descent
2021}
2022
1609sub size_allocate { 2023sub invoke_size_allocate {
1610 my ($self, $w, $h) = @_; 2024 my ($self, $w, $h) = @_;
1611 2025
1612 delete $self->{ox}; 2026 delete $self->{ox};
1613 2027
1614 delete $self->{texture} 2028 delete $self->{texture}
1615 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w}; 2029 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
2030
2031 1
1616} 2032}
1617 2033
1618sub set_fontsize { 2034sub set_fontsize {
1619 my ($self, $fontsize) = @_; 2035 my ($self, $fontsize) = @_;
1620 2036
1621 $self->{fontsize} = $fontsize; 2037 $self->{fontsize} = $fontsize;
2038 delete $self->{size_req};
1622 delete $self->{texture}; 2039 delete $self->{texture};
1623 2040
1624 $self->realloc; 2041 $self->realloc;
1625} 2042}
1626 2043
1627sub reconfigure { 2044sub reconfigure {
1628 my ($self) = @_; 2045 my ($self) = @_;
1629 2046
1630 delete $self->{size_req}; 2047 delete $self->{size_req};
2048 delete $self->{texture};
1631 2049
1632 $self->SUPER::reconfigure; 2050 $self->SUPER::reconfigure;
1633} 2051}
1634 2052
1635sub _draw { 2053sub _draw {
1636 my ($self) = @_; 2054 my ($self) = @_;
1637 2055
1638 $self->SUPER::_draw; # draw background, if applicable 2056 $self->SUPER::_draw; # draw background, if applicable
1639 2057
1640 my $tex = $self->{texture} ||= do { 2058 my $size = $self->{texture} ||= do {
1641 $self->{layout}->set_foreground (@{$self->{fg}}); 2059 $self->{layout}->set_foreground (@{$self->{fg}});
1642 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2060 $self->{layout}->set_font ($self->{font}) if $self->{font};
1643 $self->{layout}->set_width ($self->{w}); 2061 $self->{layout}->set_width ($self->{w});
1644 $self->{layout}->set_ellipsise ($self->{ellipsise}); 2062 $self->{layout}->set_ellipsise ($self->{ellipsise});
1645 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 2063 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1646 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2064 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1647 2065
1648 new_from_layout CFClient::Texture $self->{layout} 2066 [$self->{layout}->size]
1649 }; 2067 };
1650 2068
1651 unless (exists $self->{ox}) { 2069 unless (exists $self->{ox}) {
1652 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} 2070 $self->{ox} = $self->{padding_x} + int $self->{align} * ($self->{w} - $size->[0] - $self->{padding_x} * 2);
1653 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x} 2071 $self->{oy} = $self->{padding_y} + int $self->{valign} * ($self->{h} - $size->[1] - $self->{padding_y} * 2);
1654 : ($self->{w} - $tex->{w}) * 0.5);
1655 2072
1656 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 2073 $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1657 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1658 : ($self->{h} - $tex->{h}) * 0.5);
1659 }; 2074 };
1660 2075
1661 glEnable GL_TEXTURE_2D; 2076# unless ($self->{list}) {
1662 2077# $self->{list} = DC::OpenGL::glGenList;
1663 my $w = List::Util::min $self->{w} + 4, $tex->{w}; 2078# DC::OpenGL::glNewList $self->{list};
1664 my $h = List::Util::min $self->{h} + 2, $tex->{h}; 2079# $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1665 2080# DC::OpenGL::glEndList;
1666 if ($tex->{format} == GL_ALPHA) {
1667 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1668 glColor @{$self->{fg}};
1669 $tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1670 } else {
1671 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1672 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1673 } 2081# }
2082#
2083# DC::OpenGL::glCallList $self->{list};
1674 2084
1675 glDisable GL_TEXTURE_2D; 2085 $self->{layout}->draw;
1676} 2086}
2087
2088#sub destroy {
2089# my ($self) = @_;
2090#
2091# DC::OpenGL::glDeleteList delete $self->{list} if $self->{list};
2092#
2093# $self->SUPER::destroy;
2094#}
1677 2095
1678############################################################################# 2096#############################################################################
1679 2097
1680package CFClient::UI::EntryBase; 2098package DC::UI::EntryBase;
1681 2099
1682our @ISA = CFClient::UI::Label::; 2100our @ISA = DC::UI::Label::;
1683 2101
1684use CFClient::OpenGL; 2102use DC::OpenGL;
1685 2103
1686sub new { 2104sub new {
1687 my $class = shift; 2105 my $class = shift;
1688 2106
1689 $class->SUPER::new ( 2107 $class->SUPER::new (
1690 fg => [1, 1, 1], 2108 fg => [1, 1, 1],
1691 bg => [0, 0, 0, 0.2], 2109 bg => [0, 0, 0, 0.2],
2110 outline => undef,
1692 active_bg => [1, 1, 1, 0.5], 2111 active_bg => [0, 0, 1, .2],
1693 active_fg => [0, 0, 0], 2112 active_fg => [1, 1, 1],
2113 active_outline => [1, 1, 0],
1694 can_hover => 1, 2114 can_hover => 1,
1695 can_focus => 1, 2115 can_focus => 1,
2116 align => 0,
1696 valign => 0, 2117 valign => 0.5,
1697 can_events => 1, 2118 can_events => 1,
2119 ellipsise => 0,
2120 padding_x => 4,
2121 padding_y => 2,
1698 #text => ... 2122 #text => ...
1699 #hidden => "*", 2123 #hidden => "*",
1700 @_ 2124 @_
1701 ) 2125 )
1702} 2126}
… …
1713 2137
1714 $text =~ s/./*/g if $self->{hidden}; 2138 $text =~ s/./*/g if $self->{hidden};
1715 $self->{layout}->set_text ("$text "); 2139 $self->{layout}->set_text ("$text ");
1716 delete $self->{size_req}; 2140 delete $self->{size_req};
1717 2141
1718 $self->_emit (changed => $self->{text}); 2142 $self->emit (changed => $self->{text});
1719 2143
1720 $self->realloc; 2144 $self->realloc;
1721 $self->update; 2145 $self->update;
1722} 2146}
1723 2147
… …
1738 my ($w, $h) = $self->SUPER::size_request; 2162 my ($w, $h) = $self->SUPER::size_request;
1739 2163
1740 ($w + 1, $h) # add 1 for cursor 2164 ($w + 1, $h) # add 1 for cursor
1741} 2165}
1742 2166
1743sub key_down { 2167sub invoke_key_down {
1744 my ($self, $ev) = @_; 2168 my ($self, $ev) = @_;
1745 2169
1746 my $mod = $ev->{mod}; 2170 my $mod = $ev->{mod};
1747 my $sym = $ev->{sym}; 2171 my $sym = $ev->{sym};
1748 my $uni = $ev->{unicode}; 2172 my $uni = $ev->{unicode};
1749 2173
1750 my $text = $self->get_text; 2174 my $text = $self->get_text;
1751 2175
1752 if ($uni == 8) { 2176 $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;
2177
2178 if ($sym == DC::SDLK_BACKSPACE) {
1753 substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; 2179 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1754 } elsif ($uni == 127) { 2180 } elsif ($sym == DC::SDLK_DELETE) {
1755 substr $text, $self->{cursor}, 1, ""; 2181 substr $text, $self->{cursor}, 1, "";
1756 } elsif ($sym == CFClient::SDLK_LEFT) { 2182 } elsif ($sym == DC::SDLK_LEFT) {
1757 --$self->{cursor} if $self->{cursor}; 2183 --$self->{cursor} if $self->{cursor};
1758 } elsif ($sym == CFClient::SDLK_RIGHT) { 2184 } elsif ($sym == DC::SDLK_RIGHT) {
1759 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 2185 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1760 } elsif ($sym == CFClient::SDLK_HOME) { 2186 } elsif ($sym == DC::SDLK_HOME) {
2187 # what a hack
2188 $self->{cursor} =
2189 (substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
2190 ? length $1
2191 : 0;
2192 } elsif ($sym == DC::SDLK_END) {
2193 # uh, again
2194 $self->{cursor} =
2195 (substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
2196 ? $self->{cursor} + length $1
2197 : length $self->{text};
2198 } elsif ($uni == 21) { # ctrl-u
2199 $text = "";
1761 $self->{cursor} = 0; 2200 $self->{cursor} = 0;
1762 } elsif ($sym == CFClient::SDLK_END) {
1763 $self->{cursor} = length $text;
1764 } elsif ($uni == 27) { 2201 } elsif ($uni == 27) {
1765 $self->_emit ('escape'); 2202 $self->emit ('escape');
1766 } elsif ($uni) { 2203 } elsif ($uni == 0x0d) {
2204 substr $text, $self->{cursor}++, 0, "\012";
2205 } elsif ($uni >= 0x20) {
1767 substr $text, $self->{cursor}++, 0, chr $uni; 2206 substr $text, $self->{cursor}++, 0, chr $uni;
1768 } else { 2207 } else {
1769 return 0; 2208 return 0;
1770 } 2209 }
1771 2210
1772 $self->_set_text ($text); 2211 $self->_set_text ($text);
1773 2212
1774 $self->realloc; 2213 $self->realloc;
2214 $self->update;
1775 2215
1776 1 2216 1
1777} 2217}
1778 2218
1779sub focus_in { 2219sub invoke_focus_in {
1780 my ($self) = @_; 2220 my ($self) = @_;
1781 2221
1782 $self->{last_activity} = $::NOW; 2222 $self->{last_activity} = $::NOW;
1783 2223
1784 $self->SUPER::focus_in; 2224 $self->SUPER::invoke_focus_in
1785} 2225}
1786 2226
1787sub button_down { 2227sub invoke_button_down {
1788 my ($self, $ev, $x, $y) = @_; 2228 my ($self, $ev, $x, $y) = @_;
1789 2229
1790 $self->SUPER::button_down ($ev, $x, $y); 2230 $self->SUPER::invoke_button_down ($ev, $x, $y);
1791 2231
1792 my $idx = $self->{layout}->xy_to_index ($x, $y); 2232 my $idx = $self->{layout}->xy_to_index ($x, $y);
1793 2233
1794 # byte-index to char-index 2234 # byte-index to char-index
1795 my $text = $self->{text}; 2235 my $text = $self->{text};
1796 utf8::encode $text; 2236 utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1797 $self->{cursor} = length substr $text, 0, $idx; 2237 $self->{cursor} = length $text;
1798 2238
1799 $self->_set_text ($self->{text}); 2239 $self->_set_text ($self->{text});
1800 $self->update; 2240 $self->update;
1801 2241
1802 1 2242 1
1803} 2243}
1804 2244
1805sub mouse_motion { 2245sub invoke_mouse_motion {
1806 my ($self, $ev, $x, $y) = @_; 2246 my ($self, $ev, $x, $y) = @_;
1807# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 2247# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1808 2248
1809 0 2249 1
1810} 2250}
1811 2251
1812sub _draw { 2252sub _draw {
1813 my ($self) = @_; 2253 my ($self) = @_;
1814 2254
… …
1821 glColor_premultiply @{$self->{bg}}; 2261 glColor_premultiply @{$self->{bg}};
1822 } 2262 }
1823 2263
1824 glEnable GL_BLEND; 2264 glEnable GL_BLEND;
1825 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2265 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1826 glBegin GL_QUADS;
1827 glVertex 0 , 0;
1828 glVertex 0 , $self->{h};
1829 glVertex $self->{w}, $self->{h}; 2266 glRect 0, 0, $self->{w}, $self->{h};
1830 glVertex $self->{w}, 0;
1831 glEnd;
1832 glDisable GL_BLEND; 2267 glDisable GL_BLEND;
1833 2268
1834 $self->SUPER::_draw; 2269 $self->SUPER::_draw;
1835 2270
1836 #TODO: force update every cursor change :( 2271 #TODO: force update every cursor change :(
… …
1838 2273
1839 unless (exists $self->{cur_h}) { 2274 unless (exists $self->{cur_h}) {
1840 my $text = substr $self->{text}, 0, $self->{cursor}; 2275 my $text = substr $self->{text}, 0, $self->{cursor};
1841 utf8::encode $text; 2276 utf8::encode $text;
1842 2277
1843 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text) 2278 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
1844 } 2279 }
1845 2280
1846 glColor @{$self->{fg}}; 2281 glColor_premultiply @{$self->{active_fg}};
1847 glBegin GL_LINES; 2282 glBegin GL_LINES;
1848 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy}; 2283 glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy};
1849 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h}; 2284 glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1850 glEnd; 2285 glEnd;
1851 }
1852}
1853 2286
2287 glLineWidth 3;
2288 glColor @{$self->{active_outline}};
2289 glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
2290 glLineWidth 1;
2291
2292 } else {
2293 glColor @{$self->{outline} || $DC::THEME{entry_outline}};
2294 glBegin GL_LINE_STRIP;
2295 glVertex .5, $self->{h} * .5;
2296 glVertex .5, $self->{h} - 2.5;
2297 glVertex $self->{w} - .5, $self->{h} - 2.5;
2298 glVertex $self->{w} - .5, $self->{h} * .5;
2299 glEnd;
2300 }
2301}
2302
2303#############################################################################
2304
1854package CFClient::UI::Entry; 2305package DC::UI::Entry;
1855 2306
1856our @ISA = CFClient::UI::EntryBase::; 2307our @ISA = DC::UI::EntryBase::;
1857 2308
1858use CFClient::OpenGL; 2309use DC::OpenGL;
1859 2310
2311sub new {
2312 my $class = shift;
2313
2314 $class->SUPER::new (
2315 history_pointer => -1,
2316 @_
2317 )
2318}
2319
2320
1860sub key_down { 2321sub invoke_key_down {
1861 my ($self, $ev) = @_; 2322 my ($self, $ev) = @_;
1862 2323
1863 my $sym = $ev->{sym}; 2324 my $sym = $ev->{sym};
1864 2325
1865 if ($sym == 13) { 2326 if ($ev->{uni} == 0x0d || $sym == 13) {
1866 unshift @{$self->{history}}, 2327 unshift @{$self->{history}},
1867 my $txt = $self->get_text; 2328 my $txt = $self->get_text;
2329
1868 $self->{history_pointer} = -1; 2330 $self->{history_pointer} = -1;
1869 $self->{history_saveback} = ''; 2331 $self->{history_saveback} = '';
1870 $self->_emit (activate => $txt); 2332 $self->emit (activate => $txt);
1871 $self->update; 2333 $self->update;
1872 2334
1873 } elsif ($sym == CFClient::SDLK_UP) { 2335 } elsif ($sym == DC::SDLK_UP) {
1874 if ($self->{history_pointer} < 0) { 2336 if ($self->{history_pointer} < 0) {
1875 $self->{history_saveback} = $self->get_text; 2337 $self->{history_saveback} = $self->get_text;
1876 } 2338 }
1877 if (@{$self->{history} || []} > 0) { 2339 if (@{$self->{history} || []} > 0) {
1878 $self->{history_pointer}++; 2340 $self->{history_pointer}++;
… …
1880 $self->{history_pointer} = @{$self->{history} || []} - 1; 2342 $self->{history_pointer} = @{$self->{history} || []} - 1;
1881 } 2343 }
1882 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2344 $self->set_text ($self->{history}->[$self->{history_pointer}]);
1883 } 2345 }
1884 2346
1885 } elsif ($sym == CFClient::SDLK_DOWN) { 2347 } elsif ($sym == DC::SDLK_DOWN) {
1886 $self->{history_pointer}--; 2348 $self->{history_pointer}--;
1887 $self->{history_pointer} = -1 if $self->{history_pointer} < 0; 2349 $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1888 2350
1889 if ($self->{history_pointer} >= 0) { 2351 if ($self->{history_pointer} >= 0) {
1890 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2352 $self->set_text ($self->{history}->[$self->{history_pointer}]);
1891 } else { 2353 } else {
2354 if (defined $self->{history_saveback}) {
1892 $self->set_text ($self->{history_saveback}); 2355 $self->set_text ($self->{history_saveback});
2356 $self->{history_saveback} = undef;
2357 }
1893 } 2358 }
1894 2359
1895 } else { 2360 } else {
1896 return $self->SUPER::key_down ($ev) 2361 return $self->SUPER::invoke_key_down ($ev)
1897 } 2362 }
1898 2363
1899 1 2364 1
1900} 2365}
1901 2366
1902############################################################################# 2367#############################################################################
1903 2368
1904package CFClient::UI::Button; 2369package DC::UI::TextEdit;
1905 2370
1906our @ISA = CFClient::UI::Label::; 2371our @ISA = DC::UI::EntryBase::;
1907 2372
1908use CFClient::OpenGL; 2373use DC::OpenGL;
1909
1910my @tex =
1911 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1912 qw(b1_button_active.png);
1913 2374
1914sub new { 2375sub new {
1915 my $class = shift; 2376 my $class = shift;
1916 2377
1917 $class->SUPER::new ( 2378 $class->SUPER::new (
1918 padding_x => 4,
1919 padding_y => 4, 2379 padding_y => 4,
1920 fg => [1, 1, 1], 2380
1921 active_fg => [0, 0, 1], 2381 @_
2382 )
2383}
2384
2385sub move_cursor_ver {
2386 my ($self, $dy) = @_;
2387
2388 my ($line, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
2389
2390 $line += $dy;
2391
2392 if (defined (my $index = $self->{layout}->line_x_to_index ($line, $x))) {
2393 $self->{cursor} = $index;
2394 delete $self->{cur_h};
2395 $self->update;
2396 return;
2397 }
2398}
2399
2400sub invoke_key_down {
2401 my ($self, $ev) = @_;
2402
2403 my $sym = $ev->{sym};
2404
2405 if ($sym == DC::SDLK_UP) {
2406 $self->move_cursor_ver (-1);
2407 } elsif ($sym == DC::SDLK_DOWN) {
2408 $self->move_cursor_ver (+1);
2409 } else {
2410 return $self->SUPER::invoke_key_down ($ev)
2411 }
2412
2413 1
2414}
2415
2416#############################################################################
2417
2418package DC::UI::ButtonBin;
2419
2420our @ISA = DC::UI::Bin::;
2421
2422use DC::OpenGL;
2423
2424my @tex =
2425 map { new_from_resource DC::Texture $_, mipmap => 1 }
2426 qw(b1_button_inactive.png b1_button_active.png);
2427
2428sub new {
2429 my $class = shift;
2430
2431 $class->SUPER::new (
1922 can_hover => 1, 2432 can_hover => 1,
1923 align => 0, 2433 align => 0.5,
1924 valign => 0, 2434 valign => 0.5,
1925 can_events => 1, 2435 can_events => 1,
1926 @_ 2436 @_
1927 ) 2437 )
1928} 2438}
1929 2439
1930sub activate { }
1931
1932sub button_up { 2440sub invoke_button_up {
1933 my ($self, $ev, $x, $y) = @_; 2441 my ($self, $ev, $x, $y) = @_;
1934 2442
1935 $self->emit ("activate") 2443 $self->emit ("activate")
1936 if $x >= 0 && $x < $self->{w} 2444 if $x >= 0 && $x < $self->{w}
1937 && $y >= 0 && $y < $self->{h}; 2445 && $y >= 0 && $y < $self->{h};
… …
1940} 2448}
1941 2449
1942sub _draw { 2450sub _draw {
1943 my ($self) = @_; 2451 my ($self) = @_;
1944 2452
1945 local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1946
1947 glEnable GL_TEXTURE_2D; 2453 glEnable GL_TEXTURE_2D;
1948 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2454 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1949 glColor 0, 0, 0, 1; 2455 glColor 0, 0, 0, 1;
1950 2456
2457 my $tex = $tex[$GRAB == $self];
1951 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 2458 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1952 2459
1953 glDisable GL_TEXTURE_2D; 2460 glDisable GL_TEXTURE_2D;
1954 2461
1955 $self->SUPER::_draw; 2462 $self->SUPER::_draw;
1956} 2463}
1957 2464
1958############################################################################# 2465#############################################################################
1959 2466
1960package CFClient::UI::CheckBox; 2467package DC::UI::Button;
1961 2468
1962our @ISA = CFClient::UI::DrawBG::; 2469our @ISA = DC::UI::Label::;
2470
2471use DC::OpenGL;
1963 2472
1964my @tex = 2473my @tex =
1965 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2474 map { new_from_resource DC::Texture $_, mipmap => 1 }
1966 qw(c1_checkbox_bg.png c1_checkbox_active.png); 2475 qw(b1_button_inactive.png b1_button_active.png);
1967
1968use CFClient::OpenGL;
1969 2476
1970sub new { 2477sub new {
1971 my $class = shift; 2478 my $class = shift;
1972 2479
1973 $class->SUPER::new ( 2480 $class->SUPER::new (
2481 padding_x => 8,
2482 padding_y => 4,
2483 fg => [1.0, 1.0, 1.0],
2484 active_fg => [0.8, 0.8, 0.8],
2485 can_hover => 1,
2486 align => 0.5,
2487 valign => 0.5,
2488 can_events => 1,
2489 @_
2490 )
2491}
2492
2493sub invoke_button_up {
2494 my ($self, $ev, $x, $y) = @_;
2495
2496 $self->emit ("activate")
2497 if $x >= 0 && $x < $self->{w}
2498 && $y >= 0 && $y < $self->{h};
2499
2500 1
2501}
2502
2503sub _draw {
2504 my ($self) = @_;
2505
2506 local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
2507
2508 glEnable GL_TEXTURE_2D;
2509 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2510 glColor 0, 0, 0, 1;
2511
2512 my $tex = $tex[$GRAB == $self];
2513 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2514
2515 glDisable GL_TEXTURE_2D;
2516
2517 $self->SUPER::_draw;
2518}
2519
2520#############################################################################
2521
2522package DC::UI::CheckBox;
2523
2524our @ISA = DC::UI::DrawBG::;
2525
2526my @tex =
2527 map { new_from_resource DC::Texture $_, mipmap => 1 }
2528 qw(c1_checkbox_bg.png c1_checkbox_active.png);
2529
2530use DC::OpenGL;
2531
2532sub new {
2533 my $class = shift;
2534
2535 $class->SUPER::new (
2536 fontsize => 1,
1974 padding_x => 2, 2537 padding_x => 2,
1975 padding_y => 2, 2538 padding_y => 2,
1976 fg => [1, 1, 1], 2539 fg => [1, 1, 1],
1977 active_fg => [1, 1, 0], 2540 active_fg => [1, 1, 0],
1978 bg => [0, 0, 0, 0.2], 2541 bg => [0, 0, 0, 0.2],
… …
1984} 2547}
1985 2548
1986sub size_request { 2549sub size_request {
1987 my ($self) = @_; 2550 my ($self) = @_;
1988 2551
1989 (6) x 2 2552 ($self->{fontsize} * $::FONTSIZE) x 2
1990} 2553}
1991 2554
2555sub toggle {
2556 my ($self) = @_;
2557
2558 $self->{state} = !$self->{state};
2559 $self->emit (changed => $self->{state});
2560 $self->update;
2561}
2562
1992sub button_down { 2563sub invoke_button_down {
1993 my ($self, $ev, $x, $y) = @_; 2564 my ($self, $ev, $x, $y) = @_;
1994 2565
1995 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2566 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1996 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2567 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1997 $self->{state} = !$self->{state}; 2568 $self->toggle;
1998 $self->_emit (changed => $self->{state});
1999 } else { 2569 } else {
2000 return 0 2570 return 0
2001 } 2571 }
2002 2572
2003 1 2573 1
… …
2006sub _draw { 2576sub _draw {
2007 my ($self) = @_; 2577 my ($self) = @_;
2008 2578
2009 $self->SUPER::_draw; 2579 $self->SUPER::_draw;
2010 2580
2011 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0; 2581 glTranslate $self->{padding_x}, $self->{padding_y}, 0;
2012 2582
2013 my ($w, $h) = @$self{qw(w h)}; 2583 my ($w, $h) = @$self{qw(w h)};
2014 2584
2015 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2; 2585 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2016 2586
… …
2023 glDisable GL_TEXTURE_2D; 2593 glDisable GL_TEXTURE_2D;
2024} 2594}
2025 2595
2026############################################################################# 2596#############################################################################
2027 2597
2028package CFClient::UI::Image; 2598package DC::UI::Image;
2029 2599
2030our @ISA = CFClient::UI::Base::; 2600our @ISA = DC::UI::DrawBG::;
2031 2601
2032use CFClient::OpenGL; 2602use DC::OpenGL;
2033use Carp qw/confess/;
2034 2603
2035our %loaded_images; 2604our %texture_cache;
2036 2605
2037sub new { 2606sub new {
2038 my $class = shift; 2607 my $class = shift;
2039 2608
2040 my $self = $class->SUPER::new (can_events => 0, @_); 2609 my $self = $class->SUPER::new (
2610 can_events => 0,
2611 scale => 1,
2612 @_,
2613 );
2041 2614
2042 $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; 2615 $self->{path} || $self->{tex}
2616 or Carp::croak "'path' or 'tex' attributes required";
2043 2617
2044 $loaded_images{$self->{image}} ||= 2618 $self->{tex} ||= $texture_cache{$self->{path}} ||=
2045 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; 2619 new_from_resource DC::Texture $self->{path}, mipmap => 1;
2046 2620
2047 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2621 DC::weaken $texture_cache{$self->{path}};
2048 2622
2049 Scalar::Util::weaken $loaded_images{$self->{image}}; 2623 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2050
2051 $self->{aspect} = $tex->{w} / $tex->{h};
2052 2624
2053 $self 2625 $self
2054} 2626}
2055 2627
2628sub STORABLE_freeze {
2629 my ($self, $cloning) = @_;
2630
2631 $self->{path}
2632 or die "cannot serialise DC::UI::Image on non-loadable images\n";
2633
2634 $self->{path}
2635}
2636
2637sub STORABLE_attach {
2638 my ($self, $cloning, $path) = @_;
2639
2640 $self->new (path => $path)
2641}
2642
2643sub set_texture {
2644 my ($self, $tex) = @_;
2645
2646 $self->{tex} = $tex;
2647 $self->update;
2648}
2649
2056sub size_request { 2650sub size_request {
2057 my ($self) = @_; 2651 my ($self) = @_;
2058 2652
2059 ($self->{tex}->{w}, $self->{tex}->{h}) 2653 (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
2060} 2654}
2061 2655
2062sub _draw { 2656sub _draw {
2063 my ($self) = @_; 2657 my ($self) = @_;
2658
2659 $self->SUPER::_draw;
2064 2660
2065 my $tex = $self->{tex}; 2661 my $tex = $self->{tex};
2066 2662
2067 my ($w, $h) = ($self->{w}, $self->{h}); 2663 my ($w, $h) = ($self->{w}, $self->{h});
2068 2664
… …
2081 glDisable GL_TEXTURE_2D; 2677 glDisable GL_TEXTURE_2D;
2082} 2678}
2083 2679
2084############################################################################# 2680#############################################################################
2085 2681
2682package DC::UI::ImageButton;
2683
2684our @ISA = DC::UI::Image::;
2685
2686use DC::OpenGL;
2687
2688sub new {
2689 my $class = shift;
2690
2691 my $self = $class->SUPER::new (
2692 padding_x => 4,
2693 padding_y => 4,
2694 fg => [1, 1, 1],
2695 active_fg => [0, 0, 1],
2696 can_hover => 1,
2697 align => 0.5,
2698 valign => 0.5,
2699 can_events => 1,
2700 @_
2701 );
2702}
2703
2704sub invoke_button_down {
2705 my ($self, $ev, $x, $y) = @_;
2706
2707 1
2708}
2709
2710sub invoke_button_up {
2711 my ($self, $ev, $x, $y) = @_;
2712
2713 $self->emit ("activate")
2714 if $x >= 0 && $x < $self->{w}
2715 && $y >= 0 && $y < $self->{h};
2716
2717 1
2718}
2719
2720#############################################################################
2721
2086package CFClient::UI::VGauge; 2722package DC::UI::VGauge;
2087 2723
2088our @ISA = CFClient::UI::Base::; 2724our @ISA = DC::UI::Base::;
2089 2725
2090use List::Util qw(min max); 2726use List::Util qw(min max);
2091 2727
2092use CFClient::OpenGL; 2728use DC::OpenGL;
2093 2729
2094my %tex = ( 2730my %tex = (
2095 food => [ 2731 food => [
2096 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2732 map { new_from_resource DC::Texture $_, mipmap => 1 }
2097 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ 2733 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2098 ], 2734 ],
2099 grace => [ 2735 grace => [
2100 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2736 map { new_from_resource DC::Texture $_, mipmap => 1 }
2101 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ 2737 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2102 ], 2738 ],
2103 hp => [ 2739 hp => [
2104 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2740 map { new_from_resource DC::Texture $_, mipmap => 1 }
2105 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ 2741 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2106 ], 2742 ],
2107 mana => [ 2743 mana => [
2108 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2744 map { new_from_resource DC::Texture $_, mipmap => 1 }
2109 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ 2745 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2110 ], 2746 ],
2111); 2747);
2112 2748
2113# eg. VGauge->new (gauge => 'food'), default gauge: food 2749# eg. VGauge->new (gauge => 'food'), default gauge: food
… …
2173 my $ycut1 = max 0, min 1, $ycut; 2809 my $ycut1 = max 0, min 1, $ycut;
2174 my $ycut2 = max 0, min 1, $ycut - 1; 2810 my $ycut2 = max 0, min 1, $ycut - 1;
2175 2811
2176 my $h1 = $self->{h} * (1 - $ycut1); 2812 my $h1 = $self->{h} * (1 - $ycut1);
2177 my $h2 = $self->{h} * (1 - $ycut2); 2813 my $h2 = $self->{h} * (1 - $ycut2);
2814 my $h3 = $self->{h};
2815
2816 $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2178 2817
2179 glEnable GL_BLEND; 2818 glEnable GL_BLEND;
2180 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA, 2819 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2181 GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2820 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2182 glEnable GL_TEXTURE_2D; 2821 glEnable GL_TEXTURE_2D;
… …
2201 2840
2202 if ($t3) { 2841 if ($t3) {
2203 glBindTexture GL_TEXTURE_2D, $t3->{name}; 2842 glBindTexture GL_TEXTURE_2D, $t3->{name};
2204 glBegin GL_QUADS; 2843 glBegin GL_QUADS;
2205 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2; 2844 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2206 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h}; 2845 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2207 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h}; 2846 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2208 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2; 2847 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2209 glEnd; 2848 glEnd;
2210 } 2849 }
2211 2850
2212 glDisable GL_BLEND; 2851 glDisable GL_BLEND;
2213 glDisable GL_TEXTURE_2D; 2852 glDisable GL_TEXTURE_2D;
2214} 2853}
2215 2854
2216############################################################################# 2855#############################################################################
2217 2856
2857package DC::UI::Progress;
2858
2859our @ISA = DC::UI::Label::;
2860
2861use DC::OpenGL;
2862
2863sub new {
2864 my ($class, %arg) = @_;
2865
2866 my $self = $class->SUPER::new (
2867 padding_x => 2,
2868 padding_y => 2,
2869 fg => [1, 1, 1],
2870 bg => [0, 0, 1, 0.2],
2871 bar => [0.7, 0.5, 0.1, 0.8],
2872 outline => [0.4, 0.3, 0],
2873 fontsize => 0.9,
2874 valign => 0.5,
2875 align => 0.5,
2876 can_events => 1,
2877 ellipsise => 1,
2878 label => "%d%%",
2879 %arg,
2880 );
2881
2882 $self->set_value ($arg{value} || -1);
2883
2884 $self
2885}
2886
2887sub set_label {
2888 my ($self, $label) = @_;
2889
2890 return if $self->{label} eq $label;
2891 $self->{label} = $label;
2892
2893 $self->DC::UI::Progress::set_value (0 + delete $self->{value});
2894}
2895
2896sub set_value {
2897 my ($self, $value) = @_;
2898
2899 if ($self->{value} ne $value) {
2900 $self->{value} = $value;
2901
2902 if ($value < 0) {
2903 $self->set_text ("-");
2904 } else {
2905 $self->set_text (sprintf $self->{label}, $value * 100);
2906 }
2907
2908 $self->update;
2909 }
2910}
2911
2912sub _draw {
2913 my ($self) = @_;
2914
2915 glEnable GL_BLEND;
2916 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2917
2918 my $px = $self->{padding_x};
2919 my $py = $self->{padding_y};
2920
2921 if ($self->{value} >= 0) {
2922 my $s = int $px + ($self->{w} - $px * 2) * $self->{value};
2923
2924 glColor_premultiply @{$self->{bar}};
2925 glRect $px, $py, $s, $self->{h} - $py;
2926 glColor_premultiply @{$self->{bg}};
2927 glRect $s , $py, $self->{w} - $px, $self->{h} - $py;
2928 }
2929
2930 glColor_premultiply @{$self->{outline}};
2931
2932 $px -= .5;
2933 $py -= .5;
2934
2935 glRect_lineloop $px, $py, $self->{w} - $px, $self->{h} - $py;
2936
2937 glDisable GL_BLEND;
2938
2939 {
2940 local $self->{bg}; # do not draw background
2941 $self->SUPER::_draw;
2942 }
2943}
2944
2945#############################################################################
2946
2947package DC::UI::ExperienceProgress;
2948
2949our @ISA = DC::UI::Progress::;
2950
2951sub new {
2952 my ($class, %arg) = @_;
2953
2954 my $tt = exists $arg{tooltip} ? "$arg{tooltip}\n\n" : "";
2955
2956 my $self = $class->SUPER::new (
2957 %arg,
2958 tooltip => sub {
2959 my ($self) = @_;
2960
2961 sprintf "%slevel %d\n%s points\n%s next level\n%s to go, %d%% done",
2962 $tt,
2963 $self->{lvl},
2964 ::formsep ($self->{exp}),
2965 ::formsep ($self->{nxt}),
2966 ::formsep ($self->{nxt} - $self->{exp}),
2967 $self->_percent * 100,
2968 },
2969 );
2970
2971 $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) }
2972 if $::CONN;
2973
2974 $self
2975}
2976
2977sub DESTROY {
2978 my ($self) = @_;
2979
2980 delete $::CONN->{on_exp_update}{$self+0}
2981 if $::CONN;
2982
2983 $self->SUPER::DESTROY;
2984}
2985
2986sub _percent {
2987 my ($self) = @_;
2988
2989 my $table = $::CONN && $::CONN->{exp_table}
2990 or return -1;
2991
2992 my $l0 = $table->[$self->{lvl} - 1];
2993 my $l1 = $table->[$self->{lvl}];
2994
2995 $self->{nxt} = $l1;
2996
2997 ($self->{exp} - $l0) / ($l1 - $l0)
2998}
2999
3000sub set_value {
3001 my ($self, $lvl, $exp) = @_;
3002
3003 $self->{lvl} = $lvl;
3004 $self->{exp} = $exp;
3005
3006 $self->SUPER::set_value ($self->_percent);
3007}
3008
3009#############################################################################
3010
2218package CFClient::UI::Gauge; 3011package DC::UI::Gauge;
2219 3012
2220our @ISA = CFClient::UI::VBox::; 3013our @ISA = DC::UI::VBox::;
2221 3014
2222sub new { 3015sub new {
2223 my ($class, %arg) = @_; 3016 my ($class, %arg) = @_;
2224 3017
2225 my $self = $class->SUPER::new ( 3018 my $self = $class->SUPER::new (
… …
2227 can_hover => 1, 3020 can_hover => 1,
2228 can_events => 1, 3021 can_events => 1,
2229 %arg, 3022 %arg,
2230 ); 3023 );
2231 3024
2232 $self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999"); 3025 $self->add ($self->{value} = new DC::UI::Label valign => 1, align => 0.5, template => "999");
2233 $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1); 3026 $self->add ($self->{gauge} = new DC::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2234 $self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999"); 3027 $self->add ($self->{max} = new DC::UI::Label valign => 0, align => 0.5, template => "999");
2235 3028
2236 $self 3029 $self
2237} 3030}
2238 3031
2239sub set_fontsize { 3032sub set_fontsize {
… …
2260 $self->{value}->set_text ($val); 3053 $self->{value}->set_text ($val);
2261} 3054}
2262 3055
2263############################################################################# 3056#############################################################################
2264 3057
2265package CFClient::UI::Slider; 3058package DC::UI::Slider;
2266 3059
2267use strict; 3060use common::sense;
2268 3061
2269use CFClient::OpenGL; 3062use DC::OpenGL;
2270 3063
2271our @ISA = CFClient::UI::DrawBG::; 3064our @ISA = DC::UI::DrawBG::;
2272 3065
2273my @tex = 3066my @tex =
2274 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } 3067 map { new_from_resource DC::Texture $_ }
2275 qw(s1_slider.png s1_slider_bg.png); 3068 qw(s1_slider.png s1_slider_bg.png);
2276 3069
2277sub new { 3070sub new {
2278 my $class = shift; 3071 my $class = shift;
2279 3072
… …
2300 $self->update; 3093 $self->update;
2301 3094
2302 $self 3095 $self
2303} 3096}
2304 3097
2305sub changed { }
2306
2307sub set_range { 3098sub set_range {
2308 my ($self, $range) = @_; 3099 my ($self, $range) = @_;
2309 3100
2310 ($range, $self->{range}) = ($self->{range}, $range); 3101 ($range, $self->{range}) = ($self->{range}, $range);
2311 3102
… …
2318sub set_value { 3109sub set_value {
2319 my ($self, $value) = @_; 3110 my ($self, $value) = @_;
2320 3111
2321 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; 3112 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2322 3113
2323 $hi = $lo + 1 if $hi <= $lo; 3114 $hi = $lo if $hi < $lo;
2324 3115
2325 $page = $hi - $lo if $page > $hi - $lo; 3116 $value = $hi - $page if $value > $hi - $page;
2326
2327 $value = $lo if $value < $lo; 3117 $value = $lo if $value < $lo;
2328 $value = $hi - $page if $value > $hi - $page;
2329 3118
2330 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit 3119 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2331 if $unit; 3120 if $unit;
2332 3121
2333 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 3122 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2334 3123
2335 if ($value != $old_value) { 3124 if ($value != $old_value) {
2336 $self->_emit (changed => $value); 3125 $self->emit (changed => $value);
2337 $self->update; 3126 $self->update;
2338 } 3127 }
2339} 3128}
2340 3129
2341sub size_request { 3130sub size_request {
2342 my ($self) = @_; 3131 my ($self) = @_;
2343 3132
2344 ($self->{req_w}, $self->{req_h}) 3133 ($self->{req_w}, $self->{req_h})
2345} 3134}
2346 3135
2347sub button_down { 3136sub invoke_button_down {
2348 my ($self, $ev, $x, $y) = @_; 3137 my ($self, $ev, $x, $y) = @_;
2349 3138
2350 $self->SUPER::button_down ($ev, $x, $y); 3139 $self->SUPER::invoke_button_down ($ev, $x, $y);
2351 3140
2352 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 3141 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2353 3142
2354 $self->mouse_motion ($ev, $x, $y) 3143 $self->invoke_mouse_motion ($ev, $x, $y);
2355}
2356 3144
3145 1
3146}
3147
2357sub mouse_motion { 3148sub invoke_mouse_motion {
2358 my ($self, $ev, $x, $y) = @_; 3149 my ($self, $ev, $x, $y) = @_;
2359 3150
2360 if ($GRAB == $self) { 3151 if ($GRAB == $self) {
2361 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 3152 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2362 3153
2363 my (undef, $lo, $hi, $page) = @{$self->{range}}; 3154 my (undef, $lo, $hi, $page) = @{$self->{range}};
2364 3155
2365 $x = ($x - $self->{click}[1]) / ($w * $self->{scale}); 3156 $x = ($x - $self->{click}[1]) / ($w * $self->{scale} || 1e999);
2366 3157
2367 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); 3158 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2368 } else { 3159 } else {
2369 return 0; 3160 return 0;
2370 } 3161 }
2371 3162
2372 1 3163 1
2373} 3164}
2374 3165
3166sub invoke_mouse_wheel {
3167 my ($self, $ev) = @_;
3168
3169 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
3170
3171 my $pagepart = $ev->{mod} & DC::KMOD_SHIFT ? 1 : 0.2;
3172
3173 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
3174
3175 1
3176}
3177
2375sub update { 3178sub update {
2376 my ($self) = @_; 3179 my ($self) = @_;
2377 3180
2378 delete $self->{knob_w}; 3181 delete $self->{knob_w};
2379 $self->SUPER::update; 3182 $self->SUPER::update;
… …
2383 my ($self) = @_; 3186 my ($self) = @_;
2384 3187
2385 unless ($self->{knob_w}) { 3188 unless ($self->{knob_w}) {
2386 $self->set_value ($self->{range}[0]); 3189 $self->set_value ($self->{range}[0]);
2387 3190
2388 my ($value, $lo, $hi, $page) = @{$self->{range}}; 3191 my ($value, $lo, $hi, $page, $unit) = @{$self->{range}};
2389 my $range = ($hi - $page - $lo) || 1e-100; 3192 my $range = ($hi - $page - $lo) || 1e-10;
2390 3193
2391 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1; 3194 my $knob_w = List::Util::min 1, $page / (($hi - $lo) || 1e-10) || 24 / $self->{w};
2392 3195
2393 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5; 3196 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2394 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; 3197 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2395 3198
2396 $value = ($value - $lo) / $range; 3199 $value = ($value - $lo) / $range;
… …
2426 glDisable GL_TEXTURE_2D; 3229 glDisable GL_TEXTURE_2D;
2427} 3230}
2428 3231
2429############################################################################# 3232#############################################################################
2430 3233
2431package CFClient::UI::ValSlider; 3234package DC::UI::ValSlider;
2432 3235
2433our @ISA = CFClient::UI::HBox::; 3236our @ISA = DC::UI::HBox::;
2434 3237
2435sub new { 3238sub new {
2436 my ($class, %arg) = @_; 3239 my ($class, %arg) = @_;
2437 3240
2438 my $range = delete $arg{range}; 3241 my $range = delete $arg{range};
2439 3242
2440 my $self = $class->SUPER::new ( 3243 my $self = $class->SUPER::new (
2441 slider => (new CFClient::UI::Slider expand => 1, range => $range), 3244 slider => (new DC::UI::Slider expand => 1, range => $range),
2442 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}), 3245 entry => (new DC::UI::Label text => "", template => delete $arg{template}),
2443 to_value => sub { shift }, 3246 to_value => sub { shift },
2444 from_value => sub { shift }, 3247 from_value => sub { shift },
2445 %arg, 3248 %arg,
2446 ); 3249 );
2447 3250
… …
2467sub set_range { shift->{slider}->set_range (@_) } 3270sub set_range { shift->{slider}->set_range (@_) }
2468sub set_value { shift->{slider}->set_value (@_) } 3271sub set_value { shift->{slider}->set_value (@_) }
2469 3272
2470############################################################################# 3273#############################################################################
2471 3274
2472package CFClient::UI::TextView; 3275package DC::UI::TextScroller;
2473 3276
2474our @ISA = CFClient::UI::HBox::; 3277our @ISA = DC::UI::HBox::;
2475 3278
2476use CFClient::OpenGL; 3279use DC::OpenGL;
2477 3280
2478sub new { 3281sub new {
2479 my $class = shift; 3282 my $class = shift;
2480 3283
2481 my $self = $class->SUPER::new ( 3284 my $self = $class->SUPER::new (
2482 fontsize => 1, 3285 fontsize => 1,
2483 can_events => 0, 3286 can_events => 1,
2484 indent => 0, 3287 indent => 0,
2485 #font => default_font 3288 #font => default_font
2486 @_, 3289 @_,
2487 3290
2488 layout => (new CFClient::Layout 1), 3291 layout => (new DC::Layout),
2489 par => [], 3292 par => [],
3293 max_par => 0,
2490 height => 0, 3294 height => 0,
2491 children => [ 3295 children => [
2492 (new CFClient::UI::Empty expand => 1), 3296 (new DC::UI::Empty expand => 1),
2493 (new CFClient::UI::Slider vertical => 1), 3297 (new DC::UI::Slider vertical => 1),
2494 ], 3298 ],
2495 ); 3299 );
2496 3300
2497 $self->{children}[1]->connect (changed => sub { $self->update }); 3301 $self->{children}[1]->connect (changed => sub { $self->update });
2498 3302
… …
2504 3308
2505 $self->{fontsize} = $fontsize; 3309 $self->{fontsize} = $fontsize;
2506 $self->reflow; 3310 $self->reflow;
2507} 3311}
2508 3312
3313sub size_request {
3314 my ($self) = @_;
3315
3316 my ($empty, $slider) = $self->visible_children;
3317
3318 local $self->{children} = [$empty, $slider];
3319 $self->SUPER::size_request
3320}
3321
2509sub size_allocate { 3322sub invoke_size_allocate {
2510 my ($self, $w, $h) = @_; 3323 my ($self, $w, $h) = @_;
2511 3324
2512 $self->SUPER::size_allocate ($w, $h); 3325 my ($empty, $slider, @other) = @{ $self->{children} };
3326 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2513 3327
2514 $self->{layout}->set_font ($self->{font}) if $self->{font}; 3328 $self->{layout}->set_font ($self->{font}) if $self->{font};
2515 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 3329 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2516 $self->{layout}->set_width ($self->{children}[0]{w}); 3330 $self->{layout}->set_width ($empty->{w});
2517 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 3331 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2518 3332
2519 $self->reflow; 3333 $self->reflow;
2520}
2521 3334
2522sub text_size { 3335 local $self->{children} = [$empty, $slider];
3336 $self->SUPER::invoke_size_allocate ($w, $h)
3337}
3338
3339sub invoke_mouse_wheel {
2523 my ($self, $text, $indent) = @_; 3340 my ($self, $ev) = @_;
3341
3342 return 0 unless $ev->{dy}; # only vertical movements
3343
3344 $self->{children}[1]->emit (mouse_wheel => $ev);
3345
3346 1
3347}
3348
3349sub get_layout {
3350 my ($self, $para) = @_;
2524 3351
2525 my $layout = $self->{layout}; 3352 my $layout = $self->{layout};
2526 3353
3354 $layout->set_font ($self->{font}) if $self->{font};
3355 $layout->set_foreground (@{$para->{fg}});
2527 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 3356 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2528 $layout->set_width ($self->{children}[0]{w} - $indent); 3357 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2529 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 3358 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2530 $layout->set_markup ($text); 3359 $layout->set_markup ($para->{markup});
3360
3361 $layout->set_shapes (
3362 map
3363 +(0, $_->baseline_shift + $_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
3364 @{$para->{widget}}
2531 3365 );
3366
2532 $layout->size 3367 $layout
2533} 3368}
2534 3369
2535sub reflow { 3370sub reflow {
2536 my ($self) = @_; 3371 my ($self) = @_;
2537 3372
… …
2544 3379
2545 # todo: base offset on lines or so, not on pixels 3380 # todo: base offset on lines or so, not on pixels
2546 $self->{children}[1]->set_value ($offset); 3381 $self->{children}[1]->set_value ($offset);
2547} 3382}
2548 3383
3384sub current_paragraph {
3385 my ($self) = @_;
3386
3387 $self->{top_paragraph} - 1
3388}
3389
3390sub scroll_to {
3391 my ($self, $para) = @_;
3392
3393 $para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
3394
3395 $self->{scroll_to} = $para;
3396 $self->update;
3397}
3398
2549sub clear { 3399sub clear {
2550 my ($self) = @_; 3400 my ($self) = @_;
3401
3402 my (undef, undef, @other) = @{ $self->{children} };
3403 $self->remove ($_) for @other;
2551 3404
2552 $self->{par} = []; 3405 $self->{par} = [];
2553 $self->{height} = 0; 3406 $self->{height} = 0;
2554 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 3407 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2555} 3408}
2556 3409
2557sub add_paragraph { 3410sub add_paragraph {
2558 my ($self, $color, $text, $indent) = @_; 3411 my $self = shift;
2559 3412
2560 for my $line (split /\n/, $text) { 3413 for my $para (@_) {
2561 my ($w, $h) = $self->text_size ($line); 3414 $para = {
3415 fg => [1, 1, 1, 1],
3416 indent => 0,
3417 markup => "",
3418 widget => [],
3419 ref $para ? %$para : (markup => $para),
3420 w => 1e10,
3421 wrapped => 1,
3422 };
3423
3424 $self->add (@{ $para->{widget} }) if @{ $para->{widget} };
3425 push @{$self->{par}}, $para;
3426 }
3427
3428 if (my $max = $self->{max_par}) {
3429 shift @{$self->{par}} while @{$self->{par}} > $max;
3430 }
3431
3432 $self->{need_reflow}++;
3433 $self->update;
3434}
3435
3436sub scroll_to_bottom {
3437 my ($self) = @_;
3438
3439 $self->{scroll_to} = $#{$self->{par}};
3440 $self->update;
3441}
3442
3443sub force_uptodate {
3444 my ($self) = @_;
3445
3446 if (delete $self->{need_reflow}) {
3447 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
3448
3449 my $height = 0;
3450
3451 for my $para (@{$self->{par}}) {
3452 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
3453 my $layout = $self->get_layout ($para);
3454 my ($w, $h) = $layout->size;
3455
3456 $para->{w} = $w + $para->{indent};
3457 $para->{h} = $h;
3458 $para->{wrapped} = $layout->has_wrapped;
3459 }
3460
3461 $para->{y} = $height;
3462 $height += $para->{h};
3463 }
3464
2562 $self->{height} += $h; 3465 $self->{height} = $height;
2563 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 3466 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2564 }
2565 3467
2566 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 3468 delete $self->{texture};
3469 }
3470
3471 if (my $paridx = delete $self->{scroll_to}) {
3472 $self->{children}[1]->set_value ($self->{par}[$paridx]{y});
3473 }
2567} 3474}
2568 3475
2569sub update { 3476sub update {
2570 my ($self) = @_; 3477 my ($self) = @_;
2571 3478
… …
2574 return unless $self->{h} > 0; 3481 return unless $self->{h} > 0;
2575 3482
2576 delete $self->{texture}; 3483 delete $self->{texture};
2577 3484
2578 $ROOT->on_post_alloc ($self => sub { 3485 $ROOT->on_post_alloc ($self => sub {
3486 $self->force_uptodate;
3487
2579 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 3488 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2580 3489
2581 if (delete $self->{need_reflow}) {
2582 my $height = 0;
2583
2584 my $layout = $self->{layout};
2585
2586 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2587
2588 for (@{$self->{par}}) {
2589 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2590 $layout->set_width ($W - $_->[3]);
2591 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2592 $layout->set_markup ($_->[4]);
2593 my ($w, $h) = $layout->size;
2594 $_->[0] = $w + $_->[3];
2595 $_->[1] = $h;
2596 }
2597
2598 $height += $_->[1];
2599 }
2600
2601 $self->{height} = $height;
2602
2603 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2604
2605 delete $self->{texture};
2606 }
2607
2608 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 3490 $self->{texture} ||= new_from_opengl DC::Texture $W, $H, sub {
2609 glClearColor 0, 0, 0, 0; 3491 glClearColor 0, 0, 0, 0;
2610 glClear GL_COLOR_BUFFER_BIT; 3492 glClear GL_COLOR_BUFFER_BIT;
2611 3493
3494 package DC::UI::Base;
3495 local ($draw_x, $draw_y, $draw_w, $draw_h) =
3496 (0, 0, $self->{w}, $self->{h});
3497
3498 my $top = int $self->{children}[1]{range}[0];
3499
3500 my $paridx = 0;
3501 my $top_paragraph;
2612 my $top = int $self->{children}[1]{range}[0]; 3502 my $top = int $self->{children}[1]{range}[0];
2613 3503
2614 my $y0 = $top; 3504 my $y0 = $top;
2615 my $y1 = $top + $H; 3505 my $y1 = $top + $H;
2616 3506
2617 my $y = 0;
2618
2619 my $layout = $self->{layout};
2620
2621 $layout->set_font ($self->{font}) if $self->{font};
2622
2623 glEnable GL_BLEND;
2624 #TODO# not correct in windows where rgba is forced off
2625 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2626
2627 for my $par (@{$self->{par}}) { 3507 for my $para (@{$self->{par}}) {
2628 my $h = $par->[1]; 3508 my $h = $para->{h};
3509 my $y = $para->{y};
2629 3510
2630 if ($y0 < $y + $h && $y < $y1) { 3511 if ($y0 < $y + $h && $y < $y1) {
2631 $layout->set_foreground (@{ $par->[2] }); 3512 my $layout = $self->get_layout ($para);
2632 $layout->set_width ($W - $par->[3]);
2633 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2634 $layout->set_markup ($par->[4]);
2635 3513
2636 my ($w, $h, $data, $format, $internalformat) = $layout->render; 3514 $layout->render ($para->{indent}, $y - $y0);
3515 $layout->draw;
2637 3516
2638 glRasterPos $par->[3], $y - $y0; 3517 if (my @w = @{ $para->{widget} }) {
2639 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 3518 my @s = $layout->get_shapes;
3519
3520 for (@w) {
3521 my ($dx, $dy) = splice @s, 0, 2, ();
3522
3523 $_->{x} = $dx + $para->{indent};
3524 $_->{y} = $dy + $y - $y0;
3525
3526 $_->draw;
3527 }
3528 }
2640 } 3529 }
2641 3530
2642 $y += $h; 3531 $paridx++;
3532 $top_paragraph ||= $paridx if $y >= $top;
2643 } 3533 }
2644 3534
2645 glDisable GL_BLEND; 3535 $self->{top_paragraph} = $top_paragraph;
2646 }; 3536 };
2647 }); 3537 });
3538}
3539
3540sub reconfigure {
3541 my ($self) = @_;
3542
3543 $self->SUPER::reconfigure;
3544
3545 $_->{w} = 1e10 for @{ $self->{par} };
3546 $self->reflow;
2648} 3547}
2649 3548
2650sub _draw { 3549sub _draw {
2651 my ($self) = @_; 3550 my ($self) = @_;
2652 3551
… …
2655 glColor 0, 0, 0, 1; 3554 glColor 0, 0, 0, 1;
2656 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 3555 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2657 glDisable GL_TEXTURE_2D; 3556 glDisable GL_TEXTURE_2D;
2658 3557
2659 $self->{children}[1]->draw; 3558 $self->{children}[1]->draw;
2660
2661} 3559}
2662 3560
2663############################################################################# 3561#############################################################################
2664 3562
2665package CFClient::UI::Animator; 3563package DC::UI::Animator;
2666 3564
2667use CFClient::OpenGL; 3565use DC::OpenGL;
2668 3566
2669our @ISA = CFClient::UI::Bin::; 3567our @ISA = DC::UI::Bin::;
2670 3568
2671sub moveto { 3569sub moveto {
2672 my ($self, $x, $y) = @_; 3570 my ($self, $x, $y) = @_;
2673 3571
2674 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 3572 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
… …
2702 glPopMatrix; 3600 glPopMatrix;
2703} 3601}
2704 3602
2705############################################################################# 3603#############################################################################
2706 3604
2707package CFClient::UI::Flopper; 3605package DC::UI::Flopper;
2708 3606
2709our @ISA = CFClient::UI::Button::; 3607our @ISA = DC::UI::Button::;
2710 3608
2711sub new { 3609sub new {
2712 my $class = shift; 3610 my $class = shift;
2713 3611
2714 my $self = $class->SUPER::new ( 3612 my $self = $class->SUPER::new (
… …
2726 $self->{other}->toggle_visibility; 3624 $self->{other}->toggle_visibility;
2727} 3625}
2728 3626
2729############################################################################# 3627#############################################################################
2730 3628
2731package CFClient::UI::Tooltip; 3629package DC::UI::Tooltip;
2732 3630
2733our @ISA = CFClient::UI::Bin::; 3631our @ISA = DC::UI::Bin::;
2734 3632
2735use CFClient::OpenGL; 3633use DC::OpenGL;
2736 3634
2737sub new { 3635sub new {
2738 my $class = shift; 3636 my $class = shift;
2739 3637
2740 $class->SUPER::new ( 3638 $class->SUPER::new (
… …
2744} 3642}
2745 3643
2746sub set_tooltip_from { 3644sub set_tooltip_from {
2747 my ($self, $widget) = @_; 3645 my ($self, $widget) = @_;
2748 3646
2749 my $tooltip = $widget->{tooltip}; 3647 my $tip = $widget->{tooltip};
3648 $tip = $tip->($widget) if "CODE" eq ref $tip;
3649
3650 $tip = DC::Pod::section_label tooltip => $1
3651 if $tip =~ /^#(.*)$/;
2750 3652
2751 if ($ENV{CFPLUS_DEBUG} & 2) { 3653 if ($ENV{CFPLUS_DEBUG} & 2) {
2752 $tooltip .= "\n\n" . (ref $widget) . "\n" 3654 $tip .= "\n\n" . (ref $widget) . "\n"
2753 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" 3655 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2754 . "req $widget->{req_w} $widget->{req_h}\n" 3656 . "req $widget->{req_w} $widget->{req_h}\n"
2755 . "visible $widget->{visible}"; 3657 . "visible $widget->{visible}";
2756 } 3658 }
2757 3659
3660 $tip =~ s/^\n+//;
3661 $tip =~ s/\n+$//;
3662
2758 $self->add (new CFClient::UI::Label 3663 $self->add (new DC::UI::Label
3664 fg => $DC::THEME{tooltip_fg},
2759 markup => $tooltip, 3665 markup => $tip,
2760 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3666 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
3667 align => 0,
2761 fontsize => 0.8, 3668 fontsize => 0.8,
2762 fg => [0, 0, 0, 1], 3669 style => $DC::THEME{tooltip_style}, # FLAG_INVERSE
2763 ellipsise => 0, 3670 ellipsise => 0,
2764 font => ($widget->{tooltip_font} || $::FONT_PROP), 3671 font => ($widget->{tooltip_font} || $::FONT_PROP),
2765 ); 3672 );
2766} 3673}
2767 3674
… …
2771 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 3678 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2772 3679
2773 ($w + 4, $h + 4) 3680 ($w + 4, $h + 4)
2774} 3681}
2775 3682
2776sub size_allocate { 3683sub invoke_size_allocate {
2777 my ($self, $w, $h) = @_; 3684 my ($self, $w, $h) = @_;
2778 3685
2779 $self->SUPER::size_allocate ($w - 4, $h - 4); 3686 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2780} 3687}
2781 3688
2782sub visibility_change { 3689sub invoke_visibility_change {
2783 my ($self, $visible) = @_; 3690 my ($self, $visible) = @_;
2784 3691
2785 return unless $visible; 3692 return unless $visible;
2786 3693
2787 $self->{root}->on_post_alloc ("move_$self" => sub { 3694 $self->{root}->on_post_alloc ("move_$self" => sub {
2788 my $widget = $self->{owner} 3695 my $widget = $self->{owner}
2789 or return; 3696 or return;
2790 3697
3698 if ($widget->{visible}) {
2791 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 3699 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2792 3700
2793 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 3701 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2794 if $x + $self->{w} > $self->{root}{w}; 3702 if $x + $self->{w} > $self->{root}{w};
2795 3703
2796 $self->move_abs ($x, $y); 3704 $self->move_abs ($x, $y);
3705 } else {
3706 $self->hide;
3707 }
2797 }); 3708 });
2798} 3709}
2799 3710
2800sub _draw { 3711sub _draw {
2801 my ($self) = @_; 3712 my ($self) = @_;
2802 3713
2803 glTranslate 0.375, 0.375;
2804
2805 my ($w, $h) = @$self{qw(w h)}; 3714 my ($w, $h) = @$self{qw(w h)};
2806 3715
2807 glColor 1, 0.8, 0.4; 3716 glColor @{ $DC::THEME{tooltip_bg} };
2808 glBegin GL_QUADS; 3717 glRect 0, 0, $w, $h;
2809 glVertex 0 , 0;
2810 glVertex 0 , $h;
2811 glVertex $w, $h;
2812 glVertex $w, 0;
2813 glEnd;
2814 3718
2815 glColor 0, 0, 0; 3719 glColor @{ $DC::THEME{tooltip_border} };
2816 glBegin GL_LINE_LOOP; 3720 glRect_lineloop .5, .5, $w + .5, $h + .5;
2817 glVertex 0 , 0;
2818 glVertex 0 , $h;
2819 glVertex $w, $h;
2820 glVertex $w, 0;
2821 glEnd;
2822 3721
2823 glTranslate 2 - 0.375, 2 - 0.375; 3722 glTranslate 2, 2;
2824 3723
2825 $self->SUPER::_draw; 3724 $self->SUPER::_draw;
2826} 3725}
2827 3726
2828############################################################################# 3727#############################################################################
2829 3728
2830package CFClient::UI::Face; 3729package DC::UI::Face;
2831 3730
2832our @ISA = CFClient::UI::Base::; 3731our @ISA = DC::UI::DrawBG::;
2833 3732
2834use CFClient::OpenGL; 3733use DC::OpenGL;
2835 3734
2836sub new { 3735sub new {
2837 my $class = shift; 3736 my $class = shift;
2838 3737
2839 my $self = $class->SUPER::new ( 3738 my $self = $class->SUPER::new (
3739 size_w => 32,
3740 size_h => 8,
2840 aspect => 1, 3741 aspect => 1,
2841 can_events => 0, 3742 can_events => 0,
2842 @_, 3743 @_,
2843 ); 3744 );
2844 3745
2845 if ($self->{anim} && $self->{animspeed}) { 3746 $self->update_anim;
2846 Scalar::Util::weaken (my $widget = $self);
2847
2848 $self->{timer} = Event->timer (
2849 at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2850 hard => 1,
2851 interval => $self->{animspeed},
2852 cb => sub {
2853 ++$widget->{frame};
2854 $widget->update;
2855 },
2856 );
2857 }
2858 3747
2859 $self 3748 $self
2860} 3749}
2861 3750
3751sub update_timer {
3752 my ($self) = @_;
3753
3754 return unless $self->{timer};
3755
3756 if ($self->{visible}) {
3757 $self->{timer}->start;
3758 } else {
3759 $self->{timer}->stop;
3760 }
3761}
3762
3763sub update_face {
3764 my ($self) = @_;
3765
3766 if ($::CONN) {
3767 if (my $anim = $::CONN->{anim}[$self->{anim}]) {
3768 if ($anim && @$anim) {
3769 $self->{face} = $anim->[ $self->{frame} % @$anim ];
3770 delete $self->{face_change_cb};
3771
3772 if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{face}[$self->{face}]{id} ]) {
3773 unless ($tex->{name} || $tex->{loading}) {
3774 $tex->upload (sub { $self->reconfigure });
3775 }
3776 }
3777 }
3778 }
3779 }
3780}
3781
3782sub update_anim {
3783 my ($self) = @_;
3784
3785 if ($self->{anim} && $self->{animspeed}) {
3786 DC::weaken (my $widget = $self);
3787
3788 $self->{animspeed} = List::Util::max 0.05, $self->{animspeed};
3789 $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub {
3790 return unless $::CONN;
3791
3792 my $w = $widget
3793 or return;
3794
3795 ++$w->{frame};
3796 $w->update_face;
3797
3798 # somehow, $widget can go away
3799 $w->update;
3800 $w->update_timer;
3801 };
3802
3803 $self->update_face;
3804 $self->update_timer;
3805 } else {
3806 delete $self->{timer};
3807 }
3808}
3809
2862sub size_request { 3810sub size_request {
2863 (32, 8) 3811 my ($self) = @_;
3812
3813 if ($::CONN) {
3814 if (my $faceid = $::CONN->{face}[$self->{face}]{id}) {
3815 if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
3816 if ($tex->{name}) {
3817 return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
3818 } elsif (!$tex->{loading}) {
3819 $tex->upload (sub { $self->reconfigure });
3820 }
3821 }
3822
3823 $self->{face_change_cb} ||= $::CONN->on_face_change ($self->{face}, sub { $self->reconfigure });
3824 }
3825 }
3826
3827 ($self->{size_w} || 8, $self->{size_h} || 8)
2864} 3828}
2865 3829
2866sub update { 3830sub update {
2867 my ($self) = @_; 3831 my ($self) = @_;
2868 3832
2869 return unless $self->{visible}; 3833 return unless $self->{visible};
2870 3834
2871 $self->SUPER::update; 3835 $self->SUPER::update;
2872} 3836}
2873 3837
3838sub set_face {
3839 my ($self, $face) = @_;
3840
3841 $self->{face} = $face;
3842 $self->reconfigure;
3843}
3844
3845sub set_anim {
3846 my ($self, $anim) = @_;
3847
3848 $self->{anim} = $anim;
3849 $self->update_anim;
3850}
3851
3852sub set_animspeed {
3853 my ($self, $animspeed) = @_;
3854
3855 $self->{animspeed} = $animspeed;
3856 $self->update_anim;
3857}
3858
3859sub invoke_visibility_change {
3860 my ($self) = @_;
3861
3862 $self->update_timer;
3863
3864 0
3865}
3866
2874sub _draw { 3867sub _draw {
2875 my ($self) = @_; 3868 my ($self) = @_;
2876 3869
2877 return unless $::CONN; 3870 $self->SUPER::_draw;
2878 3871
2879 my $face; 3872 if (my $tex = $self->{tex}) {
2880
2881 if ($self->{frame}) {
2882 my $anim = $::CONN->{anim}[$self->{anim}];
2883
2884 $face = $anim->[ $self->{frame} % @$anim ]
2885 if $anim && @$anim;
2886 }
2887
2888 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2889
2890 if ($tex) {
2891 glEnable GL_TEXTURE_2D; 3873 glEnable GL_TEXTURE_2D;
2892 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 3874 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2893 glColor 0, 0, 0, 1; 3875 glColor 0, 0, 0, 1;
2894 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3876 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2895 glDisable GL_TEXTURE_2D; 3877 glDisable GL_TEXTURE_2D;
2896 } 3878 }
2897} 3879}
2898 3880
2899sub DESTROY { 3881sub destroy {
2900 my ($self) = @_; 3882 my ($self) = @_;
2901 3883
2902 $self->{timer}->cancel 3884 (delete $self->{timer})->cancel
2903 if $self->{timer}; 3885 if $self->{timer};
2904 3886
2905 $self->SUPER::DESTROY; 3887 $self->SUPER::destroy;
2906} 3888}
2907 3889
2908############################################################################# 3890#############################################################################
2909 3891
2910package CFClient::UI::Buttonbar; 3892package DC::UI::Buttonbar;
2911 3893
2912our @ISA = CFClient::UI::HBox::; 3894our @ISA = DC::UI::HBox::;
2913 3895
2914# TODO: should actualyl wrap buttons and other goodies. 3896# TODO: should actually wrap buttons and other goodies.
2915 3897
2916############################################################################# 3898#############################################################################
2917 3899
2918package CFClient::UI::Menu; 3900package DC::UI::Menu;
2919 3901
2920our @ISA = CFClient::UI::FancyFrame::; 3902our @ISA = DC::UI::Toplevel::;
2921 3903
2922use CFClient::OpenGL; 3904use DC::OpenGL;
2923 3905
2924sub new { 3906sub new {
2925 my $class = shift; 3907 my $class = shift;
2926 3908
2927 my $self = $class->SUPER::new ( 3909 my $self = $class->SUPER::new (
2928 items => [], 3910 items => [],
2929 z => 100, 3911 z => 100,
2930 @_, 3912 @_,
2931 ); 3913 );
2932 3914
2933 $self->add ($self->{vbox} = new CFClient::UI::VBox); 3915 $self->add ($self->{vbox} = new DC::UI::VBox);
2934 3916
2935 for my $item (@{ $self->{items} }) { 3917 for my $item (@{ $self->{items} }) {
2936 my ($widget, $cb, $tooltip) = @$item; 3918 my ($widget, $cb, $tooltip) = @$item;
2937 3919
2938 # handle various types of items, only text for now 3920 # handle various types of items, only text for now
2939 if (!ref $widget) { 3921 if (!ref $widget) {
3922 if ($widget =~ /\t/) {
3923 my ($left, $right) = split /\t/, $widget, 2;
3924
2940 $widget = new CFClient::UI::Label 3925 $widget = new DC::UI::HBox
2941 can_hover => 1, 3926 can_hover => 1,
2942 can_events => 1, 3927 can_events => 1,
2943 text => $widget,
2944 tooltip => $tooltip 3928 tooltip => $tooltip,
3929 children => [
3930 (new DC::UI::Label markup => $left , align => 0, expand => 1),
3931 (new DC::UI::Label markup => $right, align => 1),
3932 ],
3933 ;
3934
3935 } else {
3936 $widget = new DC::UI::Label
3937 can_hover => 1,
3938 can_events => 1,
3939 align => 0,
3940 markup => $widget,
3941 tooltip => $tooltip;
3942 }
2945 } 3943 }
2946 3944
2947 $self->{item}{$widget} = $item; 3945 $self->{item}{$widget} = $item;
2948 3946
2949 $self->{vbox}->add ($widget); 3947 $self->{vbox}->add ($widget);
… …
2954 3952
2955# popup given the event (must be a mouse button down event currently) 3953# popup given the event (must be a mouse button down event currently)
2956sub popup { 3954sub popup {
2957 my ($self, $ev) = @_; 3955 my ($self, $ev) = @_;
2958 3956
2959 $self->_emit ("popdown"); 3957 $self->emit ("popdown");
2960 3958
2961 # maybe save $GRAB? must be careful about events... 3959 # maybe save $GRAB? must be careful about events...
2962 $GRAB = $self; 3960 $GRAB = $self;
2963 $self->{button} = $ev->{button}; 3961 $self->{button} = $ev->{button};
2964 3962
2965 $self->show; 3963 $self->show;
2966 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2967}
2968 3964
3965 my $x = $ev->{x};
3966 my $y = $ev->{y};
3967
3968 $self->{root}->on_post_alloc ($self => sub {
3969 $self->move_abs ($x - $self->{w} * 0.25, $y - $self->{border} * $::FONTSIZE * .5);
3970 });
3971
3972 1 # so it can be used inside event handlers
3973}
3974
2969sub mouse_motion { 3975sub invoke_mouse_motion {
2970 my ($self, $ev, $x, $y) = @_; 3976 my ($self, $ev, $x, $y) = @_;
2971 3977
2972 # TODO: should use vbox->find_widget or so 3978 # TODO: should use vbox->find_widget or so
2973 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3979 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2974 $self->{hover} = $self->{item}{$HOVER}; 3980 $self->{hover} = $self->{item}{$HOVER};
2975 3981
2976 0 3982 0
2977} 3983}
2978 3984
2979sub button_up { 3985sub invoke_button_up {
2980 my ($self, $ev, $x, $y) = @_; 3986 my ($self, $ev, $x, $y) = @_;
2981 3987
2982 if ($ev->{button} == $self->{button}) { 3988 if ($ev->{button} == $self->{button}) {
2983 undef $GRAB; 3989 undef $GRAB;
2984 $self->hide; 3990 $self->hide;
2985 3991
2986 $self->_emit ("popdown"); 3992 $self->emit ("popdown");
2987 $self->{hover}[1]->() if $self->{hover}; 3993 $self->{hover}[1]->() if $self->{hover};
2988 } else { 3994 } else {
2989 return 0 3995 return 0
2990 } 3996 }
2991 3997
2992 1 3998 1
2993} 3999}
2994 4000
2995############################################################################# 4001#############################################################################
2996 4002
2997package CFClient::UI::Multiplexer; 4003package DC::UI::Multiplexer;
2998 4004
2999our @ISA = CFClient::UI::Container::; 4005our @ISA = DC::UI::Container::;
3000 4006
3001sub new { 4007sub new {
3002 my $class = shift; 4008 my $class = shift;
3003 4009
3004 my $self = $class->SUPER::new ( 4010 my $self = $class->SUPER::new (
3005 @_, 4011 @_,
3006 ); 4012 );
3007 4013
3008 $self->{current} = $self->{children}[0] 4014 $self->set_current_page (0);
3009 if @{ $self->{children} };
3010 4015
3011 $self 4016 $self
3012} 4017}
3013 4018
3014sub add { 4019sub add {
3015 my ($self, @widgets) = @_; 4020 my ($self, @widgets) = @_;
3016 4021
3017 $self->SUPER::add (@widgets); 4022 $self->SUPER::add (@widgets);
3018 4023
3019 $self->{current} = $self->{children}[0] 4024 $self->set_current_page (0)
3020 if @{ $self->{children} }; 4025 if @widgets == @{ $self->{children} };
4026}
4027
4028sub get_current_page {
4029 my ($self) = @_;
4030
4031 $self->{current}
3021} 4032}
3022 4033
3023sub set_current_page { 4034sub set_current_page {
3024 my ($self, $page_or_widget) = @_; 4035 my ($self, $page_or_widget) = @_;
3025 4036
3026 my $widget = ref $page_or_widget 4037 my $widget = ref $page_or_widget
3027 ? $page_or_widget 4038 ? $page_or_widget
3028 : $self->{children}[$page_or_widget]; 4039 : $self->{children}[$page_or_widget];
3029 4040
4041 $self->{current}->set_invisible if $self->{current} && $self->{visible};
4042
3030 $self->{current} = $widget; 4043 if (($self->{current} = $widget)) {
4044 $self->{current}->set_visible if $self->{current} && $self->{visible};
3031 $self->{current}->configure (0, 0, $self->{w}, $self->{h}); 4045 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3032 4046
3033 $self->_emit (page_changed => $self->{current}); 4047 $self->emit (page_changed => $self->{current});
4048 }
3034 4049
3035 $self->realloc; 4050 $self->realloc;
3036} 4051}
3037 4052
3038sub visible_children { 4053sub visible_children {
3039 $_[0]{current} 4054 $_[0]{current} || ()
3040} 4055}
3041 4056
3042sub size_request { 4057sub size_request {
3043 my ($self) = @_; 4058 my ($self) = @_;
3044 4059
4060 $self->{current}
3045 $self->{current}->size_request 4061 ? $self->{current}->size_request
4062 : (0, 0)
3046} 4063}
3047 4064
3048sub size_allocate { 4065sub invoke_size_allocate {
3049 my ($self, $w, $h) = @_; 4066 my ($self, $w, $h) = @_;
3050 4067
3051 $self->{current}->configure (0, 0, $w, $h); 4068 $self->{current}->configure (0, 0, $w, $h)
4069 if $self->{current};
4070
4071 1
3052} 4072}
3053 4073
3054sub _draw { 4074sub _draw {
3055 my ($self) = @_; 4075 my ($self) = @_;
3056 4076
3057 $self->{current}->draw; 4077 $self->{current}->draw
4078 if $self->{current};
3058} 4079}
3059 4080
3060############################################################################# 4081#############################################################################
3061 4082
3062package CFClient::UI::Notebook; 4083package DC::UI::Notebook;
3063 4084
4085use DC::OpenGL;
4086
3064our @ISA = CFClient::UI::VBox::; 4087our @ISA = DC::UI::VBox::;
3065 4088
3066sub new { 4089sub new {
3067 my $class = shift; 4090 my $class = shift;
3068 4091
3069 my $self = $class->SUPER::new ( 4092 my $self = $class->SUPER::new (
3070 buttonbar => (new CFClient::UI::Buttonbar), 4093 buttonbar => (new DC::UI::Buttonbar),
3071 multiplexer => (new CFClient::UI::Multiplexer expand => 1), 4094 multiplexer => (new DC::UI::Multiplexer expand => 1),
4095 active_outline => [.7, .7, 0.2],
3072 # filter => # will be put between multiplexer and $self 4096 # filter => # will be put between multiplexer and $self
3073 @_, 4097 @_,
3074 ); 4098 );
3075 4099
3076 $self->{filter}->add ($self->{multiplexer}) if $self->{filter}; 4100 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3077 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer}); 4101 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
3078 4102
4103 {
4104 Scalar::Util::weaken (my $wself = $self);
4105
4106 $self->{multiplexer}->connect (c_add => sub {
4107 my ($mplex, $widgets) = @_;
4108
4109 for my $child (@$widgets) {
4110 Scalar::Util::weaken $child;
4111 $child->{c_tab_} ||= do {
4112 my $tab =
4113 (UNIVERSAL::isa $child->{c_tab}, "DC::UI::Base")
4114 ? $child->{c_tab}
4115 : new DC::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
4116
4117 $tab->connect (activate => sub {
4118 $wself->set_current_page ($child);
4119 });
4120
4121 $tab
4122 };
4123
4124 $self->{buttonbar}->add ($child->{c_tab_});
4125 }
4126 });
4127
4128 $self->{multiplexer}->connect (c_remove => sub {
4129 my ($mplex, $widgets) = @_;
4130
4131 for my $child (@$widgets) {
4132 $wself->{buttonbar}->remove ($child->{c_tab_});
4133 }
4134 });
4135 }
4136
3079 $self 4137 $self
3080} 4138}
3081 4139
3082sub add { 4140sub add {
4141 my ($self, @widgets) = @_;
4142
4143 $self->{multiplexer}->add (@widgets)
4144}
4145
4146sub remove {
4147 my ($self, @widgets) = @_;
4148
4149 $self->{multiplexer}->remove (@widgets)
4150}
4151
4152sub pages {
4153 my ($self) = @_;
4154 $self->{multiplexer}->children
4155}
4156
4157sub page_index {
4158 my ($self, $widget) = @_;
4159
4160 my $i = 0;
4161 for ($self->pages) {
4162 if ($_ eq $widget) { return $i };
4163 $i++;
4164 }
4165
4166 undef
4167}
4168
4169sub add_tab {
3083 my ($self, $title, $widget, $tooltip) = @_; 4170 my ($self, $title, $widget, $tooltip) = @_;
3084 4171
3085 Scalar::Util::weaken $self; 4172 $title = [$title, $tooltip] unless ref $title;
4173 $widget->{c_tab} = $title;
3086 4174
3087 $self->{buttonbar}->add (new CFClient::UI::Button
3088 markup => $title,
3089 tooltip => $tooltip,
3090 on_activate => sub { $self->set_current_page ($widget) },
3091 );
3092
3093 $self->{multiplexer}->add ($widget); 4175 $self->add ($widget);
4176}
4177
4178sub get_current_page {
4179 my ($self) = @_;
4180
4181 $self->{multiplexer}->get_current_page
3094} 4182}
3095 4183
3096sub set_current_page { 4184sub set_current_page {
3097 my ($self, $page) = @_; 4185 my ($self, $page) = @_;
3098 4186
3099 $self->{multiplexer}->set_current_page ($page); 4187 $self->{multiplexer}->set_current_page ($page);
3100 $self->_emit (page_changed => $self->{multiplexer}{current}); 4188 $self->emit (page_changed => $self->{multiplexer}{current});
4189}
4190
4191sub _draw {
4192 my ($self) = @_;
4193
4194 $self->SUPER::_draw ();
4195
4196 if (my $cur = $self->{multiplexer}{current}) {
4197 if ($cur = $cur->{c_tab_}) {
4198 glTranslate $self->{buttonbar}{x} + $cur->{x},
4199 $self->{buttonbar}{y} + $cur->{y};
4200 glLineWidth 3;
4201 #glEnable GL_BLEND;
4202 #glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
4203 glColor @{$self->{active_outline}};
4204 glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
4205 glLineWidth 1;
4206 #glDisable GL_BLEND;
4207 }
4208 }
3101} 4209}
3102 4210
3103############################################################################# 4211#############################################################################
3104 4212
3105package CFClient::UI::Combobox; 4213package DC::UI::Selector;
3106 4214
3107use utf8; 4215use utf8;
3108 4216
3109our @ISA = CFClient::UI::Button::; 4217our @ISA = DC::UI::Button::;
3110 4218
3111sub new { 4219sub new {
3112 my $class = shift; 4220 my $class = shift;
3113 4221
3114 my $self = $class->SUPER::new ( 4222 my $self = $class->SUPER::new (
3115 options => [], # [title, value, tooltip], ... 4223 options => [], # [value, title, longdesc], ...
3116 value => undef, 4224 value => undef,
3117 @_, 4225 @_,
3118 ); 4226 );
3119 4227
3120 $self->_set_value ($self->{value}); 4228 $self->_set_value ($self->{value});
3121 4229
3122 $self 4230 $self
3123} 4231}
3124 4232
3125sub button_down { 4233sub invoke_button_down {
3126 my ($self, $ev) = @_; 4234 my ($self, $ev) = @_;
3127 4235
3128 my @menu_items; 4236 my @menu_items;
3129 4237
3130 for (@{ $self->{options} }) { 4238 for (@{ $self->{options} }) {
3131 my ($title, $value, $tooltip) = @$_; 4239 my ($value, $title, $tooltip) = @$_;
3132 4240
3133 push @menu_items, [$tooltip, sub { $self->set_value ($value) }]; 4241 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3134 } 4242 }
3135 4243
3136 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 4244 DC::UI::Menu->new (items => \@menu_items)->popup ($ev);
3137} 4245}
3138 4246
3139sub _set_value { 4247sub _set_value {
3140 my ($self, $value) = @_; 4248 my ($self, $value) = @_;
3141 4249
3142 my ($item) = grep $_->[1] eq $value, @{ $self->{options} } 4250 my ($item) = grep $_->[0] eq $value, @{ $self->{options} };
4251 $item ||= $self->{options}[0]
3143 or return; 4252 or return;
3144 4253
3145 $self->{value} = $item->[1]; 4254 $self->{value} = $item->[0];
3146 $self->set_markup ("$item->[0] ⇓"); 4255 $self->set_markup ("$item->[1] ⇓");
3147 $self->set_tooltip ($item->[2]); 4256# $self->set_tooltip ($item->[2]);
3148} 4257}
3149 4258
3150sub set_value { 4259sub set_value {
3151 my ($self, $value) = @_; 4260 my ($self, $value) = @_;
3152 4261
3153 return unless $self->{value} ne $value; 4262 return unless $self->{value} ne $value;
3154 4263
3155 $self->_set_value ($value); 4264 $self->_set_value ($value);
3156 $self->_emit (changed => $value); 4265 $self->emit (changed => $value);
4266}
4267
4268sub set_options {
4269 my ($self, $options) = @_;
4270
4271 $self->{options} = $options;
4272 $self->_set_value ($self->{value});
3157} 4273}
3158 4274
3159############################################################################# 4275#############################################################################
3160 4276
3161package CFClient::UI::Statusbox; 4277package DC::UI::Statusbox;
3162 4278
3163our @ISA = CFClient::UI::VBox::; 4279our @ISA = DC::UI::VBox::;
3164 4280
3165sub new { 4281sub new {
3166 my $class = shift; 4282 my $class = shift;
3167 4283
3168 my $self = $class->SUPER::new ( 4284 my $self = $class->SUPER::new (
3169 fontsize => 0.8, 4285 fontsize => 0.8,
3170 @_, 4286 @_,
3171 ); 4287 );
3172 4288
3173 Scalar::Util::weaken (my $this = $self); 4289 DC::weaken (my $this = $self);
3174 4290
3175 $self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder }); 4291 $self->{timer} = EV::timer 1, 1, sub { $this->reorder };
3176 4292
3177 $self 4293 $self
3178} 4294}
3179 4295
3180sub reorder { 4296sub reorder {
3181 my ($self) = @_; 4297 my ($self) = @_;
3182 my $NOW = Time::HiRes::time; 4298 my $NOW = AE::time;
3183 4299
3184 # freeze display when hovering over any label 4300 # freeze display when hovering over any label
3185 return if $CFClient::UI::TOOLTIP->{owner} 4301 return if $DC::UI::TOOLTIP->{owner}
3186 && grep $CFClient::UI::TOOLTIP->{owner} == $_->{label}, 4302 && grep $DC::UI::TOOLTIP->{owner} == $_->{label},
3187 values %{ $self->{item} }; 4303 values %{ $self->{item} };
3188 4304
3189 while (my ($k, $v) = each %{ $self->{item} }) { 4305 while (my ($k, $v) = each %{ $self->{item} }) {
3190 delete $self->{item}{$k} if $v->{timeout} < $NOW; 4306 delete $self->{item}{$k} if $v->{timeout} < $NOW;
3191 } 4307 }
4308
4309 $self->{timer}->set (1, 1);
3192 4310
3193 my @widgets; 4311 my @widgets;
3194 4312
3195 my @items = sort { 4313 my @items = sort {
3196 $a->{pri} <=> $b->{pri} 4314 $a->{pri} <=> $b->{pri}
3197 or $b->{id} <=> $a->{id} 4315 or $b->{id} <=> $a->{id}
3198 } values %{ $self->{item} }; 4316 } values %{ $self->{item} };
3199
3200 $self->{timer}->interval (1);
3201 4317
3202 my $count = 10 + 1; 4318 my $count = 10 + 1;
3203 for my $item (@items) { 4319 for my $item (@items) {
3204 last unless --$count; 4320 last unless --$count;
3205 4321
… …
3212 for ($short) { 4328 for ($short) {
3213 s/^\s+//; 4329 s/^\s+//;
3214 s/\s+/ /g; 4330 s/\s+/ /g;
3215 } 4331 }
3216 4332
3217 new CFClient::UI::Label 4333 new DC::UI::Label
3218 markup => $short, 4334 markup => $short,
3219 tooltip => $item->{tooltip}, 4335 tooltip => $item->{tooltip},
3220 tooltip_font => $::FONT_PROP, 4336 tooltip_font => $::FONT_PROP,
3221 tooltip_width => 0.67, 4337 tooltip_width => 0.67,
3222 fontsize => $item->{fontsize} || $self->{fontsize}, 4338 fontsize => $item->{fontsize} || $self->{fontsize},
3223 max_w => $::WIDTH * 0.44, 4339 max_w => $::WIDTH * 0.44,
4340 align => 0,
3224 fg => [@{ $item->{fg} }], 4341 fg => [@{ $item->{fg} }],
3225 can_events => 1, 4342 can_events => 1,
3226 can_hover => 1 4343 can_hover => 1
3227 }; 4344 };
3228 4345
3229 if ((my $diff = $item->{timeout} - $NOW) < 2) { 4346 if ((my $diff = $item->{timeout} - $NOW) < 2) {
3230 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2; 4347 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
3231 $label->update; 4348 $label->update;
3232 $label->set_max_size (undef, $label->{req_h} * $diff) 4349 $label->set_max_size (undef, $label->{req_h} * $diff)
3233 if $diff < 1; 4350 if $diff < 1;
3234 $self->{timer}->interval (1/30); 4351 $self->{timer}->set (1/30, 1/30);
3235 } else { 4352 } else {
3236 $label->{fg}[3] = $item->{fg}[3] || 1; 4353 $label->{fg}[3] = $item->{fg}[3] || 1;
3237 } 4354 }
3238 4355
3239 push @widgets, $label; 4356 push @widgets, $label;
3240 } 4357 }
4358
4359 my $hash = join ",", @widgets;
4360 return if $hash eq $self->{last_widget_hash};
4361 $self->{last_widget_hash} = $hash;
3241 4362
3242 $self->clear; 4363 $self->clear;
3243 $self->SUPER::add (reverse @widgets); 4364 $self->SUPER::add (reverse @widgets);
3244} 4365}
3245 4366
… …
3260 $item->{count}++; 4381 $item->{count}++;
3261 } else { 4382 } else {
3262 $item->{count} = 1; 4383 $item->{count} = 1;
3263 $item->{text} = $item->{tooltip} = $text; 4384 $item->{text} = $item->{tooltip} = $text;
3264 } 4385 }
3265 $item->{id} = ++$self->{id}; 4386 $item->{id} += 0.2;#d#
3266 $item->{timeout} = $timeout; 4387 $item->{timeout} = $timeout;
3267 delete $item->{label}; 4388 delete $item->{label};
3268 } else { 4389 } else {
3269 $self->{item}{$group} = { 4390 $self->{item}{$group} = {
3270 id => ++$self->{id}, 4391 id => ++$self->{id},
… …
3276 count => 1, 4397 count => 1,
3277 %arg, 4398 %arg,
3278 }; 4399 };
3279 } 4400 }
3280 4401
4402 $ROOT->on_refresh (reorder => sub {
3281 $self->reorder; 4403 $self->reorder;
4404 });
3282} 4405}
3283 4406
3284sub reconfigure { 4407sub reconfigure {
3285 my ($self) = @_; 4408 my ($self) = @_;
3286 4409
… …
3289 4412
3290 $self->reorder; 4413 $self->reorder;
3291 $self->SUPER::reconfigure; 4414 $self->SUPER::reconfigure;
3292} 4415}
3293 4416
3294sub DESTROY { 4417sub destroy {
3295 my ($self) = @_; 4418 my ($self) = @_;
3296 4419
3297 $self->{timer}->cancel; 4420 $self->{timer}->cancel;
3298 4421
3299 $self->SUPER::DESTROY; 4422 $self->SUPER::destroy;
3300} 4423}
3301 4424
3302############################################################################# 4425#############################################################################
3303 4426
3304package CFClient::UI::Inventory;
3305
3306our @ISA = CFClient::UI::ScrolledWindow::;
3307
3308sub new {
3309 my $class = shift;
3310
3311 my $self = $class->SUPER::new (
3312 child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3313 @_,
3314 );
3315
3316 $self
3317}
3318
3319sub set_items {
3320 my ($self, $items) = @_;
3321
3322 $self->{child}->clear;
3323 return unless $items;
3324
3325 my @items = sort {
3326 ($a->{type} <=> $b->{type})
3327 or ($a->{name} cmp $b->{name})
3328 } @$items;
3329
3330 $self->{real_items} = \@items;
3331
3332 my $row = 0;
3333 for my $item (@items) {
3334 CFClient::Item::update_widgets $item;
3335
3336 $self->{child}->add (0, $row, $item->{face_widget});
3337 $self->{child}->add (1, $row, $item->{desc_widget});
3338 $self->{child}->add (2, $row, $item->{weight_widget});
3339
3340 $row++;
3341 }
3342}
3343
3344#############################################################################
3345
3346package CFClient::UI::BindEditor;
3347
3348our @ISA = CFClient::UI::FancyFrame::;
3349
3350sub new {
3351 my $class = shift;
3352
3353 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3354
3355 $self->add (my $vb = new CFClient::UI::VBox);
3356
3357
3358 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3359 text => "start recording",
3360 tooltip => "Start/Stops recording of actions."
3361 ."All subsequent actions after the recording started will be captured."
3362 ."The actions are displayed after the record was stopped."
3363 ."To bind the action you have to click on the 'Bind' button",
3364 on_activate => sub {
3365 unless ($self->{recording}) {
3366 $self->start;
3367 } else {
3368 $self->stop;
3369 }
3370 });
3371
3372 $vb->add (new CFClient::UI::Label text => "Actions:");
3373 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3374
3375 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3376 $vb->add (my $hb = new CFClient::UI::HBox);
3377 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3378 $hb->add (new CFClient::UI::Button
3379 text => "bind",
3380 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3381 on_activate => sub {
3382 $self->ask_for_bind;
3383 });
3384
3385 $vb->add (my $hb = new CFClient::UI::HBox);
3386 $hb->add (new CFClient::UI::Button
3387 text => "ok",
3388 expand => 1,
3389 tooltip => "This closes the binding editor and saves the binding",
3390 on_activate => sub {
3391 $self->hide;
3392 $self->commit;
3393 });
3394
3395 $hb->add (new CFClient::UI::Button
3396 text => "cancel",
3397 expand => 1,
3398 tooltip => "This closes the binding editor without saving",
3399 on_activate => sub {
3400 $self->hide;
3401 $self->{binding_cancel}->()
3402 if $self->{binding_cancel};
3403 });
3404
3405 $self->update_binding_widgets;
3406
3407 $self
3408}
3409
3410sub commit {
3411 my ($self) = @_;
3412 my ($mod, $sym, $cmds) = $self->get_binding;
3413 if ($sym != 0 && @$cmds > 0) {
3414 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3415 ."'. Don't forget 'Save Config'!");
3416 $self->{binding_change}->($mod, $sym, $cmds)
3417 if $self->{binding_change};
3418 } else {
3419 $::STATUSBOX->add ("No action bound, no key or action specified!");
3420 $self->{binding_cancel}->()
3421 if $self->{binding_cancel};
3422 }
3423}
3424
3425sub start {
3426 my ($self) = @_;
3427
3428 $self->{rec_btn}->set_text ("stop recording");
3429 $self->{recording} = 1;
3430 $self->clear_command_list;
3431 $::CONN->start_record if $::CONN;
3432}
3433
3434sub stop {
3435 my ($self) = @_;
3436
3437 $self->{rec_btn}->set_text ("start recording");
3438 $self->{recording} = 0;
3439
3440 my $rec;
3441 $rec = $::CONN->stop_record if $::CONN;
3442 return unless ref $rec eq 'ARRAY';
3443 $self->set_command_list ($rec);
3444}
3445
3446
3447sub ask_for_bind_and_commit {
3448 my ($self) = @_;
3449 $self->ask_for_bind (1);
3450}
3451
3452sub ask_for_bind {
3453 my ($self, $commit) = @_;
3454
3455 CFClient::Binder::open_binding_dialog (sub {
3456 my ($mod, $sym) = @_;
3457 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3458 $self->update_binding_widgets;
3459 $self->commit if $commit;
3460 });
3461}
3462
3463# $mod and $sym are the modifiers and key symbol
3464# $cmds is a array ref of strings (the commands)
3465# $cb is the callback that is executed on OK
3466# $ccb is the callback that is executed on CANCEL and
3467# when the binding was unsuccessful on OK
3468sub set_binding {
3469 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3470
3471 $self->clear_command_list;
3472 $self->{recording} = 0;
3473 $self->{rec_btn}->set_text ("start recording");
3474
3475 $self->{binding} = [$mod, $sym];
3476 $self->{commands} = $cmds;
3477
3478 $self->{binding_change} = $cb;
3479 $self->{binding_cancel} = $ccb;
3480
3481 $self->update_binding_widgets;
3482}
3483
3484# this is a shortcut method that asks for a binding
3485# and then just binds it.
3486sub do_quick_binding {
3487 my ($self, $cmds) = @_;
3488 $self->set_binding (undef, undef, $cmds, sub {
3489 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3490 });
3491 $self->ask_for_bind (1);
3492}
3493
3494sub update_binding_widgets {
3495 my ($self) = @_;
3496 my ($mod, $sym, $cmds) = $self->get_binding;
3497 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3498 $self->set_command_list ($cmds);
3499}
3500
3501sub get_binding {
3502 my ($self) = @_;
3503 return (
3504 $self->{binding}->[0],
3505 $self->{binding}->[1],
3506 [ grep { defined $_ } @{$self->{commands}} ]
3507 );
3508}
3509
3510sub clear_command_list {
3511 my ($self) = @_;
3512 $self->{cmdbox}->clear ();
3513}
3514
3515sub set_command_list {
3516 my ($self, $cmds) = @_;
3517
3518 $self->{cmdbox}->clear ();
3519 $self->{commands} = $cmds;
3520
3521 my $idx = 0;
3522
3523 for (@$cmds) {
3524 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3525
3526 my $i = $idx;
3527 $hb->add (new CFClient::UI::Label text => $_);
3528 $hb->add (new CFClient::UI::Button
3529 text => "delete",
3530 tooltip => "Deletes the action from the record",
3531 on_activate => sub {
3532 $self->{cmdbox}->remove ($hb);
3533 $cmds->[$i] = undef;
3534 });
3535
3536
3537 $idx++
3538 }
3539}
3540
3541#############################################################################
3542
3543package CFClient::UI::SpellList;
3544
3545our @ISA = CFClient::UI::Table::;
3546
3547sub new {
3548 my $class = shift;
3549
3550 my $self = $class->SUPER::new (
3551 binding => [],
3552 commands => [],
3553 @_,
3554 )
3555}
3556
3557my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3558 "<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.");
3559my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3560 "<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.");
3561my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3562 "<b>Damage</b>. The amount of damage the spell deals when it hits.");
3563
3564sub rebuild_spell_list {
3565 my ($self) = @_;
3566
3567 $CFClient::UI::ROOT->on_refresh ($self => sub {
3568 $self->clear;
3569
3570 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name");
3571 $self->add (2, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3572 $self->add (3, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3573 $self->add (4, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3574
3575 my $row = 0;
3576
3577 for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3578 my $spell = $self->{spell}{$_};
3579
3580 $row++;
3581
3582 $self->add (0, $row, new CFClient::UI::Face
3583 face => $spell->{face},
3584 can_hover => 1,
3585 can_events => 1,
3586 tooltip => $spell->{message},
3587 );
3588
3589 $self->add (1, $row, new CFClient::UI::Label
3590 expand => 1,
3591 text => $spell->{name},
3592 can_hover => 1,
3593 can_events => 1,
3594 tooltip => $spell->{message},
3595 );
3596
3597 $self->add (2, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3598 $self->add (3, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3599 $self->add (4, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3600
3601 # TODO: should be done via popup
3602 $self->add (5, $row, new CFClient::UI::Button
3603 text => "bind",
3604 tooltip => "bind spell readying (cast command) to key",
3605 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) },
3606 );
3607 }
3608 });
3609}
3610
3611sub add_spell {
3612 my ($self, $spell) = @_;
3613
3614 $self->{spell}->{$spell->{name}} = $spell;
3615 $self->rebuild_spell_list;
3616}
3617
3618sub remove_spell {
3619 my ($self, $spell) = @_;
3620
3621 delete $self->{spell}->{$spell->{name}};
3622 $self->rebuild_spell_list;
3623}
3624
3625#############################################################################
3626
3627package CFClient::UI::Root; 4427package DC::UI::Root;
3628 4428
3629our @ISA = CFClient::UI::Container::; 4429our @ISA = DC::UI::Container::;
3630 4430
3631use List::Util qw(min max); 4431use List::Util qw(min max);
3632 4432
3633use CFClient::OpenGL; 4433use DC::OpenGL;
3634 4434
3635sub new { 4435sub new {
3636 my $class = shift; 4436 my $class = shift;
3637 4437
3638 my $self = $class->SUPER::new ( 4438 my $self = $class->SUPER::new (
3639 visible => 1, 4439 visible => 1,
3640 @_, 4440 @_,
3641 ); 4441 );
3642 4442
3643 Scalar::Util::weaken ($self->{root} = $self); 4443 DC::weaken ($self->{root} = $self);
3644 4444
3645 $self 4445 $self
3646} 4446}
3647 4447
3648sub size_request { 4448sub size_request {
… …
3663 $coord = $max - $size if $coord > $max - $size; 4463 $coord = $max - $size if $coord > $max - $size;
3664 4464
3665 int $coord + 0.5 4465 int $coord + 0.5
3666} 4466}
3667 4467
3668sub size_allocate { 4468sub invoke_size_allocate {
3669 my ($self, $w, $h) = @_; 4469 my ($self, $w, $h) = @_;
3670 4470
3671 for my $child ($self->children) { 4471 for my $child ($self->children) {
3672 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 4472 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3673 4473
… …
3677 $X = _to_pixel $X, $W, $self->{w}; 4477 $X = _to_pixel $X, $W, $self->{w};
3678 $Y = _to_pixel $Y, $H, $self->{h}; 4478 $Y = _to_pixel $Y, $H, $self->{h};
3679 4479
3680 $child->configure ($X, $Y, $W, $H); 4480 $child->configure ($X, $Y, $W, $H);
3681 } 4481 }
4482
4483 1
3682} 4484}
3683 4485
3684sub coord2local { 4486sub coord2local {
3685 my ($self, $x, $y) = @_; 4487 my ($self, $x, $y) = @_;
3686 4488
… …
3694} 4496}
3695 4497
3696sub update { 4498sub update {
3697 my ($self) = @_; 4499 my ($self) = @_;
3698 4500
3699 $::WANT_REFRESH++; 4501 $::WANT_REFRESH = 1;
3700} 4502}
3701 4503
3702sub add { 4504sub add {
3703 my ($self, @children) = @_; 4505 my ($self, @children) = @_;
3704 4506
… …
3741 while ($self->{refresh_hook}) { 4543 while ($self->{refresh_hook}) {
3742 $_->() 4544 $_->()
3743 for values %{delete $self->{refresh_hook}}; 4545 for values %{delete $self->{refresh_hook}};
3744 } 4546 }
3745 4547
3746 if ($self->{realloc}) { 4548 while ($self->{realloc}) {
3747 my %queue; 4549 my %queue;
3748 my @queue; 4550 my @queue;
3749 my $widget; 4551 my $widget;
3750 4552
3751 outer: 4553 outer:
… …
3771 4573
3772 delete $queue{$widget+0}; 4574 delete $queue{$widget+0};
3773 4575
3774 my ($w, $h) = $widget->size_request; 4576 my ($w, $h) = $widget->size_request;
3775 4577
3776 $w = max $widget->{min_w}, $w + $widget->{padding_x} * 2; 4578 $w += $widget->{padding_x} * 2;
3777 $h = max $widget->{min_h}, $h + $widget->{padding_y} * 2; 4579 $h += $widget->{padding_y} * 2;
4580
4581 $w = max $widget->{min_w}, $w;
4582 $h = max $widget->{min_h}, $h;
3778 4583
3779 $w = min $widget->{max_w}, $w if exists $widget->{max_w}; 4584 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3780 $h = min $widget->{max_h}, $h if exists $widget->{max_h}; 4585 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3781 4586
3782 $w = $widget->{force_w} if exists $widget->{force_w}; 4587 $w = $widget->{force_w} if exists $widget->{force_w};
… …
3798 } 4603 }
3799 } 4604 }
3800 4605
3801 delete $self->{realloc}{$widget+0}; 4606 delete $self->{realloc}{$widget+0};
3802 } 4607 }
3803 }
3804 4608
3805 while (my $size_alloc = delete $self->{size_alloc}) { 4609 while (my $size_alloc = delete $self->{size_alloc}) {
3806 my @queue = sort { $b->{visible} <=> $a->{visible} } 4610 my @queue = sort { $a->{visible} <=> $b->{visible} }
3807 values %$size_alloc; 4611 values %$size_alloc;
3808 4612
3809 while () { 4613 while () {
3810 my $widget = pop @queue || last; 4614 my $widget = pop @queue || last;
3811 4615
3812 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 4616 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3813 4617
3814 $w = 0 if $w < 0; 4618 $w = max $widget->{min_w}, $w;
3815 $h = 0 if $h < 0; 4619 $h = max $widget->{min_h}, $h;
3816 4620
4621# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
4622# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
4623
4624 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
4625 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
4626
3817 $w = int $w + 0.5; 4627 $w = int $w + 0.5;
3818 $h = int $h + 0.5; 4628 $h = int $h + 0.5;
3819 4629
3820 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 4630 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3821 $widget->{old_w} = $widget->{w}; 4631 $widget->{old_w} = $widget->{w};
3822 $widget->{old_h} = $widget->{h}; 4632 $widget->{old_h} = $widget->{h};
3823 4633
3824 $widget->{w} = $w; 4634 $widget->{w} = $w;
3825 $widget->{h} = $h; 4635 $widget->{h} = $h;
3826 4636
3827 $widget->emit (size_allocate => $w, $h); 4637 $widget->emit (size_allocate => $w, $h);
4638 }
3828 } 4639 }
3829 } 4640 }
3830 } 4641 }
3831 4642
3832 while ($self->{post_alloc_hook}) { 4643 while ($self->{post_alloc_hook}) {
3833 $_->() 4644 $_->()
3834 for values %{delete $self->{post_alloc_hook}}; 4645 for values %{delete $self->{post_alloc_hook}};
3835 } 4646 }
3836
3837 4647
3838 glViewport 0, 0, $::WIDTH, $::HEIGHT; 4648 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3839 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 4649 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3840 glClear GL_COLOR_BUFFER_BIT; 4650 glClear GL_COLOR_BUFFER_BIT;
3841 4651
… …
3844 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 4654 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3845 glMatrixMode GL_MODELVIEW; 4655 glMatrixMode GL_MODELVIEW;
3846 glLoadIdentity; 4656 glLoadIdentity;
3847 4657
3848 { 4658 {
3849 package CFClient::UI::Base; 4659 package DC::UI::Base;
3850 4660
3851 ($draw_x, $draw_y, $draw_w, $draw_h) = 4661 local ($draw_x, $draw_y, $draw_w, $draw_h) =
3852 (0, 0, $self->{w}, $self->{h}); 4662 (0, 0, $self->{w}, $self->{h});
3853 }
3854 4663
3855 $self->_draw; 4664 $self->_draw;
4665 }
3856} 4666}
3857 4667
3858############################################################################# 4668#############################################################################
3859 4669
3860package CFClient::UI; 4670package DC::UI;
3861 4671
3862$ROOT = new CFClient::UI::Root; 4672$ROOT = new DC::UI::Root;
3863$TOOLTIP = new CFClient::UI::Tooltip z => 900; 4673$TOOLTIP = new DC::UI::Tooltip z => 900;
3864 4674
38651 46751
3866

Diff Legend

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