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.302 by root, Mon Jun 12 13:26:14 2006 UTC vs.
Revision 1.479 by root, Thu Feb 4 20:01:09 2010 UTC

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

Diff Legend

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