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.279 by root, Mon Jun 5 00:17:47 2006 UTC vs.
Revision 1.468 by root, Wed Sep 3 10:36:25 2008 UTC

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

Diff Legend

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