ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.296 by root, Wed Jun 7 05:48:53 2006 UTC vs.
Revision 1.489 by root, Sun Nov 25 14:37:18 2012 UTC

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

Diff Legend

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