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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.312 by root, Fri Jun 23 23:54:30 2006 UTC vs.
Revision 1.345 by root, Sun Aug 13 21:46:10 2006 UTC

1package CFClient::UI; 1package CFPlus::UI;
2 2
3use utf8; 3use utf8;
4use strict; 4use strict;
5 5
6use Scalar::Util (); 6use Scalar::Util ();
7use List::Util (); 7use List::Util ();
8use Event; 8use Event;
9 9
10use CFClient; 10use CFPlus;
11use CFPlus::Pod;
11use CFClient::Texture; 12use CFPlus::Texture;
12 13
13our ($FOCUS, $HOVER, $GRAB); # various widgets 14our ($FOCUS, $HOVER, $GRAB); # various widgets
14 15
15our $LAYOUT; 16our $LAYOUT;
16our $ROOT; 17our $ROOT;
79sub feed_sdl_key_up_event { 80sub feed_sdl_key_up_event {
80 $FOCUS->emit (key_up => $_[0]) 81 $FOCUS->emit (key_up => $_[0])
81 if $FOCUS; 82 if $FOCUS;
82} 83}
83 84
85sub check_hover {
86 my ($widget) = @_;
87
88 if ($widget != $HOVER) {
89 my $hover = $HOVER; $HOVER = $widget;
90
91 $hover->update if $hover && $hover->{can_hover};
92 $HOVER->update if $HOVER && $HOVER->{can_hover};
93
94 $TOOLTIP_WATCHER->start;
95 }
96}
97
84sub feed_sdl_button_down_event { 98sub feed_sdl_button_down_event {
85 my ($ev) = @_; 99 my ($ev) = @_;
86 my ($x, $y) = ($ev->{x}, $ev->{y}); 100 my ($x, $y) = ($ev->{x}, $ev->{y});
87 101
88 if (!$BUTTON_STATE) { 102 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
103
104 unless ($GRAB) {
89 my $widget = $ROOT->find_widget ($x, $y); 105 my $widget = $ROOT->find_widget ($x, $y);
90 106
91 $GRAB = $widget; 107 $GRAB = $widget;
92 $GRAB->update if $GRAB; 108 $GRAB->update if $GRAB;
93 109
94 $TOOLTIP_WATCHER->cb->(); 110 $TOOLTIP_WATCHER->cb->();
95 } 111 }
96 112
97 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 113 if ($GRAB) {
98 114 if ($ev->{button} == 4 || $ev->{button} == 5) {
99 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y)) 115 # mousewheel
100 if $GRAB; 116 $ev->{dx} = 0;
117 $ev->{dy} = $ev->{button} * 2 - 9;
118 $GRAB->emit (mouse_wheel => $ev);
119 } else {
120 $GRAB->emit (button_down => $ev)
121 }
122 }
101} 123}
102 124
103sub feed_sdl_button_up_event { 125sub feed_sdl_button_up_event {
104 my ($ev) = @_; 126 my ($ev) = @_;
105 my ($x, $y) = ($ev->{x}, $ev->{y});
106 127
107 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 128 my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108 129
109 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 130 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110 131
111 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y)) 132 $GRAB->emit (button_up => $ev)
112 if $GRAB; 133 if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113 134
114 if (!$BUTTON_STATE) { 135 unless ($BUTTON_STATE) {
115 my $grab = $GRAB; undef $GRAB; 136 my $grab = $GRAB; undef $GRAB;
116 $grab->update if $grab; 137 $grab->update if $grab;
117 $GRAB->update if $GRAB; 138 $GRAB->update if $GRAB;
118 139
140 check_hover $widget;
119 $TOOLTIP_WATCHER->cb->(); 141 $TOOLTIP_WATCHER->cb->();
120 } 142 }
121} 143}
122 144
123sub feed_sdl_motion_event { 145sub feed_sdl_motion_event {
124 my ($ev) = @_; 146 my ($ev) = @_;
125 my ($x, $y) = ($ev->{x}, $ev->{y}); 147 my ($x, $y) = ($ev->{x}, $ev->{y});
126 148
127 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 149 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128 150
129 if ($widget != $HOVER) { 151 check_hover $widget;
130 my $hover = $HOVER; $HOVER = $widget;
131 152
132 $hover->update if $hover && $hover->{can_hover}; 153 $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; 154 if $HOVER;
140} 155}
141 156
142# convert position array to integers 157# convert position array to integers
143sub harmonize { 158sub harmonize {
193 reconfigure_widgets; 208 reconfigure_widgets;
194} 209}
195 210
196############################################################################# 211#############################################################################
197 212
213package CFPlus::UI::Event;
214
215sub xy {
216 $_[1]->coord2local ($_[0]{x}, $_[0]{y})
217}
218
219#############################################################################
220
198package CFClient::UI::Base; 221package CFPlus::UI::Base;
199 222
200use strict; 223use strict;
201 224
202use CFClient::OpenGL; 225use CFPlus::OpenGL;
203 226
204sub new { 227sub new {
205 my $class = shift; 228 my $class = shift;
206 229
207 my $self = bless { 230 my $self = bless {
212 h => undef, 235 h => undef,
213 can_events => 1, 236 can_events => 1,
214 @_ 237 @_
215 }, $class; 238 }, $class;
216 239
217 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 240 Scalar::Util::weaken ($CFPlus::UI::WIDGET{$self+0} = $self);
218 241
219 for (keys %$self) { 242 for (keys %$self) {
220 if (/^on_(.*)$/) { 243 if (/^on_(.*)$/) {
221 $self->connect ($1 => delete $self->{$_}); 244 $self->connect ($1 => delete $self->{$_});
222 } 245 }
223 } 246 }
224 247
225 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) { 248 if (my $layout = $CFPlus::UI::LAYOUT->{$self->{name}}) {
226 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x}; 249 $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}; 250 $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}; 251 $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}; 252 $self->{force_h} = $layout->{h} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{h};
230 253
231 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x}; 254 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
232 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y}; 255 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
233 256
234 $self->show if $layout->{show}; 257 $self->show if $layout->{show};
247sub show { 270sub show {
248 my ($self) = @_; 271 my ($self) = @_;
249 272
250 return if $self->{parent}; 273 return if $self->{parent};
251 274
252 $CFClient::UI::ROOT->add ($self); 275 $CFPlus::UI::ROOT->add ($self);
253} 276}
254 277
255sub set_visible { 278sub set_visible {
256 my ($self) = @_; 279 my ($self) = @_;
257 280
278 delete $self->{root}; 301 delete $self->{root};
279 302
280 undef $GRAB if $GRAB == $self; 303 undef $GRAB if $GRAB == $self;
281 undef $HOVER if $HOVER == $self; 304 undef $HOVER if $HOVER == $self;
282 305
283 $CFClient::UI::TOOLTIP_WATCHER->cb->() 306 $CFPlus::UI::TOOLTIP_WATCHER->cb->()
284 if $TOOLTIP->{owner} == $self; 307 if $TOOLTIP->{owner} == $self;
285 308
286 $self->emit ("focus_out"); 309 $self->emit ("focus_out");
287 $self->emit (visibility_change => 0); 310 $self->emit (visibility_change => 0);
288} 311}
345 my ($self, $x, $y, $w, $h) = @_; 368 my ($self, $x, $y, $w, $h) = @_;
346 369
347 if ($self->{aspect}) { 370 if ($self->{aspect}) {
348 my ($ow, $oh) = ($w, $h); 371 my ($ow, $oh) = ($w, $h);
349 372
350 $w = List::Util::min $w, int $h * $self->{aspect}; 373 $w = List::Util::min $w, CFPlus::ceil $h * $self->{aspect};
351 $h = List::Util::min $h, int $w / $self->{aspect}; 374 $h = List::Util::min $h, CFPlus::ceil $w / $self->{aspect};
352 375
353 # use alignment to adjust x, y 376 # use alignment to adjust x, y
354 377
355 $x += int 0.5 * ($ow - $w); 378 $x += int 0.5 * ($ow - $w);
356 $y += int 0.5 * ($oh - $h); 379 $y += int 0.5 * ($oh - $h);
397 420
398 return if $self->{tooltip} eq $tooltip; 421 return if $self->{tooltip} eq $tooltip;
399 422
400 $self->{tooltip} = $tooltip; 423 $self->{tooltip} = $tooltip;
401 424
402 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 425 if ($CFPlus::UI::TOOLTIP->{owner} == $self) {
403 delete $CFClient::UI::TOOLTIP->{owner}; 426 delete $CFPlus::UI::TOOLTIP->{owner};
404 $CFClient::UI::TOOLTIP_WATCHER->cb->(); 427 $CFPlus::UI::TOOLTIP_WATCHER->cb->();
405 } 428 }
406} 429}
407 430
408# translate global coordinates to local coordinate system 431# translate global coordinates to local coordinate system
409sub coord2local { 432sub coord2local {
410 my ($self, $x, $y) = @_; 433 my ($self, $x, $y) = @_;
411 434
435 Carp::confess unless $self->{parent};#d#
436
412 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) 437 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
413} 438}
414 439
415# translate local coordinates to global coordinate system 440# translate local coordinates to global coordinate system
416sub coord2global { 441sub coord2global {
417 my ($self, $x, $y) = @_; 442 my ($self, $x, $y) = @_;
418 443
444 Carp::confess unless $self->{parent};#d#
445
419 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 446 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
420} 447}
421 448
422sub invoke_focus_in { 449sub invoke_focus_in {
423 my ($self) = @_; 450 my ($self) = @_;
424 451
425 return if $FOCUS == $self; 452 return if $FOCUS == $self;
426 return unless $self->{can_focus}; 453 return unless $self->{can_focus};
427 454
428 my $focus = $FOCUS; $FOCUS = $self; 455 $FOCUS = $self;
429 456
430 $focus->update if $focus; 457 $self->update;
431 $FOCUS->update;
432 458
433 0 459 0
434} 460}
435 461
436sub invoke_focus_out { 462sub invoke_focus_out {
437 my ($self) = @_; 463 my ($self) = @_;
438 464
439 return unless $FOCUS == $self; 465 return unless $FOCUS == $self;
440 466
441 my $focus = $FOCUS; undef $FOCUS; 467 undef $FOCUS;
442 468
443 $focus->update if $focus; #? 469 $self->update;
444 470
445 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus 471 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
446 unless $FOCUS; 472 unless $FOCUS;
447 473
448 0 474 0
449} 475}
450 476
451sub grab_focus { 477sub grab_focus {
452 my ($self) = @_; 478 my ($self) = @_;
453 479
480 $FOCUS->emit ("focus_out") if $FOCUS;
454 $self->emit ("focus_in"); 481 $self->emit ("focus_in");
455} 482}
456 483
457sub invoke_mouse_motion { 1 } 484sub invoke_mouse_motion { 0 }
458sub invoke_button_up { 1 } 485sub invoke_button_up { 0 }
459sub invoke_key_down { 1 } 486sub invoke_key_down { 0 }
460sub invoke_key_up { 1 } 487sub invoke_key_up { 0 }
488sub invoke_mouse_wheel { 0 }
461 489
462sub invoke_button_down { 490sub invoke_button_down {
463 my ($self, $ev, $x, $y) = @_; 491 my ($self, $ev, $x, $y) = @_;
464 492
465 $self->grab_focus; 493 $self->grab_focus;
466 494
467 1 495 0
468} 496}
469 497
470sub connect { 498sub connect {
471 my ($self, $signal, $cb) = @_; 499 my ($self, $signal, $cb) = @_;
472 500
473 push @{ $self->{signal_cb}{$signal} }, $cb; 501 push @{ $self->{signal_cb}{$signal} }, $cb;
502
503 defined wantarray and CFPlus::guard {
504 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
505 @{ $self->{signal_cb}{$signal} };
506 }
474} 507}
508
509my %has_coords = (
510 button_down => 1,
511 button_up => 1,
512 mouse_motion => 1,
513 mouse_wheel => 1,
514);
475 515
476sub emit { 516sub emit {
477 my ($self, $signal, @args) = @_; 517 my ($self, $signal, @args) = @_;
478 518
519 # I do not really like this solution, but I dislike duplication
520 # and needlessly verbose code, too.
521 my @append
522 = $has_coords{$signal}
523 ? $args[0]->xy ($self)
524 : ();
525
526 #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
527
479 #d##TODO# stop propagating at first true, do not use sum 528 #d##TODO# stop propagating at first true, do not use sum
480 (List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before 529 (List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
481 || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure 530 || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append) # closure
482 || ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent 531 || ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
483} 532}
484 533
485sub find_widget { 534sub find_widget {
486 my ($self, $x, $y) = @_; 535 my ($self, $x, $y) = @_;
487 536
571 glVertex $self->{w} - 1, 0; 620 glVertex $self->{w} - 1, 0;
572 glVertex $self->{w} - 1, $self->{h} - 1; 621 glVertex $self->{w} - 1, $self->{h} - 1;
573 glVertex 0 , $self->{h} - 1; 622 glVertex 0 , $self->{h} - 1;
574 glEnd; 623 glEnd;
575 glPopMatrix; 624 glPopMatrix;
576 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 625 #CFPlus::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
577 } 626 }
578 627
579 $self->_draw; 628 $self->_draw;
580 glPopMatrix; 629 glPopMatrix;
581} 630}
587} 636}
588 637
589sub DESTROY { 638sub DESTROY {
590 my ($self) = @_; 639 my ($self) = @_;
591 640
641 return if CFPlus::in_destruct;
642
592 delete $WIDGET{$self+0}; 643 delete $WIDGET{$self+0};
593 644
594 eval { $self->destroy }; 645 eval { $self->destroy };
595 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/; 646 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
596} 647}
597 648
598############################################################################# 649#############################################################################
599 650
600package CFClient::UI::DrawBG; 651package CFPlus::UI::DrawBG;
601 652
602our @ISA = CFClient::UI::Base::; 653our @ISA = CFPlus::UI::Base::;
603 654
604use strict; 655use strict;
605use CFClient::OpenGL; 656use CFPlus::OpenGL;
606 657
607sub new { 658sub new {
608 my $class = shift; 659 my $class = shift;
609 660
610 # range [value, low, high, page] 661 # range [value, low, high, page]
641 } 692 }
642} 693}
643 694
644############################################################################# 695#############################################################################
645 696
646package CFClient::UI::Empty; 697package CFPlus::UI::Empty;
647 698
648our @ISA = CFClient::UI::Base::; 699our @ISA = CFPlus::UI::Base::;
649 700
650sub new { 701sub new {
651 my ($class, %arg) = @_; 702 my ($class, %arg) = @_;
652 $class->SUPER::new (can_events => 0, %arg); 703 $class->SUPER::new (can_events => 0, %arg);
653} 704}
660 711
661sub draw { } 712sub draw { }
662 713
663############################################################################# 714#############################################################################
664 715
665package CFClient::UI::Container; 716package CFPlus::UI::Container;
666 717
667our @ISA = CFClient::UI::Base::; 718our @ISA = CFPlus::UI::Base::;
668 719
669sub new { 720sub new {
670 my ($class, %arg) = @_; 721 my ($class, %arg) = @_;
671 722
672 my $children = delete $arg{children}; 723 my $children = delete $arg{children};
681 if $children; 732 if $children;
682 733
683 $self 734 $self
684} 735}
685 736
737sub realloc {
738 my ($self) = @_;
739
740 $self->{force_realloc} = 1;
741 $self->{force_size_alloc} = 1;
742 $self->SUPER::realloc;
743}
744
686sub add { 745sub add {
687 my ($self, @widgets) = @_; 746 my ($self, @widgets) = @_;
688 747
689 $_->set_parent ($self) 748 $_->set_parent ($self)
690 for @widgets; 749 for @widgets;
750 $_->draw for @{$self->{children}}; 809 $_->draw for @{$self->{children}};
751} 810}
752 811
753############################################################################# 812#############################################################################
754 813
755package CFClient::UI::Bin; 814package CFPlus::UI::Bin;
756 815
757our @ISA = CFClient::UI::Container::; 816our @ISA = CFPlus::UI::Container::;
758 817
759sub new { 818sub new {
760 my ($class, %arg) = @_; 819 my ($class, %arg) = @_;
761 820
762 my $child = (delete $arg{child}) || new CFClient::UI::Empty::; 821 my $child = (delete $arg{child}) || new CFPlus::UI::Empty::;
763 822
764 $class->SUPER::new (children => [$child], %arg) 823 $class->SUPER::new (children => [$child], %arg)
765} 824}
766 825
767sub add { 826sub add {
774sub remove { 833sub remove {
775 my ($self, $widget) = @_; 834 my ($self, $widget) = @_;
776 835
777 $self->SUPER::remove ($widget); 836 $self->SUPER::remove ($widget);
778 837
779 $self->{children} = [new CFClient::UI::Empty] 838 $self->{children} = [new CFPlus::UI::Empty]
780 unless @{$self->{children}}; 839 unless @{$self->{children}};
781} 840}
782 841
783sub child { $_[0]->{children}[0] } 842sub child { $_[0]->{children}[0] }
784 843
796 855
797############################################################################# 856#############################################################################
798 857
799# back-buffered drawing area 858# back-buffered drawing area
800 859
801package CFClient::UI::Window; 860package CFPlus::UI::Window;
802 861
803our @ISA = CFClient::UI::Bin::; 862our @ISA = CFPlus::UI::Bin::;
804 863
805use CFClient::OpenGL; 864use CFPlus::OpenGL;
806 865
807sub new { 866sub new {
808 my ($class, %arg) = @_; 867 my ($class, %arg) = @_;
809 868
810 my $self = $class->SUPER::new (%arg); 869 my $self = $class->SUPER::new (%arg);
832} 891}
833 892
834sub render_child { 893sub render_child {
835 my ($self) = @_; 894 my ($self) = @_;
836 895
837 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 896 $self->{texture} = new_from_opengl CFPlus::Texture $self->{w}, $self->{h}, sub {
838 glClearColor 0, 0, 0, 0; 897 glClearColor 0, 0, 0, 0;
839 glClear GL_COLOR_BUFFER_BIT; 898 glClear GL_COLOR_BUFFER_BIT;
840 899
841 { 900 {
842 package CFClient::UI::Base; 901 package CFPlus::UI::Base;
843 902
844 ($draw_x, $draw_y, $draw_w, $draw_h) = 903 ($draw_x, $draw_y, $draw_w, $draw_h) =
845 (0, 0, $self->{w}, $self->{h}); 904 (0, 0, $self->{w}, $self->{h});
846 } 905 }
847 906
850} 909}
851 910
852sub _draw { 911sub _draw {
853 my ($self) = @_; 912 my ($self) = @_;
854 913
855 my ($w, $h) = @$self{qw(w h)};
856
857 my $tex = $self->{texture} 914 my $tex = $self->{texture}
858 or return; 915 or return;
859 916
860 glEnable GL_TEXTURE_2D; 917 glEnable GL_TEXTURE_2D;
861 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 918 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
862 glColor 0, 0, 0, 1; 919 glColor 0, 0, 0, 1;
863 920
864 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h); 921 $tex->draw_quad_alpha_premultiplied (0, 0);
865 922
866 glDisable GL_TEXTURE_2D; 923 glDisable GL_TEXTURE_2D;
867} 924}
868 925
869############################################################################# 926#############################################################################
870 927
871package CFClient::UI::ViewPort; 928package CFPlus::UI::ViewPort;
872 929
873our @ISA = CFClient::UI::Window::; 930our @ISA = CFPlus::UI::Window::;
874 931
875sub new { 932sub new {
876 my $class = shift; 933 my $class = shift;
877 934
878 $class->SUPER::new ( 935 $class->SUPER::new (
938 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w} 995 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
939 && $y >= $self->{y} && $y < $self->{y} + $self->{h} 996 && $y >= $self->{y} && $y < $self->{y} + $self->{h}
940 ) { 997 ) {
941 $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})
942 } else { 999 } else {
943 $self->CFClient::UI::Base::find_widget ($x, $y) 1000 $self->CFPlus::UI::Base::find_widget ($x, $y)
944 } 1001 }
945} 1002}
946 1003
947sub _render { 1004sub _render {
948 my ($self) = @_; 1005 my ($self) = @_;
949 1006
950 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};
951 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};
952 1009
953 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 1010 CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
954 1011
955 $self->SUPER::_render; 1012 $self->SUPER::_render;
956} 1013}
957 1014
958############################################################################# 1015#############################################################################
959 1016
960package CFClient::UI::ScrolledWindow; 1017package CFPlus::UI::ScrolledWindow;
961 1018
962our @ISA = CFClient::UI::HBox::; 1019our @ISA = CFPlus::UI::HBox::;
963 1020
964sub new { 1021sub new {
965 my ($class, %arg) = @_; 1022 my ($class, %arg) = @_;
966 1023
967 my $child = delete $arg{child}; 1024 my $child = delete $arg{child};
968 1025
969 my $self; 1026 my $self;
970 1027
971 my $slider = new CFClient::UI::Slider 1028 my $slider = new CFPlus::UI::Slider
972 vertical => 1, 1029 vertical => 1,
973 range => [0, 0, 1, 0.01], # HACK fix 1030 range => [0, 0, 1, 0.01], # HACK fix
974 on_changed => sub { 1031 on_changed => sub {
975 $self->{vp}->set_offset (0, $_[1]); 1032 $self->{vp}->set_offset (0, $_[1]);
976 }, 1033 },
977 ; 1034 ;
978 1035
979 $self = $class->SUPER::new ( 1036 $self = $class->SUPER::new (
980 vp => (new CFClient::UI::ViewPort expand => 1), 1037 vp => (new CFPlus::UI::ViewPort expand => 1),
1038 can_events => 1,
981 slider => $slider, 1039 slider => $slider,
982 %arg, 1040 %arg,
983 ); 1041 );
984 1042
985 $self->SUPER::add ($self->{vp}, $self->{slider}); 1043 $self->SUPER::add ($self->{vp}, $self->{slider});
986 $self->add ($child) if $child; 1044 $self->add ($child) if $child;
987 1045
988 $self 1046 $self
989} 1047}
990 1048
1049#TODO# update range on size_allocate depending on child
1050
991sub add { 1051sub add {
992 my ($self, $widget) = @_; 1052 my ($self, $widget) = @_;
993 1053
994 $self->{vp}->add ($self->{child} = $widget); 1054 $self->{vp}->add ($self->{child} = $widget);
995} 1055}
996 1056
1057sub invoke_mouse_wheel {
1058 my ($self, $ev) = @_;
1059
1060 return 0 unless $ev->{dy}; # only vertical movements
1061
1062 $self->{slider}->emit (mouse_wheel => $ev);
1063
1064 1
1065}
1066
1067sub update_slider {
1068 my ($self) = @_;
1069
1070 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
1071}
1072
997sub update { 1073sub update {
998 my ($self) = @_; 1074 my ($self) = @_;
999 1075
1000 $self->SUPER::update; 1076 $self->SUPER::update;
1001 1077
1002 # todo: overwrite size_allocate of child 1078 $self->update_slider;
1003 my $child = $self->{vp}->child;
1004 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1005} 1079}
1006 1080
1007sub invoke_size_allocate { 1081sub invoke_size_allocate {
1008 my ($self, $w, $h) = @_; 1082 my ($self, $w, $h) = @_;
1009 1083
1010 my $child = $self->{vp}->child; 1084 $self->update_slider;
1011 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1012 1085
1013 $self->SUPER::invoke_size_allocate ($w, $h) 1086 $self->SUPER::invoke_size_allocate ($w, $h)
1014} 1087}
1015 1088
1016#TODO# update range on size_allocate depending on child
1017# update viewport offset on scroll
1018
1019############################################################################# 1089#############################################################################
1020 1090
1021package CFClient::UI::Frame; 1091package CFPlus::UI::Frame;
1022 1092
1023our @ISA = CFClient::UI::Bin::; 1093our @ISA = CFPlus::UI::Bin::;
1024 1094
1025use CFClient::OpenGL; 1095use CFPlus::OpenGL;
1026 1096
1027sub new { 1097sub new {
1028 my $class = shift; 1098 my $class = shift;
1029 1099
1030 $class->SUPER::new ( 1100 $class->SUPER::new (
1056 $self->SUPER::_draw; 1126 $self->SUPER::_draw;
1057} 1127}
1058 1128
1059############################################################################# 1129#############################################################################
1060 1130
1061package CFClient::UI::FancyFrame; 1131package CFPlus::UI::FancyFrame;
1062 1132
1063our @ISA = CFClient::UI::Bin::; 1133our @ISA = CFPlus::UI::Bin::;
1064 1134
1065use CFClient::OpenGL; 1135use CFPlus::OpenGL;
1066 1136
1067my $bg = 1137my $bg =
1068 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png", 1138 new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png",
1069 mipmap => 1, wrap => 1; 1139 mipmap => 1, wrap => 1;
1070 1140
1071my @border = 1141my @border =
1072 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1142 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1073 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1143 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1074 1144
1075sub new { 1145sub new {
1076 my ($class, %arg) = @_; 1146 my ($class, %arg) = @_;
1077 1147
1078 my $self = $class->SUPER::new ( 1148 my $self = $class->SUPER::new (
1079 bg => [1, 1, 1, 1], 1149 bg => [1, 1, 1, 1],
1080 border_bg => [1, 1, 1, 1], 1150 border_bg => [1, 1, 1, 1],
1081 border => 0.6, 1151 border => 0.6,
1082 can_events => 1, 1152 can_events => 1,
1083 min_w => 16, 1153 min_w => 64,
1084 min_h => 16, 1154 min_h => 32,
1085 %arg, 1155 %arg,
1086 ); 1156 );
1087 1157
1088 $self->{title_widget} = new CFClient::UI::Label 1158 $self->{title_widget} = new CFPlus::UI::Label
1089 align => 0, 1159 align => 0,
1090 valign => 1, 1160 valign => 1,
1091 text => $self->{title}, 1161 text => $self->{title},
1092 fontsize => $self->{border}, 1162 fontsize => $self->{border},
1093 if exists $self->{title}; 1163 if exists $self->{title};
1094 1164
1095 if ($self->{has_close_button}) { 1165 if ($self->{has_close_button}) {
1096 $self->{close_button} = 1166 $self->{close_button} =
1097 new CFClient::UI::ImageButton 1167 new CFPlus::UI::ImageButton
1098 path => 'x1_close.png', 1168 path => 'x1_close.png',
1099 on_activate => sub { $self->hide }; 1169 on_activate => sub { $self->emit ("delete") };
1100 1170
1101 $self->CFClient::UI::Container::add ($self->{close_button}); 1171 $self->CFPlus::UI::Container::add ($self->{close_button});
1102 } 1172 }
1103 1173
1104 $self 1174 $self
1105} 1175}
1106 1176
1107sub add { 1177sub add {
1108 my ($self, @widgets) = @_; 1178 my ($self, @widgets) = @_;
1109 1179
1110 $self->SUPER::add (@widgets); 1180 $self->SUPER::add (@widgets);
1111 $self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button}; 1181 $self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button};
1112 $self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget}; 1182 $self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1113} 1183}
1114 1184
1115sub border { 1185sub border {
1116 int $_[0]{border} * $::FONTSIZE 1186 int $_[0]{border} * $::FONTSIZE
1117} 1187}
1150 $self->child->configure ($border, $border, $w, $h); 1220 $self->child->configure ($border, $border, $w, $h);
1151 1221
1152 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border) 1222 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1153 if $self->{close_button}; 1223 if $self->{close_button};
1154 1224
1225 1
1226}
1227
1228sub invoke_delete {
1229 my ($self) = @_;
1230
1231 $self->hide;
1232
1155 1 1233 1
1156} 1234}
1157 1235
1158sub invoke_button_down { 1236sub invoke_button_down {
1159 my ($self, $ev, $x, $y) = @_; 1237 my ($self, $ev, $x, $y) = @_;
1217 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1295 $self->{motion}->($ev, $x, $y) if $self->{motion};
1218 1296
1219 ! ! $self->{motion} 1297 ! ! $self->{motion}
1220} 1298}
1221 1299
1300sub invoke_visibility_change {
1301 my ($self, $visible) = @_;
1302
1303 delete $self->{motion} unless $visible;
1304
1305 0
1306}
1307
1222sub _draw { 1308sub _draw {
1223 my ($self) = @_; 1309 my ($self) = @_;
1224 1310
1225 my $child = $self->{children}[0]; 1311 my $child = $self->{children}[0];
1226 1312
1263 if $self->{close_button}; 1349 if $self->{close_button};
1264} 1350}
1265 1351
1266############################################################################# 1352#############################################################################
1267 1353
1268package CFClient::UI::Table; 1354package CFPlus::UI::Table;
1269 1355
1270our @ISA = CFClient::UI::Base::; 1356our @ISA = CFPlus::UI::Base::;
1271 1357
1272use List::Util qw(max sum); 1358use List::Util qw(max sum);
1273 1359
1274use CFClient::OpenGL; 1360use CFPlus::OpenGL;
1275 1361
1276sub new { 1362sub new {
1277 my $class = shift; 1363 my $class = shift;
1278 1364
1279 $class->SUPER::new ( 1365 $class->SUPER::new (
1285sub children { 1371sub children {
1286 grep $_, map @$_, grep $_, @{ $_[0]{children} } 1372 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1287} 1373}
1288 1374
1289sub add { 1375sub add {
1290 my ($self, $x, $y, $child) = @_; 1376 my ($self) = shift;
1291 1377
1378 while (@_) {
1379 my ($x, $y, $child) = splice @_, 0, 3, ();
1292 $child->set_parent ($self); 1380 $child->set_parent ($self);
1293 $self->{children}[$y][$x] = $child; 1381 $self->{children}[$y][$x] = $child;
1382 }
1294 1383
1384 $self->{force_realloc} = 1;
1385 $self->{force_size_alloc} = 1;
1295 $self->realloc; 1386 $self->realloc;
1296} 1387}
1297 1388
1298sub remove { 1389sub remove {
1299 my ($self, $child) = @_; 1390 my ($self, $child) = @_;
1364 1455
1365 # linearly scale sizes 1456 # linearly scale sizes
1366 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws; 1457 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1367 $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs; 1458 $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1368 1459
1369 CFClient::UI::harmonize $ws; 1460 CFPlus::UI::harmonize $ws;
1370 CFClient::UI::harmonize $hs; 1461 CFPlus::UI::harmonize $hs;
1371 1462
1372 my $y; 1463 my $y;
1373 1464
1374 for my $r (0 .. $#{$self->{children}}) { 1465 for my $r (0 .. $#{$self->{children}}) {
1375 my $row = $self->{children}[$r] 1466 my $row = $self->{children}[$r]
1418 } 1509 }
1419} 1510}
1420 1511
1421############################################################################# 1512#############################################################################
1422 1513
1423package CFClient::UI::Box; 1514package CFPlus::UI::Box;
1424 1515
1425our @ISA = CFClient::UI::Container::; 1516our @ISA = CFPlus::UI::Container::;
1426 1517
1427sub size_request { 1518sub size_request {
1428 my ($self) = @_; 1519 my ($self) = @_;
1429 1520
1430 $self->{vertical} 1521 $self->{vertical}
1463 $req[$_] += $space * $children[$_]{expand} 1554 $req[$_] += $space * $children[$_]{expand}
1464 for 0 .. $#children; 1555 for 0 .. $#children;
1465 } 1556 }
1466 } 1557 }
1467 1558
1468 CFClient::UI::harmonize \@req; 1559 CFPlus::UI::harmonize \@req;
1469 1560
1470 my $pos = 0; 1561 my $pos = 0;
1471 for (0 .. $#children) { 1562 for (0 .. $#children) {
1472 my $alloc = $req[$_]; 1563 my $alloc = $req[$_];
1473 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1564 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1478 1 1569 1
1479} 1570}
1480 1571
1481############################################################################# 1572#############################################################################
1482 1573
1483package CFClient::UI::HBox; 1574package CFPlus::UI::HBox;
1484 1575
1485our @ISA = CFClient::UI::Box::; 1576our @ISA = CFPlus::UI::Box::;
1486 1577
1487sub new { 1578sub new {
1488 my $class = shift; 1579 my $class = shift;
1489 1580
1490 $class->SUPER::new ( 1581 $class->SUPER::new (
1493 ) 1584 )
1494} 1585}
1495 1586
1496############################################################################# 1587#############################################################################
1497 1588
1498package CFClient::UI::VBox; 1589package CFPlus::UI::VBox;
1499 1590
1500our @ISA = CFClient::UI::Box::; 1591our @ISA = CFPlus::UI::Box::;
1501 1592
1502sub new { 1593sub new {
1503 my $class = shift; 1594 my $class = shift;
1504 1595
1505 $class->SUPER::new ( 1596 $class->SUPER::new (
1508 ) 1599 )
1509} 1600}
1510 1601
1511############################################################################# 1602#############################################################################
1512 1603
1513package CFClient::UI::Label; 1604package CFPlus::UI::Label;
1514 1605
1515our @ISA = CFClient::UI::DrawBG::; 1606our @ISA = CFPlus::UI::DrawBG::;
1516 1607
1517use CFClient::OpenGL; 1608use CFPlus::OpenGL;
1518 1609
1519sub new { 1610sub new {
1520 my ($class, %arg) = @_; 1611 my ($class, %arg) = @_;
1521 1612
1522 my $self = $class->SUPER::new ( 1613 my $self = $class->SUPER::new (
1525 #active_bg => none 1616 #active_bg => none
1526 #font => default_font 1617 #font => default_font
1527 #text => initial text 1618 #text => initial text
1528 #markup => initial narkup 1619 #markup => initial narkup
1529 #max_w => maximum pixel width 1620 #max_w => maximum pixel width
1621 #style => 0, # render flags
1530 ellipsise => 3, # end 1622 ellipsise => 3, # end
1531 layout => (new CFClient::Layout), 1623 layout => (new CFPlus::Layout),
1532 fontsize => 1, 1624 fontsize => 1,
1533 align => -1, 1625 align => -1,
1534 valign => -1, 1626 valign => -1,
1535 padding_x => 2, 1627 padding_x => 2,
1536 padding_y => 2, 1628 padding_y => 2,
1537 can_events => 0, 1629 can_events => 0,
1538 %arg 1630 %arg
1539 ); 1631 );
1540 1632
1541 if (exists $self->{template}) { 1633 if (exists $self->{template}) {
1542 my $layout = new CFClient::Layout; 1634 my $layout = new CFPlus::Layout;
1543 $layout->set_text (delete $self->{template}); 1635 $layout->set_text (delete $self->{template});
1544 $self->{template} = $layout; 1636 $self->{template} = $layout;
1545 } 1637 }
1546 1638
1547 if (exists $self->{markup}) { 1639 if (exists $self->{markup}) {
1551 } 1643 }
1552 1644
1553 $self 1645 $self
1554} 1646}
1555 1647
1556sub escape($) {
1557 local $_ = $_[0];
1558
1559 s/&/&amp;/g;
1560 s/>/&gt;/g;
1561 s/</&lt;/g;
1562
1563 $_
1564}
1565
1566sub update { 1648sub update {
1567 my ($self) = @_; 1649 my ($self) = @_;
1568 1650
1569 delete $self->{texture}; 1651 delete $self->{texture};
1570 $self->SUPER::update; 1652 $self->SUPER::update;
1581 my ($self, $text) = @_; 1663 my ($self, $text) = @_;
1582 1664
1583 return if $self->{text} eq "T$text"; 1665 return if $self->{text} eq "T$text";
1584 $self->{text} = "T$text"; 1666 $self->{text} = "T$text";
1585 1667
1586 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1587 $self->{layout}->set_text ($text); 1668 $self->{layout}->set_text ($text);
1588 1669
1589 delete $self->{size_req}; 1670 delete $self->{size_req};
1590 $self->realloc; 1671 $self->realloc;
1591 $self->update; 1672 $self->update;
1597 return if $self->{text} eq "M$markup"; 1678 return if $self->{text} eq "M$markup";
1598 $self->{text} = "M$markup"; 1679 $self->{text} = "M$markup";
1599 1680
1600 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1681 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1601 1682
1602 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1603 $self->{layout}->set_markup ($markup); 1683 $self->{layout}->set_markup ($markup);
1604 1684
1605 delete $self->{size_req}; 1685 delete $self->{size_req};
1606 $self->realloc; 1686 $self->realloc;
1607 $self->update; 1687 $self->update;
1619 1699
1620 my ($w, $h) = $self->{layout}->size; 1700 my ($w, $h) = $self->{layout}->size;
1621 1701
1622 if (exists $self->{template}) { 1702 if (exists $self->{template}) {
1623 $self->{template}->set_font ($self->{font}) if $self->{font}; 1703 $self->{template}->set_font ($self->{font}) if $self->{font};
1704 $self->{template}->set_width ($self->{max_w} || -1);
1624 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 1705 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1625 1706
1626 my ($w2, $h2) = $self->{template}->size; 1707 my ($w2, $h2) = $self->{template}->size;
1627 1708
1628 $w = List::Util::max $w, $w2; 1709 $w = List::Util::max $w, $w2;
1652 1733
1653sub set_fontsize { 1734sub set_fontsize {
1654 my ($self, $fontsize) = @_; 1735 my ($self, $fontsize) = @_;
1655 1736
1656 $self->{fontsize} = $fontsize; 1737 $self->{fontsize} = $fontsize;
1738 delete $self->{size_req};
1657 delete $self->{texture}; 1739 delete $self->{texture};
1658 1740
1659 $self->realloc; 1741 $self->realloc;
1660} 1742}
1661 1743
1662sub reconfigure { 1744sub reconfigure {
1663 my ($self) = @_; 1745 my ($self) = @_;
1664 1746
1665 delete $self->{size_req}; 1747 delete $self->{size_req};
1748 delete $self->{texture};
1666 1749
1667 $self->SUPER::reconfigure; 1750 $self->SUPER::reconfigure;
1668} 1751}
1669 1752
1670sub _draw { 1753sub _draw {
1671 my ($self) = @_; 1754 my ($self) = @_;
1672 1755
1673 $self->SUPER::_draw; # draw background, if applicable 1756 $self->SUPER::_draw; # draw background, if applicable
1674 1757
1675 my $tex = $self->{texture} ||= do { 1758 my $size = $self->{texture} ||= do {
1676 $self->{layout}->set_foreground (@{$self->{fg}}); 1759 $self->{layout}->set_foreground (@{$self->{fg}});
1677 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1760 $self->{layout}->set_font ($self->{font}) if $self->{font};
1678 $self->{layout}->set_width ($self->{w}); 1761 $self->{layout}->set_width ($self->{w});
1679 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1762 $self->{layout}->set_ellipsise ($self->{ellipsise});
1680 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1763 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1681 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1764 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1682 1765
1683 new_from_layout CFClient::Texture $self->{layout} 1766 [$self->{layout}->size]
1684 }; 1767 };
1685 1768
1686 unless (exists $self->{ox}) { 1769 unless (exists $self->{ox}) {
1687 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} 1770 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1688 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x} 1771 : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1689 : ($self->{w} - $tex->{w}) * 0.5); 1772 : ($self->{w} - $size->[0]) * 0.5);
1690 1773
1691 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 1774 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1692 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y} 1775 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1693 : ($self->{h} - $tex->{h}) * 0.5); 1776 : ($self->{h} - $size->[1]) * 0.5);
1694 }; 1777 };
1695 1778
1696 glEnable GL_TEXTURE_2D;
1697
1698 my $w = List::Util::min $self->{w} + 4, $tex->{w}; 1779 my $w = List::Util::min $self->{w} + 4, $size->[0];
1699 my $h = List::Util::min $self->{h} + 2, $tex->{h}; 1780 my $h = List::Util::min $self->{h} + 2, $size->[1];
1700 1781
1701 if ($tex->{format} == GL_ALPHA) { 1782 $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1702 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1703 glColor @{$self->{fg}};
1704 $tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1705 } else {
1706 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1707 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1708 }
1709
1710 glDisable GL_TEXTURE_2D;
1711} 1783}
1712 1784
1713############################################################################# 1785#############################################################################
1714 1786
1715package CFClient::UI::EntryBase; 1787package CFPlus::UI::EntryBase;
1716 1788
1717our @ISA = CFClient::UI::Label::; 1789our @ISA = CFPlus::UI::Label::;
1718 1790
1719use CFClient::OpenGL; 1791use CFPlus::OpenGL;
1720 1792
1721sub new { 1793sub new {
1722 my $class = shift; 1794 my $class = shift;
1723 1795
1724 $class->SUPER::new ( 1796 $class->SUPER::new (
1786 1858
1787 if ($uni == 8) { 1859 if ($uni == 8) {
1788 substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; 1860 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1789 } elsif ($uni == 127) { 1861 } elsif ($uni == 127) {
1790 substr $text, $self->{cursor}, 1, ""; 1862 substr $text, $self->{cursor}, 1, "";
1791 } elsif ($sym == CFClient::SDLK_LEFT) { 1863 } elsif ($sym == CFPlus::SDLK_LEFT) {
1792 --$self->{cursor} if $self->{cursor}; 1864 --$self->{cursor} if $self->{cursor};
1793 } elsif ($sym == CFClient::SDLK_RIGHT) { 1865 } elsif ($sym == CFPlus::SDLK_RIGHT) {
1794 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 1866 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1795 } elsif ($sym == CFClient::SDLK_HOME) { 1867 } elsif ($sym == CFPlus::SDLK_HOME) {
1796 $self->{cursor} = 0; 1868 $self->{cursor} = 0;
1797 } elsif ($sym == CFClient::SDLK_END) { 1869 } elsif ($sym == CFPlus::SDLK_END) {
1798 $self->{cursor} = length $text; 1870 $self->{cursor} = length $text;
1799 } elsif ($uni == 27) { 1871 } elsif ($uni == 27) {
1800 $self->emit ('escape'); 1872 $self->emit ('escape');
1801 } elsif ($uni) { 1873 } elsif ($uni) {
1802 substr $text, $self->{cursor}++, 0, chr $uni; 1874 substr $text, $self->{cursor}++, 0, chr $uni;
1826 1898
1827 my $idx = $self->{layout}->xy_to_index ($x, $y); 1899 my $idx = $self->{layout}->xy_to_index ($x, $y);
1828 1900
1829 # byte-index to char-index 1901 # byte-index to char-index
1830 my $text = $self->{text}; 1902 my $text = $self->{text};
1831 utf8::encode $text; 1903 utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1832 $self->{cursor} = length substr $text, 0, $idx; 1904 $self->{cursor} = length $text;
1833 1905
1834 $self->_set_text ($self->{text}); 1906 $self->_set_text ($self->{text});
1835 $self->update; 1907 $self->update;
1836 1908
1837 1 1909 1
1876 utf8::encode $text; 1948 utf8::encode $text;
1877 1949
1878 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text) 1950 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1879 } 1951 }
1880 1952
1881 glColor @{$self->{fg}};
1882 glBegin GL_LINES; 1953 glBegin GL_LINES;
1883 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy}; 1954 glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1884 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h}; 1955 glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1885 glEnd; 1956 glEnd;
1886 } 1957 }
1887} 1958}
1888 1959
1889package CFClient::UI::Entry; 1960package CFPlus::UI::Entry;
1890 1961
1891our @ISA = CFClient::UI::EntryBase::; 1962our @ISA = CFPlus::UI::EntryBase::;
1892 1963
1893use CFClient::OpenGL; 1964use CFPlus::OpenGL;
1894 1965
1895sub invoke_key_down { 1966sub invoke_key_down {
1896 my ($self, $ev) = @_; 1967 my ($self, $ev) = @_;
1897 1968
1898 my $sym = $ev->{sym}; 1969 my $sym = $ev->{sym};
1904 $self->{history_pointer} = -1; 1975 $self->{history_pointer} = -1;
1905 $self->{history_saveback} = ''; 1976 $self->{history_saveback} = '';
1906 $self->emit (activate => $txt); 1977 $self->emit (activate => $txt);
1907 $self->update; 1978 $self->update;
1908 1979
1909 } elsif ($sym == CFClient::SDLK_UP) { 1980 } elsif ($sym == CFPlus::SDLK_UP) {
1910 if ($self->{history_pointer} < 0) { 1981 if ($self->{history_pointer} < 0) {
1911 $self->{history_saveback} = $self->get_text; 1982 $self->{history_saveback} = $self->get_text;
1912 } 1983 }
1913 if (@{$self->{history} || []} > 0) { 1984 if (@{$self->{history} || []} > 0) {
1914 $self->{history_pointer}++; 1985 $self->{history_pointer}++;
1916 $self->{history_pointer} = @{$self->{history} || []} - 1; 1987 $self->{history_pointer} = @{$self->{history} || []} - 1;
1917 } 1988 }
1918 $self->set_text ($self->{history}->[$self->{history_pointer}]); 1989 $self->set_text ($self->{history}->[$self->{history_pointer}]);
1919 } 1990 }
1920 1991
1921 } elsif ($sym == CFClient::SDLK_DOWN) { 1992 } elsif ($sym == CFPlus::SDLK_DOWN) {
1922 $self->{history_pointer}--; 1993 $self->{history_pointer}--;
1923 $self->{history_pointer} = -1 if $self->{history_pointer} < 0; 1994 $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1924 1995
1925 if ($self->{history_pointer} >= 0) { 1996 if ($self->{history_pointer} >= 0) {
1926 $self->set_text ($self->{history}->[$self->{history_pointer}]); 1997 $self->set_text ($self->{history}->[$self->{history_pointer}]);
1935 1 2006 1
1936} 2007}
1937 2008
1938############################################################################# 2009#############################################################################
1939 2010
1940package CFClient::UI::Button; 2011package CFPlus::UI::Button;
1941 2012
1942our @ISA = CFClient::UI::Label::; 2013our @ISA = CFPlus::UI::Label::;
1943 2014
1944use CFClient::OpenGL; 2015use CFPlus::OpenGL;
1945 2016
1946my @tex = 2017my @tex =
1947 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2018 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1948 qw(b1_button_active.png); 2019 qw(b1_button_active.png);
1949 2020
1950sub new { 2021sub new {
1951 my $class = shift; 2022 my $class = shift;
1952 2023
1989 $self->SUPER::_draw; 2060 $self->SUPER::_draw;
1990} 2061}
1991 2062
1992############################################################################# 2063#############################################################################
1993 2064
2065package CFPlus::UI::CheckBox;
2066
2067our @ISA = CFPlus::UI::DrawBG::;
2068
2069my @tex =
2070 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2071 qw(c1_checkbox_bg.png c1_checkbox_active.png);
2072
2073use CFPlus::OpenGL;
2074
2075sub new {
2076 my $class = shift;
2077
2078 $class->SUPER::new (
2079 padding_x => 2,
2080 padding_y => 2,
2081 fg => [1, 1, 1],
2082 active_fg => [1, 1, 0],
2083 bg => [0, 0, 0, 0.2],
2084 active_bg => [1, 1, 1, 0.5],
2085 state => 0,
2086 can_hover => 1,
2087 @_
2088 )
2089}
2090
2091sub size_request {
2092 my ($self) = @_;
2093
2094 (6) x 2
2095}
2096
2097sub toggle {
2098 my ($self) = @_;
2099
2100 $self->{state} = !$self->{state};
2101 $self->emit (changed => $self->{state});
2102 $self->update;
2103}
2104
2105sub invoke_button_down {
2106 my ($self, $ev, $x, $y) = @_;
2107
2108 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2109 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2110 $self->toggle;
2111 } else {
2112 return 0
2113 }
2114
2115 1
2116}
2117
2118sub _draw {
2119 my ($self) = @_;
2120
2121 $self->SUPER::_draw;
2122
2123 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
2124
2125 my ($w, $h) = @$self{qw(w h)};
2126
2127 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2128
2129 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
2130
2131 my $tex = $self->{state} ? $tex[1] : $tex[0];
2132
2133 glEnable GL_TEXTURE_2D;
2134 $tex->draw_quad_alpha (0, 0, $s, $s);
2135 glDisable GL_TEXTURE_2D;
2136}
2137
2138#############################################################################
2139
2140package CFPlus::UI::Image;
2141
2142our @ISA = CFPlus::UI::Base::;
2143
2144use CFPlus::OpenGL;
2145
2146our %texture_cache;
2147
2148sub new {
2149 my $class = shift;
2150
2151 my $self = $class->SUPER::new (
2152 can_events => 0,
2153 @_,
2154 );
2155
2156 $self->{path} || $self->{tex}
2157 or Carp::croak "'path' or 'tex' attributes required";
2158
2159 $self->{tex} ||= $texture_cache{$self->{path}} ||=
2160 new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
2161
2162 Scalar::Util::weaken $texture_cache{$self->{path}};
2163
2164 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2165
2166 $self
2167}
2168
2169sub STORABLE_freeze {
2170 my ($self, $cloning) = @_;
2171
2172 $self->{path}
2173 or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
2174
2175 $self->{path}
2176}
2177
2178sub STORABLE_attach {
2179 my ($self, $cloning, $path) = @_;
2180
2181 $self->new (path => $path)
2182}
2183
2184sub size_request {
2185 my ($self) = @_;
2186
2187 ($self->{tex}{w}, $self->{tex}{h})
2188}
2189
2190sub _draw {
2191 my ($self) = @_;
2192
2193 my $tex = $self->{tex};
2194
2195 my ($w, $h) = ($self->{w}, $self->{h});
2196
2197 if ($self->{rot90}) {
2198 glRotate 90, 0, 0, 1;
2199 glTranslate 0, -$self->{w}, 0;
2200
2201 ($w, $h) = ($h, $w);
2202 }
2203
2204 glEnable GL_TEXTURE_2D;
2205 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2206
2207 $tex->draw_quad (0, 0, $w, $h);
2208
2209 glDisable GL_TEXTURE_2D;
2210}
2211
2212#############################################################################
2213
1994package CFClient::UI::ImageButton; 2214package CFPlus::UI::ImageButton;
1995 2215
1996our @ISA = CFClient::UI::Image::; 2216our @ISA = CFPlus::UI::Image::;
1997 2217
1998use CFClient::OpenGL; 2218use CFPlus::OpenGL;
1999 2219
2000my %textures; 2220my %textures;
2001 2221
2002sub new { 2222sub new {
2003 my $class = shift; 2223 my $class = shift;
2025 1 2245 1
2026} 2246}
2027 2247
2028############################################################################# 2248#############################################################################
2029 2249
2030package CFClient::UI::CheckBox;
2031
2032our @ISA = CFClient::UI::DrawBG::;
2033
2034my @tex =
2035 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2036 qw(c1_checkbox_bg.png c1_checkbox_active.png);
2037
2038use CFClient::OpenGL;
2039
2040sub new {
2041 my $class = shift;
2042
2043 $class->SUPER::new (
2044 padding_x => 2,
2045 padding_y => 2,
2046 fg => [1, 1, 1],
2047 active_fg => [1, 1, 0],
2048 bg => [0, 0, 0, 0.2],
2049 active_bg => [1, 1, 1, 0.5],
2050 state => 0,
2051 can_hover => 1,
2052 @_
2053 )
2054}
2055
2056sub size_request {
2057 my ($self) = @_;
2058
2059 (6) x 2
2060}
2061
2062sub invoke_button_down {
2063 my ($self, $ev, $x, $y) = @_;
2064
2065 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2066 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2067 $self->{state} = !$self->{state};
2068 $self->emit (changed => $self->{state});
2069 } else {
2070 return 0
2071 }
2072
2073 1
2074}
2075
2076sub _draw {
2077 my ($self) = @_;
2078
2079 $self->SUPER::_draw;
2080
2081 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
2082
2083 my ($w, $h) = @$self{qw(w h)};
2084
2085 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2086
2087 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
2088
2089 my $tex = $self->{state} ? $tex[1] : $tex[0];
2090
2091 glEnable GL_TEXTURE_2D;
2092 $tex->draw_quad_alpha (0, 0, $s, $s);
2093 glDisable GL_TEXTURE_2D;
2094}
2095
2096#############################################################################
2097
2098package CFClient::UI::Image; 2250package CFPlus::UI::VGauge;
2099 2251
2100our @ISA = CFClient::UI::Base::; 2252our @ISA = CFPlus::UI::Base::;
2101
2102use CFClient::OpenGL;
2103
2104our %texture_cache;
2105
2106sub new {
2107 my $class = shift;
2108
2109 my $self = $class->SUPER::new (
2110 can_events => 0,
2111 @_,
2112 );
2113
2114 $self->{path}
2115 or Carp::croak "required attribute 'path' not set";
2116
2117 $self->{tex} = $texture_cache{$self->{path}} ||=
2118 new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2119
2120 Scalar::Util::weaken $texture_cache{$self->{path}};
2121
2122 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2123
2124 $self
2125}
2126
2127sub size_request {
2128 my ($self) = @_;
2129
2130 ($self->{tex}{w}, $self->{tex}{h})
2131}
2132
2133sub _draw {
2134 my ($self) = @_;
2135
2136 my $tex = $self->{tex};
2137
2138 my ($w, $h) = ($self->{w}, $self->{h});
2139
2140 if ($self->{rot90}) {
2141 glRotate 90, 0, 0, 1;
2142 glTranslate 0, -$self->{w}, 0;
2143
2144 ($w, $h) = ($h, $w);
2145 }
2146
2147 glEnable GL_TEXTURE_2D;
2148 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2149
2150 $tex->draw_quad_alpha (0, 0, $w, $h);
2151
2152 glDisable GL_TEXTURE_2D;
2153}
2154
2155#############################################################################
2156
2157package CFClient::UI::VGauge;
2158
2159our @ISA = CFClient::UI::Base::;
2160 2253
2161use List::Util qw(min max); 2254use List::Util qw(min max);
2162 2255
2163use CFClient::OpenGL; 2256use CFPlus::OpenGL;
2164 2257
2165my %tex = ( 2258my %tex = (
2166 food => [ 2259 food => [
2167 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2260 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2168 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ 2261 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2169 ], 2262 ],
2170 grace => [ 2263 grace => [
2171 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2264 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2172 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ 2265 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2173 ], 2266 ],
2174 hp => [ 2267 hp => [
2175 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2268 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2176 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ 2269 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2177 ], 2270 ],
2178 mana => [ 2271 mana => [
2179 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2272 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2180 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ 2273 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2181 ], 2274 ],
2182); 2275);
2183 2276
2184# eg. VGauge->new (gauge => 'food'), default gauge: food 2277# eg. VGauge->new (gauge => 'food'), default gauge: food
2244 my $ycut1 = max 0, min 1, $ycut; 2337 my $ycut1 = max 0, min 1, $ycut;
2245 my $ycut2 = max 0, min 1, $ycut - 1; 2338 my $ycut2 = max 0, min 1, $ycut - 1;
2246 2339
2247 my $h1 = $self->{h} * (1 - $ycut1); 2340 my $h1 = $self->{h} * (1 - $ycut1);
2248 my $h2 = $self->{h} * (1 - $ycut2); 2341 my $h2 = $self->{h} * (1 - $ycut2);
2342 my $h3 = $self->{h};
2343
2344 $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2249 2345
2250 glEnable GL_BLEND; 2346 glEnable GL_BLEND;
2251 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA, 2347 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2252 GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2348 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2253 glEnable GL_TEXTURE_2D; 2349 glEnable GL_TEXTURE_2D;
2272 2368
2273 if ($t3) { 2369 if ($t3) {
2274 glBindTexture GL_TEXTURE_2D, $t3->{name}; 2370 glBindTexture GL_TEXTURE_2D, $t3->{name};
2275 glBegin GL_QUADS; 2371 glBegin GL_QUADS;
2276 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2; 2372 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2277 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h}; 2373 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2278 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h}; 2374 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2279 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2; 2375 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2280 glEnd; 2376 glEnd;
2281 } 2377 }
2282 2378
2283 glDisable GL_BLEND; 2379 glDisable GL_BLEND;
2284 glDisable GL_TEXTURE_2D; 2380 glDisable GL_TEXTURE_2D;
2285} 2381}
2286 2382
2287############################################################################# 2383#############################################################################
2288 2384
2289package CFClient::UI::Gauge; 2385package CFPlus::UI::Gauge;
2290 2386
2291our @ISA = CFClient::UI::VBox::; 2387our @ISA = CFPlus::UI::VBox::;
2292 2388
2293sub new { 2389sub new {
2294 my ($class, %arg) = @_; 2390 my ($class, %arg) = @_;
2295 2391
2296 my $self = $class->SUPER::new ( 2392 my $self = $class->SUPER::new (
2298 can_hover => 1, 2394 can_hover => 1,
2299 can_events => 1, 2395 can_events => 1,
2300 %arg, 2396 %arg,
2301 ); 2397 );
2302 2398
2303 $self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999"); 2399 $self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999");
2304 $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1); 2400 $self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2305 $self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999"); 2401 $self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2306 2402
2307 $self 2403 $self
2308} 2404}
2309 2405
2310sub set_fontsize { 2406sub set_fontsize {
2331 $self->{value}->set_text ($val); 2427 $self->{value}->set_text ($val);
2332} 2428}
2333 2429
2334############################################################################# 2430#############################################################################
2335 2431
2336package CFClient::UI::Slider; 2432package CFPlus::UI::Slider;
2337 2433
2338use strict; 2434use strict;
2339 2435
2340use CFClient::OpenGL; 2436use CFPlus::OpenGL;
2341 2437
2342our @ISA = CFClient::UI::DrawBG::; 2438our @ISA = CFPlus::UI::DrawBG::;
2343 2439
2344my @tex = 2440my @tex =
2345 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } 2441 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2346 qw(s1_slider.png s1_slider_bg.png); 2442 qw(s1_slider.png s1_slider_bg.png);
2347 2443
2348sub new { 2444sub new {
2349 my $class = shift; 2445 my $class = shift;
2350 2446
2439 } 2535 }
2440 2536
2441 1 2537 1
2442} 2538}
2443 2539
2540sub invoke_mouse_wheel {
2541 my ($self, $ev) = @_;
2542
2543 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
2544
2545 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.2);
2546
2547 ! ! $delta
2548}
2549
2444sub update { 2550sub update {
2445 my ($self) = @_; 2551 my ($self) = @_;
2446 2552
2447 delete $self->{knob_w}; 2553 delete $self->{knob_w};
2448 $self->SUPER::update; 2554 $self->SUPER::update;
2495 glDisable GL_TEXTURE_2D; 2601 glDisable GL_TEXTURE_2D;
2496} 2602}
2497 2603
2498############################################################################# 2604#############################################################################
2499 2605
2500package CFClient::UI::ValSlider; 2606package CFPlus::UI::ValSlider;
2501 2607
2502our @ISA = CFClient::UI::HBox::; 2608our @ISA = CFPlus::UI::HBox::;
2503 2609
2504sub new { 2610sub new {
2505 my ($class, %arg) = @_; 2611 my ($class, %arg) = @_;
2506 2612
2507 my $range = delete $arg{range}; 2613 my $range = delete $arg{range};
2508 2614
2509 my $self = $class->SUPER::new ( 2615 my $self = $class->SUPER::new (
2510 slider => (new CFClient::UI::Slider expand => 1, range => $range), 2616 slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2511 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}), 2617 entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2512 to_value => sub { shift }, 2618 to_value => sub { shift },
2513 from_value => sub { shift }, 2619 from_value => sub { shift },
2514 %arg, 2620 %arg,
2515 ); 2621 );
2516 2622
2536sub set_range { shift->{slider}->set_range (@_) } 2642sub set_range { shift->{slider}->set_range (@_) }
2537sub set_value { shift->{slider}->set_value (@_) } 2643sub set_value { shift->{slider}->set_value (@_) }
2538 2644
2539############################################################################# 2645#############################################################################
2540 2646
2541package CFClient::UI::TextScroller; 2647package CFPlus::UI::TextScroller;
2542 2648
2543our @ISA = CFClient::UI::HBox::; 2649our @ISA = CFPlus::UI::HBox::;
2544 2650
2545use CFClient::OpenGL; 2651use CFPlus::OpenGL;
2546 2652
2547sub new { 2653sub new {
2548 my $class = shift; 2654 my $class = shift;
2549 2655
2550 my $self = $class->SUPER::new ( 2656 my $self = $class->SUPER::new (
2551 fontsize => 1, 2657 fontsize => 1,
2552 can_events => 0, 2658 can_events => 1,
2553 indent => 0, 2659 indent => 0,
2554 #font => default_font 2660 #font => default_font
2555 @_, 2661 @_,
2556 2662
2557 layout => (new CFClient::Layout 1), 2663 layout => (new CFPlus::Layout),
2558 par => [], 2664 par => [],
2559 height => 0, 2665 height => 0,
2560 children => [ 2666 children => [
2561 (new CFClient::UI::Empty expand => 1), 2667 (new CFPlus::UI::Empty expand => 1),
2562 (new CFClient::UI::Slider vertical => 1), 2668 (new CFPlus::UI::Slider vertical => 1),
2563 ], 2669 ],
2564 ); 2670 );
2565 2671
2566 $self->{children}[1]->connect (changed => sub { $self->update }); 2672 $self->{children}[1]->connect (changed => sub { $self->update });
2567 2673
2597 2703
2598 $self->reflow; 2704 $self->reflow;
2599 2705
2600 local $self->{children} = [$empty, $slider]; 2706 local $self->{children} = [$empty, $slider];
2601 $self->SUPER::invoke_size_allocate ($w, $h) 2707 $self->SUPER::invoke_size_allocate ($w, $h)
2708}
2709
2710sub invoke_mouse_wheel {
2711 my ($self, $ev) = @_;
2712
2713 return 0 unless $ev->{dy}; # only vertical movements
2714
2715 $self->{children}[1]->emit (mouse_wheel => $ev);
2716
2717 1
2602} 2718}
2603 2719
2604sub get_layout { 2720sub get_layout {
2605 my ($self, $para) = @_; 2721 my ($self, $para) = @_;
2606 2722
2634 2750
2635 # todo: base offset on lines or so, not on pixels 2751 # todo: base offset on lines or so, not on pixels
2636 $self->{children}[1]->set_value ($offset); 2752 $self->{children}[1]->set_value ($offset);
2637} 2753}
2638 2754
2755sub current_paragraph {
2756 my ($self) = @_;
2757
2758 $self->force_uptodate;
2759 $self->{top_paragraph} - 1
2760}
2761
2762sub scroll_to {
2763 my ($self, $para) = @_;
2764
2765 $self->force_uptodate;
2766
2767 $para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
2768
2769 $self->{children}[1]->set_value ($self->{par}[$para]{y});
2770}
2771
2639sub clear { 2772sub clear {
2640 my ($self) = @_; 2773 my ($self) = @_;
2641 2774
2642 my (undef, undef, @other) = @{ $self->{children} }; 2775 my (undef, undef, @other) = @{ $self->{children} };
2643 $self->remove ($_) for @other; 2776 $self->remove ($_) for @other;
2646 $self->{height} = 0; 2779 $self->{height} = 0;
2647 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2780 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2648} 2781}
2649 2782
2650sub add_paragraph { 2783sub add_paragraph {
2651 my ($self, $color, $para, $indent) = @_; 2784 my $self = shift;
2652 2785
2653 my ($text, @w) = ref $para ? @$para : $para; 2786 for my $para (@_) {
2654
2655 $para = { 2787 $para = {
2788 fg => [1, 1, 1, 1],
2789 indent => 0,
2790 markup => "",
2791 widget => [],
2792 ref $para ? %$para : (markup => $para),
2656 w => 1e10, 2793 w => 1e10,
2657 wrapped => 1, 2794 wrapped => 1,
2658 fg => $color,
2659 indent => $indent,
2660 markup => $text,
2661 widget => \@w,
2662 }; 2795 };
2663 2796
2664 $self->add (@w) if @w; 2797 $self->add (@{ $para->{widget} }) if @{ $para->{widget} };
2665 push @{$self->{par}}, $para; 2798 push @{$self->{par}}, $para;
2799 }
2666 2800
2667 $self->{need_reflow}++; 2801 $self->{need_reflow}++;
2668 $self->update; 2802 $self->update;
2669} 2803}
2670 2804
2673 2807
2674 $self->{scroll_to_bottom} = 1; 2808 $self->{scroll_to_bottom} = 1;
2675 $self->update; 2809 $self->update;
2676} 2810}
2677 2811
2812sub force_uptodate {
2813 my ($self) = @_;
2814
2815 if (delete $self->{need_reflow}) {
2816 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2817
2818 my $height = 0;
2819 my $paridx;
2820 my $top_paragraph;
2821 my $top = int $self->{children}[1]{range}[0];
2822
2823 for my $para (@{$self->{par}}) {
2824 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2825 my $layout = $self->get_layout ($para);
2826 my ($w, $h) = $layout->size;
2827
2828 $para->{w} = $w + $para->{indent};
2829 $para->{h} = $h;
2830 $para->{wrapped} = $layout->has_wrapped;
2831 }
2832
2833 $para->{y} = $height;
2834
2835 $paridx++;
2836 $top_paragraph ||= $paridx if $height >= $top;
2837
2838 $height += $para->{h};
2839 }
2840
2841 $self->{top_paragraph} = $top_paragraph;
2842 $self->{height} = $height;
2843
2844 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2845
2846 delete $self->{texture};
2847 }
2848
2849 if (delete $self->{scroll_to_bottom}) {
2850 $self->{children}[1]->set_value (1e10);
2851 }
2852}
2853
2678sub update { 2854sub update {
2679 my ($self) = @_; 2855 my ($self) = @_;
2680 2856
2681 $self->SUPER::update; 2857 $self->SUPER::update;
2682 2858
2683 return unless $self->{h} > 0; 2859 return unless $self->{h} > 0;
2684 2860
2685 delete $self->{texture}; 2861 delete $self->{texture};
2686 2862
2687 $ROOT->on_post_alloc ($self => sub { 2863 $ROOT->on_post_alloc ($self => sub {
2864 $self->force_uptodate;
2865
2688 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2866 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2689 2867
2690 if (delete $self->{need_reflow}) {
2691 my $height = 0;
2692
2693 for my $para (@{$self->{par}}) {
2694 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2695 my $layout = $self->get_layout ($para);
2696 my ($w, $h) = $layout->size;
2697
2698 $para->{w} = $w + $para->{indent};
2699 $para->{h} = $h;
2700 $para->{wrapped} = $layout->has_wrapped;
2701 }
2702
2703 $height += $para->{h};
2704 }
2705
2706 $self->{height} = $height;
2707
2708 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2709
2710 delete $self->{texture};
2711 }
2712
2713 if (delete $self->{scroll_to_bottom}) {
2714 $self->{children}[1]->set_value (1e10);
2715 }
2716
2717 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2868 $self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2718 glClearColor 0, 0, 0, 0; 2869 glClearColor 0, 0, 0, 0;
2719 glClear GL_COLOR_BUFFER_BIT; 2870 glClear GL_COLOR_BUFFER_BIT;
2720 2871
2721 my $top = int $self->{children}[1]{range}[0]; 2872 my $top = int $self->{children}[1]{range}[0];
2722 2873
2723 my $y0 = $top; 2874 my $y0 = $top;
2724 my $y1 = $top + $H; 2875 my $y1 = $top + $H;
2725 2876
2726 my $y = 0;
2727
2728 glEnable GL_BLEND;
2729 #TODO# not correct in windows where rgba is forced off
2730 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2731
2732 for my $para (@{$self->{par}}) { 2877 for my $para (@{$self->{par}}) {
2733 my $h = $para->{h}; 2878 my $h = $para->{h};
2879 my $y = $para->{y};
2734 2880
2735 if ($y0 < $y + $h && $y < $y1) { 2881 if ($y0 < $y + $h && $y < $y1) {
2736
2737 my $layout = $self->get_layout ($para); 2882 my $layout = $self->get_layout ($para);
2738 2883
2739 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2740
2741 glRasterPos $para->{indent}, $y - $y0; 2884 $layout->render ($para->{indent}, $y - $y0);
2742 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2743 2885
2744 if (my @w = @{ $para->{widget} }) { 2886 if (my @w = @{ $para->{widget} }) {
2745 my @s = $layout->get_shapes; 2887 my @s = $layout->get_shapes;
2746 2888
2747 for (@w) { 2889 for (@w) {
2752 2894
2753 $_->draw; 2895 $_->draw;
2754 } 2896 }
2755 } 2897 }
2756 } 2898 }
2757
2758 $y += $h;
2759 } 2899 }
2760
2761 glDisable GL_BLEND;
2762 }; 2900 };
2763 }); 2901 });
2764} 2902}
2765 2903
2766sub reconfigure { 2904sub reconfigure {
2784 $self->{children}[1]->draw; 2922 $self->{children}[1]->draw;
2785} 2923}
2786 2924
2787############################################################################# 2925#############################################################################
2788 2926
2789package CFClient::UI::Animator; 2927package CFPlus::UI::Animator;
2790 2928
2791use CFClient::OpenGL; 2929use CFPlus::OpenGL;
2792 2930
2793our @ISA = CFClient::UI::Bin::; 2931our @ISA = CFPlus::UI::Bin::;
2794 2932
2795sub moveto { 2933sub moveto {
2796 my ($self, $x, $y) = @_; 2934 my ($self, $x, $y) = @_;
2797 2935
2798 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 2936 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
2826 glPopMatrix; 2964 glPopMatrix;
2827} 2965}
2828 2966
2829############################################################################# 2967#############################################################################
2830 2968
2831package CFClient::UI::Flopper; 2969package CFPlus::UI::Flopper;
2832 2970
2833our @ISA = CFClient::UI::Button::; 2971our @ISA = CFPlus::UI::Button::;
2834 2972
2835sub new { 2973sub new {
2836 my $class = shift; 2974 my $class = shift;
2837 2975
2838 my $self = $class->SUPER::new ( 2976 my $self = $class->SUPER::new (
2850 $self->{other}->toggle_visibility; 2988 $self->{other}->toggle_visibility;
2851} 2989}
2852 2990
2853############################################################################# 2991#############################################################################
2854 2992
2855package CFClient::UI::Tooltip; 2993package CFPlus::UI::Tooltip;
2856 2994
2857our @ISA = CFClient::UI::Bin::; 2995our @ISA = CFPlus::UI::Bin::;
2858 2996
2859use CFClient::OpenGL; 2997use CFPlus::OpenGL;
2860 2998
2861sub new { 2999sub new {
2862 my $class = shift; 3000 my $class = shift;
2863 3001
2864 $class->SUPER::new ( 3002 $class->SUPER::new (
2867 ) 3005 )
2868} 3006}
2869 3007
2870sub set_tooltip_from { 3008sub set_tooltip_from {
2871 my ($self, $widget) = @_; 3009 my ($self, $widget) = @_;
3010
3011 $widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
3012 if $widget->{tooltip} =~ /^#(.*)$/;
2872 3013
2873 my $tooltip = $widget->{tooltip}; 3014 my $tooltip = $widget->{tooltip};
2874 3015
2875 if ($ENV{CFPLUS_DEBUG} & 2) { 3016 if ($ENV{CFPLUS_DEBUG} & 2) {
2876 $tooltip .= "\n\n" . (ref $widget) . "\n" 3017 $tooltip .= "\n\n" . (ref $widget) . "\n"
2880 } 3021 }
2881 3022
2882 $tooltip =~ s/^\n+//; 3023 $tooltip =~ s/^\n+//;
2883 $tooltip =~ s/\n+$//; 3024 $tooltip =~ s/\n+$//;
2884 3025
2885 $self->add (new CFClient::UI::Label 3026 $self->add (new CFPlus::UI::Label
2886 markup => $tooltip, 3027 markup => $tooltip,
2887 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3028 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2888 fontsize => 0.8, 3029 fontsize => 0.8,
2889 fg => [0, 0, 0, 1], 3030 style => 1, # FLAG_INVERSE
2890 ellipsise => 0, 3031 ellipsise => 0,
2891 font => ($widget->{tooltip_font} || $::FONT_PROP), 3032 font => ($widget->{tooltip_font} || $::FONT_PROP),
2892 ); 3033 );
2893} 3034}
2894 3035
2913 3054
2914 $self->{root}->on_post_alloc ("move_$self" => sub { 3055 $self->{root}->on_post_alloc ("move_$self" => sub {
2915 my $widget = $self->{owner} 3056 my $widget = $self->{owner}
2916 or return; 3057 or return;
2917 3058
3059 if ($widget->{visible}) {
2918 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 3060 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2919 3061
2920 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 3062 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2921 if $x + $self->{w} > $self->{root}{w}; 3063 if $x + $self->{w} > $self->{root}{w};
2922 3064
2923 $self->move_abs ($x, $y); 3065 $self->move_abs ($x, $y);
3066 } else {
3067 $self->hide;
3068 }
2924 }); 3069 });
2925} 3070}
2926 3071
2927sub _draw { 3072sub _draw {
2928 my ($self) = @_; 3073 my ($self) = @_;
2952 $self->SUPER::_draw; 3097 $self->SUPER::_draw;
2953} 3098}
2954 3099
2955############################################################################# 3100#############################################################################
2956 3101
2957package CFClient::UI::Face; 3102package CFPlus::UI::Face;
2958 3103
2959our @ISA = CFClient::UI::Base::; 3104our @ISA = CFPlus::UI::DrawBG::;
2960 3105
2961use CFClient::OpenGL; 3106use CFPlus::OpenGL;
2962 3107
2963sub new { 3108sub new {
2964 my $class = shift; 3109 my $class = shift;
2965 3110
2966 my $self = $class->SUPER::new ( 3111 my $self = $class->SUPER::new (
3001sub _draw { 3146sub _draw {
3002 my ($self) = @_; 3147 my ($self) = @_;
3003 3148
3004 return unless $::CONN; 3149 return unless $::CONN;
3005 3150
3151 $self->SUPER::_draw;
3152
3006 my $face; 3153 my $face;
3007 3154
3008 if ($self->{frame}) { 3155 if ($self->{frame}) {
3009 my $anim = $::CONN->{anim}[$self->{anim}]; 3156 my $anim = $::CONN->{anim}[$self->{anim}];
3010 3157
3032 $self->SUPER::destroy; 3179 $self->SUPER::destroy;
3033} 3180}
3034 3181
3035############################################################################# 3182#############################################################################
3036 3183
3037package CFClient::UI::Buttonbar; 3184package CFPlus::UI::Buttonbar;
3038 3185
3039our @ISA = CFClient::UI::HBox::; 3186our @ISA = CFPlus::UI::HBox::;
3040 3187
3041# TODO: should actualyl wrap buttons and other goodies. 3188# TODO: should actualyl wrap buttons and other goodies.
3042 3189
3043############################################################################# 3190#############################################################################
3044 3191
3045package CFClient::UI::Menu; 3192package CFPlus::UI::Menu;
3046 3193
3047our @ISA = CFClient::UI::FancyFrame::; 3194our @ISA = CFPlus::UI::FancyFrame::;
3048 3195
3049use CFClient::OpenGL; 3196use CFPlus::OpenGL;
3050 3197
3051sub new { 3198sub new {
3052 my $class = shift; 3199 my $class = shift;
3053 3200
3054 my $self = $class->SUPER::new ( 3201 my $self = $class->SUPER::new (
3055 items => [], 3202 items => [],
3056 z => 100, 3203 z => 100,
3057 @_, 3204 @_,
3058 ); 3205 );
3059 3206
3060 $self->add ($self->{vbox} = new CFClient::UI::VBox); 3207 $self->add ($self->{vbox} = new CFPlus::UI::VBox);
3061 3208
3062 for my $item (@{ $self->{items} }) { 3209 for my $item (@{ $self->{items} }) {
3063 my ($widget, $cb, $tooltip) = @$item; 3210 my ($widget, $cb, $tooltip) = @$item;
3064 3211
3065 # handle various types of items, only text for now 3212 # handle various types of items, only text for now
3066 if (!ref $widget) { 3213 if (!ref $widget) {
3214 if ($widget =~ /\t/) {
3215 my ($left, $right) = split /\t/, $widget, 2;
3216
3067 $widget = new CFClient::UI::Label 3217 $widget = new CFPlus::UI::HBox
3068 can_hover => 1, 3218 can_hover => 1,
3069 can_events => 1, 3219 can_events => 1,
3220 tooltip => $tooltip,
3221 children => [
3222 (new CFPlus::UI::Label markup => $left, expand => 1),
3223 (new CFPlus::UI::Label markup => $right, align => +1),
3224 ],
3225 ;
3226
3227 } else {
3228 $widget = new CFPlus::UI::Label
3229 can_hover => 1,
3230 can_events => 1,
3070 markup => $widget, 3231 markup => $widget,
3071 tooltip => $tooltip 3232 tooltip => $tooltip;
3233 }
3072 } 3234 }
3073 3235
3074 $self->{item}{$widget} = $item; 3236 $self->{item}{$widget} = $item;
3075 3237
3076 $self->{vbox}->add ($widget); 3238 $self->{vbox}->add ($widget);
3119 1 3281 1
3120} 3282}
3121 3283
3122############################################################################# 3284#############################################################################
3123 3285
3124package CFClient::UI::Multiplexer; 3286package CFPlus::UI::Multiplexer;
3125 3287
3126our @ISA = CFClient::UI::Container::; 3288our @ISA = CFPlus::UI::Container::;
3127 3289
3128sub new { 3290sub new {
3129 my $class = shift; 3291 my $class = shift;
3130 3292
3131 my $self = $class->SUPER::new ( 3293 my $self = $class->SUPER::new (
3145 3307
3146 $self->{current} = $self->{children}[0] 3308 $self->{current} = $self->{children}[0]
3147 if @{ $self->{children} }; 3309 if @{ $self->{children} };
3148} 3310}
3149 3311
3312sub get_current_page {
3313 my ($self) = @_;
3314
3315 $self->{current}
3316}
3317
3150sub set_current_page { 3318sub set_current_page {
3151 my ($self, $page_or_widget) = @_; 3319 my ($self, $page_or_widget) = @_;
3152 3320
3153 my $widget = ref $page_or_widget 3321 my $widget = ref $page_or_widget
3154 ? $page_or_widget 3322 ? $page_or_widget
3186 $self->{current}->draw; 3354 $self->{current}->draw;
3187} 3355}
3188 3356
3189############################################################################# 3357#############################################################################
3190 3358
3191package CFClient::UI::Notebook; 3359package CFPlus::UI::Notebook;
3192 3360
3193our @ISA = CFClient::UI::VBox::; 3361our @ISA = CFPlus::UI::VBox::;
3194 3362
3195sub new { 3363sub new {
3196 my $class = shift; 3364 my $class = shift;
3197 3365
3198 my $self = $class->SUPER::new ( 3366 my $self = $class->SUPER::new (
3199 buttonbar => (new CFClient::UI::Buttonbar), 3367 buttonbar => (new CFPlus::UI::Buttonbar),
3200 multiplexer => (new CFClient::UI::Multiplexer expand => 1), 3368 multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
3201 # filter => # will be put between multiplexer and $self 3369 # filter => # will be put between multiplexer and $self
3202 @_, 3370 @_,
3203 ); 3371 );
3204 3372
3205 $self->{filter}->add ($self->{multiplexer}) if $self->{filter}; 3373 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3211sub add { 3379sub add {
3212 my ($self, $title, $widget, $tooltip) = @_; 3380 my ($self, $title, $widget, $tooltip) = @_;
3213 3381
3214 Scalar::Util::weaken $self; 3382 Scalar::Util::weaken $self;
3215 3383
3216 $self->{buttonbar}->add (new CFClient::UI::Button 3384 $self->{buttonbar}->add (new CFPlus::UI::Button
3217 markup => $title, 3385 markup => $title,
3218 tooltip => $tooltip, 3386 tooltip => $tooltip,
3219 on_activate => sub { $self->set_current_page ($widget) }, 3387 on_activate => sub { $self->set_current_page ($widget) },
3220 ); 3388 );
3221 3389
3222 $self->{multiplexer}->add ($widget); 3390 $self->{multiplexer}->add ($widget);
3223} 3391}
3224 3392
3393sub get_current_page {
3394 my ($self) = @_;
3395
3396 $self->{multiplexer}->get_current_page
3397}
3398
3225sub set_current_page { 3399sub set_current_page {
3226 my ($self, $page) = @_; 3400 my ($self, $page) = @_;
3227 3401
3228 $self->{multiplexer}->set_current_page ($page); 3402 $self->{multiplexer}->set_current_page ($page);
3229 $self->emit (page_changed => $self->{multiplexer}{current}); 3403 $self->emit (page_changed => $self->{multiplexer}{current});
3230} 3404}
3231 3405
3232############################################################################# 3406#############################################################################
3233 3407
3234package CFClient::UI::Combobox; 3408package CFPlus::UI::Selector;
3235 3409
3236use utf8; 3410use utf8;
3237 3411
3238our @ISA = CFClient::UI::Button::; 3412our @ISA = CFPlus::UI::Button::;
3239 3413
3240sub new { 3414sub new {
3241 my $class = shift; 3415 my $class = shift;
3242 3416
3243 my $self = $class->SUPER::new ( 3417 my $self = $class->SUPER::new (
3260 my ($value, $title, $tooltip) = @$_; 3434 my ($value, $title, $tooltip) = @$_;
3261 3435
3262 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }]; 3436 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3263 } 3437 }
3264 3438
3265 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 3439 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
3266} 3440}
3267 3441
3268sub _set_value { 3442sub _set_value {
3269 my ($self, $value) = @_; 3443 my ($self, $value) = @_;
3270 3444
3285 $self->emit (changed => $value); 3459 $self->emit (changed => $value);
3286} 3460}
3287 3461
3288############################################################################# 3462#############################################################################
3289 3463
3290package CFClient::UI::Statusbox; 3464package CFPlus::UI::Statusbox;
3291 3465
3292our @ISA = CFClient::UI::VBox::; 3466our @ISA = CFPlus::UI::VBox::;
3293 3467
3294sub new { 3468sub new {
3295 my $class = shift; 3469 my $class = shift;
3296 3470
3297 my $self = $class->SUPER::new ( 3471 my $self = $class->SUPER::new (
3309sub reorder { 3483sub reorder {
3310 my ($self) = @_; 3484 my ($self) = @_;
3311 my $NOW = Time::HiRes::time; 3485 my $NOW = Time::HiRes::time;
3312 3486
3313 # freeze display when hovering over any label 3487 # freeze display when hovering over any label
3314 return if $CFClient::UI::TOOLTIP->{owner} 3488 return if $CFPlus::UI::TOOLTIP->{owner}
3315 && grep $CFClient::UI::TOOLTIP->{owner} == $_->{label}, 3489 && grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
3316 values %{ $self->{item} }; 3490 values %{ $self->{item} };
3317 3491
3318 while (my ($k, $v) = each %{ $self->{item} }) { 3492 while (my ($k, $v) = each %{ $self->{item} }) {
3319 delete $self->{item}{$k} if $v->{timeout} < $NOW; 3493 delete $self->{item}{$k} if $v->{timeout} < $NOW;
3320 } 3494 }
3341 for ($short) { 3515 for ($short) {
3342 s/^\s+//; 3516 s/^\s+//;
3343 s/\s+/ /g; 3517 s/\s+/ /g;
3344 } 3518 }
3345 3519
3346 new CFClient::UI::Label 3520 new CFPlus::UI::Label
3347 markup => $short, 3521 markup => $short,
3348 tooltip => $item->{tooltip}, 3522 tooltip => $item->{tooltip},
3349 tooltip_font => $::FONT_PROP, 3523 tooltip_font => $::FONT_PROP,
3350 tooltip_width => 0.67, 3524 tooltip_width => 0.67,
3351 fontsize => $item->{fontsize} || $self->{fontsize}, 3525 fontsize => $item->{fontsize} || $self->{fontsize},
3405 count => 1, 3579 count => 1,
3406 %arg, 3580 %arg,
3407 }; 3581 };
3408 } 3582 }
3409 3583
3584 $ROOT->on_refresh (reorder => sub {
3410 $self->reorder; 3585 $self->reorder;
3586 });
3411} 3587}
3412 3588
3413sub reconfigure { 3589sub reconfigure {
3414 my ($self) = @_; 3590 my ($self) = @_;
3415 3591
3428 $self->SUPER::destroy; 3604 $self->SUPER::destroy;
3429} 3605}
3430 3606
3431############################################################################# 3607#############################################################################
3432 3608
3433package CFClient::UI::Inventory; 3609package CFPlus::UI::Inventory;
3434 3610
3435our @ISA = CFClient::UI::ScrolledWindow::; 3611our @ISA = CFPlus::UI::Table::;
3436 3612
3437sub new { 3613sub new {
3438 my $class = shift; 3614 my $class = shift;
3439 3615
3440 my $self = $class->SUPER::new ( 3616 my $self = $class->SUPER::new (
3441 child => (new CFClient::UI::Table col_expand => [0, 1, 0]), 3617 col_expand => [0, 1, 0],
3618 items => [],
3442 @_, 3619 @_,
3443 ); 3620 );
3444 3621
3622 $self->set_sort_order (undef);
3623
3445 $self 3624 $self
3625}
3626
3627sub update_items {
3628 my ($self) = @_;
3629
3630 $self->clear;
3631
3632 my @item = $self->{sort}->(@{ $self->{items} });
3633
3634 my @adds;
3635 my $row = 0;
3636 for my $item ($self->{sort}->(@{ $self->{items} })) {
3637 CFPlus::Item::update_widgets $item;
3638
3639 push @adds, 0, $row, $item->{face_widget};
3640 push @adds, 1, $row, $item->{desc_widget};
3641 push @adds, 2, $row, $item->{weight_widget};
3642
3643 $row++;
3644 }
3645
3646 $self->add (@adds);
3647}
3648
3649sub set_sort_order {
3650 my ($self, $order) = @_;
3651
3652 $self->{sort} = $order ||= sub {
3653 sort {
3654 $a->{type} <=> $b->{type}
3655 or $a->{name} cmp $b->{name}
3656 } @_
3657 };
3658
3659 $self->update_items;
3446} 3660}
3447 3661
3448sub set_items { 3662sub set_items {
3449 my ($self, $items) = @_; 3663 my ($self, $items) = @_;
3450 3664
3451 $self->{child}->clear; 3665 $self->{items} = [$items ? values %$items : ()];
3452 return unless $items; 3666 $self->update_items;
3453
3454 my @items = sort {
3455 ($a->{type} <=> $b->{type})
3456 or ($a->{name} cmp $b->{name})
3457 } @$items;
3458
3459 $self->{real_items} = \@items;
3460
3461 my $row = 0;
3462 for my $item (@items) {
3463 CFClient::Item::update_widgets $item;
3464
3465 $self->{child}->add (0, $row, $item->{face_widget});
3466 $self->{child}->add (1, $row, $item->{desc_widget});
3467 $self->{child}->add (2, $row, $item->{weight_widget});
3468
3469 $row++;
3470 }
3471} 3667}
3472 3668
3473############################################################################# 3669#############################################################################
3474 3670
3475package CFClient::UI::BindEditor;
3476
3477our @ISA = CFClient::UI::FancyFrame::;
3478
3479sub new {
3480 my $class = shift;
3481
3482 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3483
3484 $self->add (my $vb = new CFClient::UI::VBox);
3485
3486
3487 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3488 text => "start recording",
3489 tooltip => "Start/Stops recording of actions."
3490 ."All subsequent actions after the recording started will be captured."
3491 ."The actions are displayed after the record was stopped."
3492 ."To bind the action you have to click on the 'Bind' button",
3493 on_activate => sub {
3494 unless ($self->{recording}) {
3495 $self->start;
3496 } else {
3497 $self->stop;
3498 }
3499 });
3500
3501 $vb->add (new CFClient::UI::Label text => "Actions:");
3502 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3503
3504 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3505 $vb->add (my $hb = new CFClient::UI::HBox);
3506 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3507 $hb->add (new CFClient::UI::Button
3508 text => "bind",
3509 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3510 on_activate => sub {
3511 $self->ask_for_bind;
3512 });
3513
3514 $vb->add (my $hb = new CFClient::UI::HBox);
3515 $hb->add (new CFClient::UI::Button
3516 text => "ok",
3517 expand => 1,
3518 tooltip => "This closes the binding editor and saves the binding",
3519 on_activate => sub {
3520 $self->hide;
3521 $self->commit;
3522 });
3523
3524 $hb->add (new CFClient::UI::Button
3525 text => "cancel",
3526 expand => 1,
3527 tooltip => "This closes the binding editor without saving",
3528 on_activate => sub {
3529 $self->hide;
3530 $self->{binding_cancel}->()
3531 if $self->{binding_cancel};
3532 });
3533
3534 $self->update_binding_widgets;
3535
3536 $self
3537}
3538
3539sub cfg_bind {
3540 my ($self, $mod, $sym, $cmds) = @_;
3541 $::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
3542 ::update_bindings ();
3543}
3544
3545sub cfg_unbind {
3546 my ($self, $mod, $sym, $cmds) = @_;
3547 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
3548 ::update_bindings ();
3549}
3550
3551sub commit {
3552 my ($self) = @_;
3553 my ($mod, $sym, $cmds) = $self->get_binding;
3554 if ($sym != 0 && @$cmds > 0) {
3555 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3556 ."'. Don't forget 'Save Config'!");
3557 $self->{binding_change}->($mod, $sym, $cmds)
3558 if $self->{binding_change};
3559 } else {
3560 $::STATUSBOX->add ("No action bound, no key or action specified!");
3561 $self->{binding_cancel}->()
3562 if $self->{binding_cancel};
3563 }
3564}
3565
3566sub start {
3567 my ($self) = @_;
3568
3569 $self->{rec_btn}->set_text ("stop recording");
3570 $self->{recording} = 1;
3571 $self->clear_command_list;
3572 $::CONN->start_record if $::CONN;
3573}
3574
3575sub stop {
3576 my ($self) = @_;
3577
3578 $self->{rec_btn}->set_text ("start recording");
3579 $self->{recording} = 0;
3580
3581 my $rec;
3582 $rec = $::CONN->stop_record if $::CONN;
3583 return unless ref $rec eq 'ARRAY';
3584 $self->set_command_list ($rec);
3585}
3586
3587
3588sub ask_for_bind_and_commit {
3589 my ($self) = @_;
3590 $self->ask_for_bind (1);
3591}
3592
3593sub ask_for_bind {
3594 my ($self, $commit, $end_cb) = @_;
3595
3596 CFClient::Binder::open_binding_dialog (sub {
3597 my ($mod, $sym) = @_;
3598 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3599 $self->update_binding_widgets;
3600 $self->commit if $commit;
3601 $end_cb->() if $end_cb;
3602 });
3603}
3604
3605# $mod and $sym are the modifiers and key symbol
3606# $cmds is a array ref of strings (the commands)
3607# $cb is the callback that is executed on OK
3608# $ccb is the callback that is executed on CANCEL and
3609# when the binding was unsuccessful on OK
3610sub set_binding {
3611 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3612
3613 $self->clear_command_list;
3614 $self->{recording} = 0;
3615 $self->{rec_btn}->set_text ("start recording");
3616
3617 $self->{binding} = [$mod, $sym];
3618 $self->{commands} = $cmds;
3619
3620 $self->{binding_change} = $cb;
3621 $self->{binding_cancel} = $ccb;
3622
3623 $self->update_binding_widgets;
3624}
3625
3626# this is a shortcut method that asks for a binding
3627# and then just binds it.
3628sub do_quick_binding {
3629 my ($self, $cmds, $end_cb) = @_;
3630 $self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
3631 $self->ask_for_bind (1, $end_cb);
3632}
3633
3634sub update_binding_widgets {
3635 my ($self) = @_;
3636 my ($mod, $sym, $cmds) = $self->get_binding;
3637 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3638 $self->set_command_list ($cmds);
3639}
3640
3641sub get_binding {
3642 my ($self) = @_;
3643 return (
3644 $self->{binding}->[0],
3645 $self->{binding}->[1],
3646 [ grep { defined $_ } @{$self->{commands}} ]
3647 );
3648}
3649
3650sub clear_command_list {
3651 my ($self) = @_;
3652 $self->{cmdbox}->clear ();
3653}
3654
3655sub set_command_list {
3656 my ($self, $cmds) = @_;
3657
3658 $self->{cmdbox}->clear ();
3659 $self->{commands} = $cmds;
3660
3661 my $idx = 0;
3662
3663 for (@$cmds) {
3664 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3665
3666 my $i = $idx;
3667 $hb->add (new CFClient::UI::Label text => $_);
3668 $hb->add (new CFClient::UI::Button
3669 text => "delete",
3670 tooltip => "Deletes the action from the record",
3671 on_activate => sub {
3672 $self->{cmdbox}->remove ($hb);
3673 $cmds->[$i] = undef;
3674 });
3675
3676
3677 $idx++
3678 }
3679}
3680
3681#############################################################################
3682
3683package CFClient::UI::SpellList; 3671package CFPlus::UI::SpellList;
3684 3672
3685our @ISA = CFClient::UI::Table::; 3673our @ISA = CFPlus::UI::Table::;
3686 3674
3687sub new { 3675sub new {
3688 my $class = shift; 3676 my $class = shift;
3689 3677
3690 my $self = $class->SUPER::new ( 3678 my $self = $class->SUPER::new (
3708 "<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL"); 3696 "<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
3709 3697
3710sub rebuild_spell_list { 3698sub rebuild_spell_list {
3711 my ($self) = @_; 3699 my ($self) = @_;
3712 3700
3713 $CFClient::UI::ROOT->on_refresh ($self => sub { 3701 $CFPlus::UI::ROOT->on_refresh ($self => sub {
3714 $self->clear; 3702 $self->clear;
3715 3703
3716 return unless $::CONN; 3704 return unless $::CONN;
3717 3705
3718 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME); 3706 $self->add (1, 0, new CFPlus::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3719 $self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL); 3707 $self->add (2, 0, new CFPlus::UI::Label text => "Skill", @TOOLTIP_SKILL);
3720 $self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL); 3708 $self->add (3, 0, new CFPlus::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3721 $self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP); 3709 $self->add (4, 0, new CFPlus::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3722 $self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG); 3710 $self->add (5, 0, new CFPlus::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3723 3711
3724 my $row = 0; 3712 my $row = 0;
3725 3713
3726 for (sort { $a cmp $b } keys %{ $self->{spell} }) { 3714 for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3727 my $spell = $self->{spell}{$_}; 3715 my $spell = $self->{spell}{$_};
3734 if ($ev->{button} == 1) { 3722 if ($ev->{button} == 1) {
3735 $::CONN->user_send ("cast $spell->{name}"); 3723 $::CONN->user_send ("cast $spell->{name}");
3736 } elsif ($ev->{button} == 2) { 3724 } elsif ($ev->{button} == 2) {
3737 $::CONN->user_send ("invoke $spell->{name}"); 3725 $::CONN->user_send ("invoke $spell->{name}");
3738 } elsif ($ev->{button} == 3) { 3726 } elsif ($ev->{button} == 3) {
3739 (new CFClient::UI::Menu 3727 (new CFPlus::UI::Menu
3740 items => [ 3728 items => [
3741 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }], 3729 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3742 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }], 3730 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3743 ], 3731 ],
3744 )->popup ($ev); 3732 )->popup ($ev);
3745 } else { 3733 } else {
3746 return 0; 3734 return 0;
3750 }; 3738 };
3751 3739
3752 my $tooltip = "$spell->{message}$TOOLTIP_ALL"; 3740 my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3753 3741
3754 #TODO: add path info to tooltip 3742 #TODO: add path info to tooltip
3755 #$self->add (6, $row, new CFClient::UI::Label text => $spell->{path}); 3743 #$self->add (6, $row, new CFPlus::UI::Label text => $spell->{path});
3756 3744
3757 $self->add (0, $row, new CFClient::UI::Face 3745 $self->add (0, $row, new CFPlus::UI::Face
3758 face => $spell->{face}, 3746 face => $spell->{face},
3759 can_hover => 1, 3747 can_hover => 1,
3760 can_events => 1, 3748 can_events => 1,
3761 tooltip => $tooltip, 3749 tooltip => $tooltip,
3762 on_button_down => $spell_cb, 3750 on_button_down => $spell_cb,
3763 ); 3751 );
3764 3752
3765 $self->add (1, $row, new CFClient::UI::Label 3753 $self->add (1, $row, new CFPlus::UI::Label
3766 expand => 1, 3754 expand => 1,
3767 text => $spell->{name}, 3755 text => $spell->{name},
3768 can_hover => 1, 3756 can_hover => 1,
3769 can_events => 1, 3757 can_events => 1,
3770 tooltip => $tooltip, 3758 tooltip => $tooltip,
3771 on_button_down => $spell_cb, 3759 on_button_down => $spell_cb,
3772 ); 3760 );
3773 3761
3774 $self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL); 3762 $self->add (2, $row, new CFPlus::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3775 $self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL); 3763 $self->add (3, $row, new CFPlus::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3776 $self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP); 3764 $self->add (4, $row, new CFPlus::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3777 $self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG); 3765 $self->add (5, $row, new CFPlus::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3778 } 3766 }
3779 }); 3767 });
3780} 3768}
3781 3769
3782sub add_spell { 3770sub add_spell {
3800 $self->rebuild_spell_list; 3788 $self->rebuild_spell_list;
3801} 3789}
3802 3790
3803############################################################################# 3791#############################################################################
3804 3792
3805package CFClient::UI::Root; 3793package CFPlus::UI::Root;
3806 3794
3807our @ISA = CFClient::UI::Container::; 3795our @ISA = CFPlus::UI::Container::;
3808 3796
3809use List::Util qw(min max); 3797use List::Util qw(min max);
3810 3798
3811use CFClient::OpenGL; 3799use CFPlus::OpenGL;
3812 3800
3813sub new { 3801sub new {
3814 my $class = shift; 3802 my $class = shift;
3815 3803
3816 my $self = $class->SUPER::new ( 3804 my $self = $class->SUPER::new (
3992 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 3980 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3993 3981
3994 $w = 0 if $w < 0; 3982 $w = 0 if $w < 0;
3995 $h = 0 if $h < 0; 3983 $h = 0 if $h < 0;
3996 3984
3985 $w = max $widget->{min_w}, $w;
3986 $h = max $widget->{min_h}, $h;
3987
3988# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
3989# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
3990
3991 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3992 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3993
3997 $w = int $w + 0.5; 3994 $w = int $w + 0.5;
3998 $h = int $h + 0.5; 3995 $h = int $h + 0.5;
3999 3996
4000 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 3997 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
4001 $widget->{old_w} = $widget->{w}; 3998 $widget->{old_w} = $widget->{w};
4024 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 4021 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
4025 glMatrixMode GL_MODELVIEW; 4022 glMatrixMode GL_MODELVIEW;
4026 glLoadIdentity; 4023 glLoadIdentity;
4027 4024
4028 { 4025 {
4029 package CFClient::UI::Base; 4026 package CFPlus::UI::Base;
4030 4027
4031 ($draw_x, $draw_y, $draw_w, $draw_h) = 4028 ($draw_x, $draw_y, $draw_w, $draw_h) =
4032 (0, 0, $self->{w}, $self->{h}); 4029 (0, 0, $self->{w}, $self->{h});
4033 } 4030 }
4034 4031
4035 $self->_draw; 4032 $self->_draw;
4036} 4033}
4037 4034
4038############################################################################# 4035#############################################################################
4039 4036
4040package CFClient::UI; 4037package CFPlus::UI;
4041 4038
4042$ROOT = new CFClient::UI::Root; 4039$ROOT = new CFPlus::UI::Root;
4043$TOOLTIP = new CFClient::UI::Tooltip z => 900; 4040$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
4044 4041
40451 40421
4046 4043

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines