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.311 by root, Fri Jun 23 22:35:16 2006 UTC vs.
Revision 1.440 by root, Sun Sep 16 18:27:48 2007 UTC

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

Diff Legend

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