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.313 by root, Sat Jun 24 00:24:09 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 glDisable GL_BLEND;
2748 for (@w) { 2889 for (@w) {
2749 my ($dx, $dy) = splice @s, 0, 2, (); 2890 my ($dx, $dy) = splice @s, 0, 2, ();
2750 2891
2751 $_->{x} = $dx + $para->{indent}; 2892 $_->{x} = $dx + $para->{indent};
2752 $_->{y} = $dy + $y - $y0; 2893 $_->{y} = $dy + $y - $y0;
2753 2894
2754 $_->draw; 2895 $_->draw;
2755 } 2896 }
2756 glEnable GL_BLEND;
2757 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2758 } 2897 }
2759 } 2898 }
2760
2761 $y += $h;
2762 } 2899 }
2763
2764 glDisable GL_BLEND;
2765 }; 2900 };
2766 }); 2901 });
2767} 2902}
2768 2903
2769sub reconfigure { 2904sub reconfigure {
2787 $self->{children}[1]->draw; 2922 $self->{children}[1]->draw;
2788} 2923}
2789 2924
2790############################################################################# 2925#############################################################################
2791 2926
2792package CFClient::UI::Animator; 2927package CFPlus::UI::Animator;
2793 2928
2794use CFClient::OpenGL; 2929use CFPlus::OpenGL;
2795 2930
2796our @ISA = CFClient::UI::Bin::; 2931our @ISA = CFPlus::UI::Bin::;
2797 2932
2798sub moveto { 2933sub moveto {
2799 my ($self, $x, $y) = @_; 2934 my ($self, $x, $y) = @_;
2800 2935
2801 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 2936 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
2829 glPopMatrix; 2964 glPopMatrix;
2830} 2965}
2831 2966
2832############################################################################# 2967#############################################################################
2833 2968
2834package CFClient::UI::Flopper; 2969package CFPlus::UI::Flopper;
2835 2970
2836our @ISA = CFClient::UI::Button::; 2971our @ISA = CFPlus::UI::Button::;
2837 2972
2838sub new { 2973sub new {
2839 my $class = shift; 2974 my $class = shift;
2840 2975
2841 my $self = $class->SUPER::new ( 2976 my $self = $class->SUPER::new (
2853 $self->{other}->toggle_visibility; 2988 $self->{other}->toggle_visibility;
2854} 2989}
2855 2990
2856############################################################################# 2991#############################################################################
2857 2992
2858package CFClient::UI::Tooltip; 2993package CFPlus::UI::Tooltip;
2859 2994
2860our @ISA = CFClient::UI::Bin::; 2995our @ISA = CFPlus::UI::Bin::;
2861 2996
2862use CFClient::OpenGL; 2997use CFPlus::OpenGL;
2863 2998
2864sub new { 2999sub new {
2865 my $class = shift; 3000 my $class = shift;
2866 3001
2867 $class->SUPER::new ( 3002 $class->SUPER::new (
2870 ) 3005 )
2871} 3006}
2872 3007
2873sub set_tooltip_from { 3008sub set_tooltip_from {
2874 my ($self, $widget) = @_; 3009 my ($self, $widget) = @_;
3010
3011 $widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
3012 if $widget->{tooltip} =~ /^#(.*)$/;
2875 3013
2876 my $tooltip = $widget->{tooltip}; 3014 my $tooltip = $widget->{tooltip};
2877 3015
2878 if ($ENV{CFPLUS_DEBUG} & 2) { 3016 if ($ENV{CFPLUS_DEBUG} & 2) {
2879 $tooltip .= "\n\n" . (ref $widget) . "\n" 3017 $tooltip .= "\n\n" . (ref $widget) . "\n"
2883 } 3021 }
2884 3022
2885 $tooltip =~ s/^\n+//; 3023 $tooltip =~ s/^\n+//;
2886 $tooltip =~ s/\n+$//; 3024 $tooltip =~ s/\n+$//;
2887 3025
2888 $self->add (new CFClient::UI::Label 3026 $self->add (new CFPlus::UI::Label
2889 markup => $tooltip, 3027 markup => $tooltip,
2890 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3028 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2891 fontsize => 0.8, 3029 fontsize => 0.8,
2892 fg => [0, 0, 0, 1], 3030 style => 1, # FLAG_INVERSE
2893 ellipsise => 0, 3031 ellipsise => 0,
2894 font => ($widget->{tooltip_font} || $::FONT_PROP), 3032 font => ($widget->{tooltip_font} || $::FONT_PROP),
2895 ); 3033 );
2896} 3034}
2897 3035
2916 3054
2917 $self->{root}->on_post_alloc ("move_$self" => sub { 3055 $self->{root}->on_post_alloc ("move_$self" => sub {
2918 my $widget = $self->{owner} 3056 my $widget = $self->{owner}
2919 or return; 3057 or return;
2920 3058
3059 if ($widget->{visible}) {
2921 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 3060 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2922 3061
2923 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 3062 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2924 if $x + $self->{w} > $self->{root}{w}; 3063 if $x + $self->{w} > $self->{root}{w};
2925 3064
2926 $self->move_abs ($x, $y); 3065 $self->move_abs ($x, $y);
3066 } else {
3067 $self->hide;
3068 }
2927 }); 3069 });
2928} 3070}
2929 3071
2930sub _draw { 3072sub _draw {
2931 my ($self) = @_; 3073 my ($self) = @_;
2955 $self->SUPER::_draw; 3097 $self->SUPER::_draw;
2956} 3098}
2957 3099
2958############################################################################# 3100#############################################################################
2959 3101
2960package CFClient::UI::Face; 3102package CFPlus::UI::Face;
2961 3103
2962our @ISA = CFClient::UI::Base::; 3104our @ISA = CFPlus::UI::DrawBG::;
2963 3105
2964use CFClient::OpenGL; 3106use CFPlus::OpenGL;
2965 3107
2966sub new { 3108sub new {
2967 my $class = shift; 3109 my $class = shift;
2968 3110
2969 my $self = $class->SUPER::new ( 3111 my $self = $class->SUPER::new (
3004sub _draw { 3146sub _draw {
3005 my ($self) = @_; 3147 my ($self) = @_;
3006 3148
3007 return unless $::CONN; 3149 return unless $::CONN;
3008 3150
3151 $self->SUPER::_draw;
3152
3009 my $face; 3153 my $face;
3010 3154
3011 if ($self->{frame}) { 3155 if ($self->{frame}) {
3012 my $anim = $::CONN->{anim}[$self->{anim}]; 3156 my $anim = $::CONN->{anim}[$self->{anim}];
3013 3157
3035 $self->SUPER::destroy; 3179 $self->SUPER::destroy;
3036} 3180}
3037 3181
3038############################################################################# 3182#############################################################################
3039 3183
3040package CFClient::UI::Buttonbar; 3184package CFPlus::UI::Buttonbar;
3041 3185
3042our @ISA = CFClient::UI::HBox::; 3186our @ISA = CFPlus::UI::HBox::;
3043 3187
3044# TODO: should actualyl wrap buttons and other goodies. 3188# TODO: should actualyl wrap buttons and other goodies.
3045 3189
3046############################################################################# 3190#############################################################################
3047 3191
3048package CFClient::UI::Menu; 3192package CFPlus::UI::Menu;
3049 3193
3050our @ISA = CFClient::UI::FancyFrame::; 3194our @ISA = CFPlus::UI::FancyFrame::;
3051 3195
3052use CFClient::OpenGL; 3196use CFPlus::OpenGL;
3053 3197
3054sub new { 3198sub new {
3055 my $class = shift; 3199 my $class = shift;
3056 3200
3057 my $self = $class->SUPER::new ( 3201 my $self = $class->SUPER::new (
3058 items => [], 3202 items => [],
3059 z => 100, 3203 z => 100,
3060 @_, 3204 @_,
3061 ); 3205 );
3062 3206
3063 $self->add ($self->{vbox} = new CFClient::UI::VBox); 3207 $self->add ($self->{vbox} = new CFPlus::UI::VBox);
3064 3208
3065 for my $item (@{ $self->{items} }) { 3209 for my $item (@{ $self->{items} }) {
3066 my ($widget, $cb, $tooltip) = @$item; 3210 my ($widget, $cb, $tooltip) = @$item;
3067 3211
3068 # handle various types of items, only text for now 3212 # handle various types of items, only text for now
3069 if (!ref $widget) { 3213 if (!ref $widget) {
3214 if ($widget =~ /\t/) {
3215 my ($left, $right) = split /\t/, $widget, 2;
3216
3070 $widget = new CFClient::UI::Label 3217 $widget = new CFPlus::UI::HBox
3071 can_hover => 1, 3218 can_hover => 1,
3072 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,
3073 markup => $widget, 3231 markup => $widget,
3074 tooltip => $tooltip 3232 tooltip => $tooltip;
3233 }
3075 } 3234 }
3076 3235
3077 $self->{item}{$widget} = $item; 3236 $self->{item}{$widget} = $item;
3078 3237
3079 $self->{vbox}->add ($widget); 3238 $self->{vbox}->add ($widget);
3122 1 3281 1
3123} 3282}
3124 3283
3125############################################################################# 3284#############################################################################
3126 3285
3127package CFClient::UI::Multiplexer; 3286package CFPlus::UI::Multiplexer;
3128 3287
3129our @ISA = CFClient::UI::Container::; 3288our @ISA = CFPlus::UI::Container::;
3130 3289
3131sub new { 3290sub new {
3132 my $class = shift; 3291 my $class = shift;
3133 3292
3134 my $self = $class->SUPER::new ( 3293 my $self = $class->SUPER::new (
3148 3307
3149 $self->{current} = $self->{children}[0] 3308 $self->{current} = $self->{children}[0]
3150 if @{ $self->{children} }; 3309 if @{ $self->{children} };
3151} 3310}
3152 3311
3312sub get_current_page {
3313 my ($self) = @_;
3314
3315 $self->{current}
3316}
3317
3153sub set_current_page { 3318sub set_current_page {
3154 my ($self, $page_or_widget) = @_; 3319 my ($self, $page_or_widget) = @_;
3155 3320
3156 my $widget = ref $page_or_widget 3321 my $widget = ref $page_or_widget
3157 ? $page_or_widget 3322 ? $page_or_widget
3189 $self->{current}->draw; 3354 $self->{current}->draw;
3190} 3355}
3191 3356
3192############################################################################# 3357#############################################################################
3193 3358
3194package CFClient::UI::Notebook; 3359package CFPlus::UI::Notebook;
3195 3360
3196our @ISA = CFClient::UI::VBox::; 3361our @ISA = CFPlus::UI::VBox::;
3197 3362
3198sub new { 3363sub new {
3199 my $class = shift; 3364 my $class = shift;
3200 3365
3201 my $self = $class->SUPER::new ( 3366 my $self = $class->SUPER::new (
3202 buttonbar => (new CFClient::UI::Buttonbar), 3367 buttonbar => (new CFPlus::UI::Buttonbar),
3203 multiplexer => (new CFClient::UI::Multiplexer expand => 1), 3368 multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
3204 # filter => # will be put between multiplexer and $self 3369 # filter => # will be put between multiplexer and $self
3205 @_, 3370 @_,
3206 ); 3371 );
3207 3372
3208 $self->{filter}->add ($self->{multiplexer}) if $self->{filter}; 3373 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3214sub add { 3379sub add {
3215 my ($self, $title, $widget, $tooltip) = @_; 3380 my ($self, $title, $widget, $tooltip) = @_;
3216 3381
3217 Scalar::Util::weaken $self; 3382 Scalar::Util::weaken $self;
3218 3383
3219 $self->{buttonbar}->add (new CFClient::UI::Button 3384 $self->{buttonbar}->add (new CFPlus::UI::Button
3220 markup => $title, 3385 markup => $title,
3221 tooltip => $tooltip, 3386 tooltip => $tooltip,
3222 on_activate => sub { $self->set_current_page ($widget) }, 3387 on_activate => sub { $self->set_current_page ($widget) },
3223 ); 3388 );
3224 3389
3225 $self->{multiplexer}->add ($widget); 3390 $self->{multiplexer}->add ($widget);
3226} 3391}
3227 3392
3393sub get_current_page {
3394 my ($self) = @_;
3395
3396 $self->{multiplexer}->get_current_page
3397}
3398
3228sub set_current_page { 3399sub set_current_page {
3229 my ($self, $page) = @_; 3400 my ($self, $page) = @_;
3230 3401
3231 $self->{multiplexer}->set_current_page ($page); 3402 $self->{multiplexer}->set_current_page ($page);
3232 $self->emit (page_changed => $self->{multiplexer}{current}); 3403 $self->emit (page_changed => $self->{multiplexer}{current});
3233} 3404}
3234 3405
3235############################################################################# 3406#############################################################################
3236 3407
3237package CFClient::UI::Combobox; 3408package CFPlus::UI::Selector;
3238 3409
3239use utf8; 3410use utf8;
3240 3411
3241our @ISA = CFClient::UI::Button::; 3412our @ISA = CFPlus::UI::Button::;
3242 3413
3243sub new { 3414sub new {
3244 my $class = shift; 3415 my $class = shift;
3245 3416
3246 my $self = $class->SUPER::new ( 3417 my $self = $class->SUPER::new (
3263 my ($value, $title, $tooltip) = @$_; 3434 my ($value, $title, $tooltip) = @$_;
3264 3435
3265 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }]; 3436 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3266 } 3437 }
3267 3438
3268 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev); 3439 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
3269} 3440}
3270 3441
3271sub _set_value { 3442sub _set_value {
3272 my ($self, $value) = @_; 3443 my ($self, $value) = @_;
3273 3444
3288 $self->emit (changed => $value); 3459 $self->emit (changed => $value);
3289} 3460}
3290 3461
3291############################################################################# 3462#############################################################################
3292 3463
3293package CFClient::UI::Statusbox; 3464package CFPlus::UI::Statusbox;
3294 3465
3295our @ISA = CFClient::UI::VBox::; 3466our @ISA = CFPlus::UI::VBox::;
3296 3467
3297sub new { 3468sub new {
3298 my $class = shift; 3469 my $class = shift;
3299 3470
3300 my $self = $class->SUPER::new ( 3471 my $self = $class->SUPER::new (
3312sub reorder { 3483sub reorder {
3313 my ($self) = @_; 3484 my ($self) = @_;
3314 my $NOW = Time::HiRes::time; 3485 my $NOW = Time::HiRes::time;
3315 3486
3316 # freeze display when hovering over any label 3487 # freeze display when hovering over any label
3317 return if $CFClient::UI::TOOLTIP->{owner} 3488 return if $CFPlus::UI::TOOLTIP->{owner}
3318 && grep $CFClient::UI::TOOLTIP->{owner} == $_->{label}, 3489 && grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
3319 values %{ $self->{item} }; 3490 values %{ $self->{item} };
3320 3491
3321 while (my ($k, $v) = each %{ $self->{item} }) { 3492 while (my ($k, $v) = each %{ $self->{item} }) {
3322 delete $self->{item}{$k} if $v->{timeout} < $NOW; 3493 delete $self->{item}{$k} if $v->{timeout} < $NOW;
3323 } 3494 }
3344 for ($short) { 3515 for ($short) {
3345 s/^\s+//; 3516 s/^\s+//;
3346 s/\s+/ /g; 3517 s/\s+/ /g;
3347 } 3518 }
3348 3519
3349 new CFClient::UI::Label 3520 new CFPlus::UI::Label
3350 markup => $short, 3521 markup => $short,
3351 tooltip => $item->{tooltip}, 3522 tooltip => $item->{tooltip},
3352 tooltip_font => $::FONT_PROP, 3523 tooltip_font => $::FONT_PROP,
3353 tooltip_width => 0.67, 3524 tooltip_width => 0.67,
3354 fontsize => $item->{fontsize} || $self->{fontsize}, 3525 fontsize => $item->{fontsize} || $self->{fontsize},
3408 count => 1, 3579 count => 1,
3409 %arg, 3580 %arg,
3410 }; 3581 };
3411 } 3582 }
3412 3583
3584 $ROOT->on_refresh (reorder => sub {
3413 $self->reorder; 3585 $self->reorder;
3586 });
3414} 3587}
3415 3588
3416sub reconfigure { 3589sub reconfigure {
3417 my ($self) = @_; 3590 my ($self) = @_;
3418 3591
3431 $self->SUPER::destroy; 3604 $self->SUPER::destroy;
3432} 3605}
3433 3606
3434############################################################################# 3607#############################################################################
3435 3608
3436package CFClient::UI::Inventory; 3609package CFPlus::UI::Inventory;
3437 3610
3438our @ISA = CFClient::UI::ScrolledWindow::; 3611our @ISA = CFPlus::UI::Table::;
3439 3612
3440sub new { 3613sub new {
3441 my $class = shift; 3614 my $class = shift;
3442 3615
3443 my $self = $class->SUPER::new ( 3616 my $self = $class->SUPER::new (
3444 child => (new CFClient::UI::Table col_expand => [0, 1, 0]), 3617 col_expand => [0, 1, 0],
3618 items => [],
3445 @_, 3619 @_,
3446 ); 3620 );
3447 3621
3622 $self->set_sort_order (undef);
3623
3448 $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;
3449} 3660}
3450 3661
3451sub set_items { 3662sub set_items {
3452 my ($self, $items) = @_; 3663 my ($self, $items) = @_;
3453 3664
3454 $self->{child}->clear; 3665 $self->{items} = [$items ? values %$items : ()];
3455 return unless $items; 3666 $self->update_items;
3456
3457 my @items = sort {
3458 ($a->{type} <=> $b->{type})
3459 or ($a->{name} cmp $b->{name})
3460 } @$items;
3461
3462 $self->{real_items} = \@items;
3463
3464 my $row = 0;
3465 for my $item (@items) {
3466 CFClient::Item::update_widgets $item;
3467
3468 $self->{child}->add (0, $row, $item->{face_widget});
3469 $self->{child}->add (1, $row, $item->{desc_widget});
3470 $self->{child}->add (2, $row, $item->{weight_widget});
3471
3472 $row++;
3473 }
3474} 3667}
3475 3668
3476############################################################################# 3669#############################################################################
3477 3670
3478package CFClient::UI::BindEditor;
3479
3480our @ISA = CFClient::UI::FancyFrame::;
3481
3482sub new {
3483 my $class = shift;
3484
3485 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3486
3487 $self->add (my $vb = new CFClient::UI::VBox);
3488
3489
3490 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3491 text => "start recording",
3492 tooltip => "Start/Stops recording of actions."
3493 ."All subsequent actions after the recording started will be captured."
3494 ."The actions are displayed after the record was stopped."
3495 ."To bind the action you have to click on the 'Bind' button",
3496 on_activate => sub {
3497 unless ($self->{recording}) {
3498 $self->start;
3499 } else {
3500 $self->stop;
3501 }
3502 });
3503
3504 $vb->add (new CFClient::UI::Label text => "Actions:");
3505 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3506
3507 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3508 $vb->add (my $hb = new CFClient::UI::HBox);
3509 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3510 $hb->add (new CFClient::UI::Button
3511 text => "bind",
3512 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3513 on_activate => sub {
3514 $self->ask_for_bind;
3515 });
3516
3517 $vb->add (my $hb = new CFClient::UI::HBox);
3518 $hb->add (new CFClient::UI::Button
3519 text => "ok",
3520 expand => 1,
3521 tooltip => "This closes the binding editor and saves the binding",
3522 on_activate => sub {
3523 $self->hide;
3524 $self->commit;
3525 });
3526
3527 $hb->add (new CFClient::UI::Button
3528 text => "cancel",
3529 expand => 1,
3530 tooltip => "This closes the binding editor without saving",
3531 on_activate => sub {
3532 $self->hide;
3533 $self->{binding_cancel}->()
3534 if $self->{binding_cancel};
3535 });
3536
3537 $self->update_binding_widgets;
3538
3539 $self
3540}
3541
3542sub cfg_bind {
3543 my ($self, $mod, $sym, $cmds) = @_;
3544 $::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
3545 ::update_bindings ();
3546}
3547
3548sub cfg_unbind {
3549 my ($self, $mod, $sym, $cmds) = @_;
3550 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
3551 ::update_bindings ();
3552}
3553
3554sub commit {
3555 my ($self) = @_;
3556 my ($mod, $sym, $cmds) = $self->get_binding;
3557 if ($sym != 0 && @$cmds > 0) {
3558 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3559 ."'. Don't forget 'Save Config'!");
3560 $self->{binding_change}->($mod, $sym, $cmds)
3561 if $self->{binding_change};
3562 } else {
3563 $::STATUSBOX->add ("No action bound, no key or action specified!");
3564 $self->{binding_cancel}->()
3565 if $self->{binding_cancel};
3566 }
3567}
3568
3569sub start {
3570 my ($self) = @_;
3571
3572 $self->{rec_btn}->set_text ("stop recording");
3573 $self->{recording} = 1;
3574 $self->clear_command_list;
3575 $::CONN->start_record if $::CONN;
3576}
3577
3578sub stop {
3579 my ($self) = @_;
3580
3581 $self->{rec_btn}->set_text ("start recording");
3582 $self->{recording} = 0;
3583
3584 my $rec;
3585 $rec = $::CONN->stop_record if $::CONN;
3586 return unless ref $rec eq 'ARRAY';
3587 $self->set_command_list ($rec);
3588}
3589
3590
3591sub ask_for_bind_and_commit {
3592 my ($self) = @_;
3593 $self->ask_for_bind (1);
3594}
3595
3596sub ask_for_bind {
3597 my ($self, $commit, $end_cb) = @_;
3598
3599 CFClient::Binder::open_binding_dialog (sub {
3600 my ($mod, $sym) = @_;
3601 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3602 $self->update_binding_widgets;
3603 $self->commit if $commit;
3604 $end_cb->() if $end_cb;
3605 });
3606}
3607
3608# $mod and $sym are the modifiers and key symbol
3609# $cmds is a array ref of strings (the commands)
3610# $cb is the callback that is executed on OK
3611# $ccb is the callback that is executed on CANCEL and
3612# when the binding was unsuccessful on OK
3613sub set_binding {
3614 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3615
3616 $self->clear_command_list;
3617 $self->{recording} = 0;
3618 $self->{rec_btn}->set_text ("start recording");
3619
3620 $self->{binding} = [$mod, $sym];
3621 $self->{commands} = $cmds;
3622
3623 $self->{binding_change} = $cb;
3624 $self->{binding_cancel} = $ccb;
3625
3626 $self->update_binding_widgets;
3627}
3628
3629# this is a shortcut method that asks for a binding
3630# and then just binds it.
3631sub do_quick_binding {
3632 my ($self, $cmds, $end_cb) = @_;
3633 $self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
3634 $self->ask_for_bind (1, $end_cb);
3635}
3636
3637sub update_binding_widgets {
3638 my ($self) = @_;
3639 my ($mod, $sym, $cmds) = $self->get_binding;
3640 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3641 $self->set_command_list ($cmds);
3642}
3643
3644sub get_binding {
3645 my ($self) = @_;
3646 return (
3647 $self->{binding}->[0],
3648 $self->{binding}->[1],
3649 [ grep { defined $_ } @{$self->{commands}} ]
3650 );
3651}
3652
3653sub clear_command_list {
3654 my ($self) = @_;
3655 $self->{cmdbox}->clear ();
3656}
3657
3658sub set_command_list {
3659 my ($self, $cmds) = @_;
3660
3661 $self->{cmdbox}->clear ();
3662 $self->{commands} = $cmds;
3663
3664 my $idx = 0;
3665
3666 for (@$cmds) {
3667 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3668
3669 my $i = $idx;
3670 $hb->add (new CFClient::UI::Label text => $_);
3671 $hb->add (new CFClient::UI::Button
3672 text => "delete",
3673 tooltip => "Deletes the action from the record",
3674 on_activate => sub {
3675 $self->{cmdbox}->remove ($hb);
3676 $cmds->[$i] = undef;
3677 });
3678
3679
3680 $idx++
3681 }
3682}
3683
3684#############################################################################
3685
3686package CFClient::UI::SpellList; 3671package CFPlus::UI::SpellList;
3687 3672
3688our @ISA = CFClient::UI::Table::; 3673our @ISA = CFPlus::UI::Table::;
3689 3674
3690sub new { 3675sub new {
3691 my $class = shift; 3676 my $class = shift;
3692 3677
3693 my $self = $class->SUPER::new ( 3678 my $self = $class->SUPER::new (
3711 "<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");
3712 3697
3713sub rebuild_spell_list { 3698sub rebuild_spell_list {
3714 my ($self) = @_; 3699 my ($self) = @_;
3715 3700
3716 $CFClient::UI::ROOT->on_refresh ($self => sub { 3701 $CFPlus::UI::ROOT->on_refresh ($self => sub {
3717 $self->clear; 3702 $self->clear;
3718 3703
3719 return unless $::CONN; 3704 return unless $::CONN;
3720 3705
3721 $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);
3722 $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);
3723 $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);
3724 $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);
3725 $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);
3726 3711
3727 my $row = 0; 3712 my $row = 0;
3728 3713
3729 for (sort { $a cmp $b } keys %{ $self->{spell} }) { 3714 for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3730 my $spell = $self->{spell}{$_}; 3715 my $spell = $self->{spell}{$_};
3737 if ($ev->{button} == 1) { 3722 if ($ev->{button} == 1) {
3738 $::CONN->user_send ("cast $spell->{name}"); 3723 $::CONN->user_send ("cast $spell->{name}");
3739 } elsif ($ev->{button} == 2) { 3724 } elsif ($ev->{button} == 2) {
3740 $::CONN->user_send ("invoke $spell->{name}"); 3725 $::CONN->user_send ("invoke $spell->{name}");
3741 } elsif ($ev->{button} == 3) { 3726 } elsif ($ev->{button} == 3) {
3742 (new CFClient::UI::Menu 3727 (new CFPlus::UI::Menu
3743 items => [ 3728 items => [
3744 ["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}"]) }],
3745 ["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}"]) }],
3746 ], 3731 ],
3747 )->popup ($ev); 3732 )->popup ($ev);
3748 } else { 3733 } else {
3749 return 0; 3734 return 0;
3753 }; 3738 };
3754 3739
3755 my $tooltip = "$spell->{message}$TOOLTIP_ALL"; 3740 my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3756 3741
3757 #TODO: add path info to tooltip 3742 #TODO: add path info to tooltip
3758 #$self->add (6, $row, new CFClient::UI::Label text => $spell->{path}); 3743 #$self->add (6, $row, new CFPlus::UI::Label text => $spell->{path});
3759 3744
3760 $self->add (0, $row, new CFClient::UI::Face 3745 $self->add (0, $row, new CFPlus::UI::Face
3761 face => $spell->{face}, 3746 face => $spell->{face},
3762 can_hover => 1, 3747 can_hover => 1,
3763 can_events => 1, 3748 can_events => 1,
3764 tooltip => $tooltip, 3749 tooltip => $tooltip,
3765 on_button_down => $spell_cb, 3750 on_button_down => $spell_cb,
3766 ); 3751 );
3767 3752
3768 $self->add (1, $row, new CFClient::UI::Label 3753 $self->add (1, $row, new CFPlus::UI::Label
3769 expand => 1, 3754 expand => 1,
3770 text => $spell->{name}, 3755 text => $spell->{name},
3771 can_hover => 1, 3756 can_hover => 1,
3772 can_events => 1, 3757 can_events => 1,
3773 tooltip => $tooltip, 3758 tooltip => $tooltip,
3774 on_button_down => $spell_cb, 3759 on_button_down => $spell_cb,
3775 ); 3760 );
3776 3761
3777 $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);
3778 $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);
3779 $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);
3780 $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);
3781 } 3766 }
3782 }); 3767 });
3783} 3768}
3784 3769
3785sub add_spell { 3770sub add_spell {
3803 $self->rebuild_spell_list; 3788 $self->rebuild_spell_list;
3804} 3789}
3805 3790
3806############################################################################# 3791#############################################################################
3807 3792
3808package CFClient::UI::Root; 3793package CFPlus::UI::Root;
3809 3794
3810our @ISA = CFClient::UI::Container::; 3795our @ISA = CFPlus::UI::Container::;
3811 3796
3812use List::Util qw(min max); 3797use List::Util qw(min max);
3813 3798
3814use CFClient::OpenGL; 3799use CFPlus::OpenGL;
3815 3800
3816sub new { 3801sub new {
3817 my $class = shift; 3802 my $class = shift;
3818 3803
3819 my $self = $class->SUPER::new ( 3804 my $self = $class->SUPER::new (
3995 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 3980 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3996 3981
3997 $w = 0 if $w < 0; 3982 $w = 0 if $w < 0;
3998 $h = 0 if $h < 0; 3983 $h = 0 if $h < 0;
3999 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
4000 $w = int $w + 0.5; 3994 $w = int $w + 0.5;
4001 $h = int $h + 0.5; 3995 $h = int $h + 0.5;
4002 3996
4003 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}) {
4004 $widget->{old_w} = $widget->{w}; 3998 $widget->{old_w} = $widget->{w};
4027 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 4021 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
4028 glMatrixMode GL_MODELVIEW; 4022 glMatrixMode GL_MODELVIEW;
4029 glLoadIdentity; 4023 glLoadIdentity;
4030 4024
4031 { 4025 {
4032 package CFClient::UI::Base; 4026 package CFPlus::UI::Base;
4033 4027
4034 ($draw_x, $draw_y, $draw_w, $draw_h) = 4028 ($draw_x, $draw_y, $draw_w, $draw_h) =
4035 (0, 0, $self->{w}, $self->{h}); 4029 (0, 0, $self->{w}, $self->{h});
4036 } 4030 }
4037 4031
4038 $self->_draw; 4032 $self->_draw;
4039} 4033}
4040 4034
4041############################################################################# 4035#############################################################################
4042 4036
4043package CFClient::UI; 4037package CFPlus::UI;
4044 4038
4045$ROOT = new CFClient::UI::Root; 4039$ROOT = new CFPlus::UI::Root;
4046$TOOLTIP = new CFClient::UI::Tooltip z => 900; 4040$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
4047 4041
40481 40421
4049 4043

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines