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.312 by root, Fri Jun 23 23:54:30 2006 UTC vs.
Revision 1.472 by root, Wed Dec 24 04:09:27 2008 UTC

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

Diff Legend

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