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.280 by root, Mon Jun 5 01:22:08 2006 UTC vs.
Revision 1.473 by root, Sun Jan 11 03:19:47 2009 UTC

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

Diff Legend

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