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.283 by root, Mon Jun 5 02:28:30 2006 UTC vs.
Revision 1.477 by root, Sun Jan 11 23:50:27 2009 UTC

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

Diff Legend

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