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.384 by root, Fri Jul 20 16:32:11 2007 UTC vs.
Revision 1.453 by root, Wed Dec 26 20:46:39 2007 UTC

1package CFPlus::UI; 1package dc::UI;
2 2
3use utf8; 3use utf8;
4use strict; 4use strict;
5 5
6use List::Util (); 6use List::Util ();
7use Event;
8 7
9use CFPlus; 8use dc;
10use CFPlus::Pod; 9use dc::Pod;
11use CFPlus::Texture; 10use dc::Texture;
12 11
13our ($FOCUS, $HOVER, $GRAB); # various widgets 12our ($FOCUS, $HOVER, $GRAB); # various widgets
14 13
15our $LAYOUT; 14our $LAYOUT;
16our $ROOT; 15our $ROOT;
17our $TOOLTIP; 16our $TOOLTIP;
18our $BUTTON_STATE; 17our $BUTTON_STATE;
19 18
20our %WIDGET; # all widgets, weak-referenced 19our %WIDGET; # all widgets, weak-referenced
21 20
22our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub { 21our $TOOLTIP_WATCHER = EV::timer_ns 0, 0.03, sub {
22 $_[0]->stop;
23
23 if (!$GRAB) { 24 if (!$GRAB) {
24 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 25 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
25 if (length $widget->{tooltip}) { 26 if (length $widget->{tooltip}) {
26 if ($TOOLTIP->{owner} != $widget) { 27 if ($TOOLTIP->{owner} != $widget) {
27 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner}; 28 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
… …
30 $TOOLTIP->{owner} = $widget; 31 $TOOLTIP->{owner} = $widget;
31 $TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner}; 32 $TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner};
32 33
33 return if $ENV{CFPLUS_DEBUG} & 8; 34 return if $ENV{CFPLUS_DEBUG} & 8;
34 35
35 my $tip = $widget->{tooltip};
36
37 $tip = $tip->($widget) if CODE:: eq ref $tip;
38
39 $TOOLTIP->set_tooltip_from ($widget); 36 $TOOLTIP->set_tooltip_from ($widget);
40 $TOOLTIP->show; 37 $TOOLTIP->show;
41 } 38 }
42 39
43 return; 40 return;
… …
46 } 43 }
47 44
48 $TOOLTIP->hide; 45 $TOOLTIP->hide;
49 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner}; 46 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
50 delete $TOOLTIP->{owner}; 47 delete $TOOLTIP->{owner};
51}); 48};
52 49
53sub get_layout { 50sub get_layout {
54 my $layout; 51 my $layout;
55 52
56 for (grep { $_->{name} } values %WIDGET) { 53 for (grep { $_->{name} } values %WIDGET) {
… …
91 my $hover = $HOVER; $HOVER = $widget; 88 my $hover = $HOVER; $HOVER = $widget;
92 89
93 $hover->update if $hover && $hover->{can_hover}; 90 $hover->update if $hover && $hover->{can_hover};
94 $HOVER->update if $HOVER && $HOVER->{can_hover}; 91 $HOVER->update if $HOVER && $HOVER->{can_hover};
95 92
96 $TOOLTIP_WATCHER->start; 93 $TOOLTIP_WATCHER->again;
97 } 94 }
98} 95}
99 96
100sub feed_sdl_button_down_event { 97sub feed_sdl_button_down_event {
101 my ($ev) = @_; 98 my ($ev) = @_;
… …
107 my $widget = $ROOT->find_widget ($x, $y); 104 my $widget = $ROOT->find_widget ($x, $y);
108 105
109 $GRAB = $widget; 106 $GRAB = $widget;
110 $GRAB->update if $GRAB; 107 $GRAB->update if $GRAB;
111 108
112 $TOOLTIP_WATCHER->cb->(); 109 $TOOLTIP_WATCHER->invoke;
113 } 110 }
114 111
115 if ($GRAB) { 112 if ($GRAB) {
116 if ($ev->{button} == 4 || $ev->{button} == 5) { 113 if ($ev->{button} == 4 || $ev->{button} == 5) {
117 # mousewheel 114 # mousewheel
118 $ev->{dx} = 0;
119 $ev->{dy} = $ev->{button} * 2 - 9; 115 my $delta = $ev->{button} * 2 - 9;
116 my $shift = $ev->{mod} & dc::KMOD_SHIFT;
117
118 $ev->{dx} = $shift ? $delta : 0;
119 $ev->{dy} = $shift ? 0 : $delta;
120
120 $GRAB->emit (mouse_wheel => $ev); 121 $GRAB->emit (mouse_wheel => $ev);
121 } else { 122 } else {
122 $GRAB->emit (button_down => $ev) 123 $GRAB->emit (button_down => $ev)
123 } 124 }
124 } 125 }
… …
138 my $grab = $GRAB; undef $GRAB; 139 my $grab = $GRAB; undef $GRAB;
139 $grab->update if $grab; 140 $grab->update if $grab;
140 $GRAB->update if $GRAB; 141 $GRAB->update if $GRAB;
141 142
142 check_hover $widget; 143 check_hover $widget;
143 $TOOLTIP_WATCHER->cb->(); 144 $TOOLTIP_WATCHER->invoke;
144 } 145 }
145} 146}
146 147
147sub feed_sdl_motion_event { 148sub feed_sdl_motion_event {
148 my ($ev) = @_; 149 my ($ev) = @_;
… …
210 reconfigure_widgets; 211 reconfigure_widgets;
211} 212}
212 213
213############################################################################# 214#############################################################################
214 215
215package CFPlus::UI::Event; 216package dc::UI::Event;
216 217
217sub xy { 218sub xy {
218 $_[1]->coord2local ($_[0]{x}, $_[0]{y}) 219 $_[1]->coord2local ($_[0]{x}, $_[0]{y})
219} 220}
220 221
221############################################################################# 222#############################################################################
222 223
223package CFPlus::UI::Base; 224package dc::UI::Base;
224 225
225use strict; 226use strict;
226 227
227use CFPlus::OpenGL; 228use dc::OpenGL;
228 229
229sub new { 230sub new {
230 my $class = shift; 231 my $class = shift;
231 232
232 my $self = bless { 233 my $self = bless {
… …
237 h => undef, 238 h => undef,
238 can_events => 1, 239 can_events => 1,
239 @_ 240 @_
240 }, $class; 241 }, $class;
241 242
242 CFPlus::weaken ($CFPlus::UI::WIDGET{$self+0} = $self); 243 dc::weaken ($dc::UI::WIDGET{$self+0} = $self);
243 244
244 for (keys %$self) { 245 for (keys %$self) {
245 if (/^on_(.*)$/) { 246 if (/^on_(.*)$/) {
246 $self->connect ($1 => delete $self->{$_}); 247 $self->connect ($1 => delete $self->{$_});
247 } 248 }
248 } 249 }
249 250
250 if (my $layout = $CFPlus::UI::LAYOUT->{$self->{name}}) { 251 if (my $layout = $dc::UI::LAYOUT->{$self->{name}}) {
251 $self->{x} = $layout->{x} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{x}; 252 $self->{x} = $layout->{x} * $dc::UI::ROOT->{alloc_w} if exists $layout->{x};
252 $self->{y} = $layout->{y} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{y}; 253 $self->{y} = $layout->{y} * $dc::UI::ROOT->{alloc_h} if exists $layout->{y};
253 $self->{force_w} = $layout->{w} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{w}; 254 $self->{force_w} = $layout->{w} * $dc::UI::ROOT->{alloc_w} if exists $layout->{w};
254 $self->{force_h} = $layout->{h} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{h}; 255 $self->{force_h} = $layout->{h} * $dc::UI::ROOT->{alloc_h} if exists $layout->{h};
255 256
256 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x}; 257 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
257 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y}; 258 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
258 259
259 $self->show if $layout->{show}; 260 $self->show if $layout->{show};
… …
269 $self->emit ("destroy"); 270 $self->emit ("destroy");
270 %$self = (); 271 %$self = ();
271} 272}
272 273
273sub TO_JSON { 274sub TO_JSON {
274 { __widget_ref__ => $_[0]{s_id} } 275 { "\fw" => $_[0]{s_id} }
275} 276}
276 277
277sub show { 278sub show {
278 my ($self) = @_; 279 my ($self) = @_;
279 280
280 return if $self->{parent}; 281 return if $self->{parent};
281 282
282 $CFPlus::UI::ROOT->add ($self); 283 $dc::UI::ROOT->add ($self);
283} 284}
284 285
285sub set_visible { 286sub set_visible {
286 my ($self) = @_; 287 my ($self) = @_;
287 288
… …
308 delete $self->{root}; 309 delete $self->{root};
309 310
310 undef $GRAB if $GRAB == $self; 311 undef $GRAB if $GRAB == $self;
311 undef $HOVER if $HOVER == $self; 312 undef $HOVER if $HOVER == $self;
312 313
313 $CFPlus::UI::TOOLTIP_WATCHER->cb->() 314 $dc::UI::TOOLTIP_WATCHER->invoke
314 if $TOOLTIP->{owner} == $self; 315 if $TOOLTIP->{owner} == $self;
315 316
316 $self->emit ("focus_out"); 317 $self->emit ("focus_out");
317 $self->emit (visibility_change => 0); 318 $self->emit (visibility_change => 0);
318} 319}
… …
337sub hide { 338sub hide {
338 my ($self) = @_; 339 my ($self) = @_;
339 340
340 $self->set_invisible; 341 $self->set_invisible;
341 342
343 # extra $parent copy for 5.8.8+ bug workaround
344 # (otherwise $_[0] in remove gets freed
345 if (my $parent = $self->{parent}) {
342 $self->{parent}->remove ($self) 346 $parent->remove ($self);
343 if $self->{parent}; 347 }
344} 348}
345 349
346sub move_abs { 350sub move_abs {
347 my ($self, $x, $y, $z) = @_; 351 my ($self, $x, $y, $z) = @_;
348 352
… …
360 $self->{force_h} = $h; 364 $self->{force_h} = $h;
361 365
362 $self->realloc; 366 $self->realloc;
363} 367}
364 368
369# traverse the widget chain up to find the maximum "physical" size constraints
370sub get_max_wh {
371 my ($self) = @_;
372
373 return $self->{parent}->get_max_wh
374 if $self->{parent};
375
376 ($::WIDTH, $::HEIGHT)
377}
378
365sub size_request { 379sub size_request {
366 require Carp; 380 require Carp;
367 Carp::confess "size_request is abstract"; 381 Carp::confess "size_request is abstract";
368} 382}
369 383
… …
375 my ($self, $x, $y, $w, $h) = @_; 389 my ($self, $x, $y, $w, $h) = @_;
376 390
377 if ($self->{aspect}) { 391 if ($self->{aspect}) {
378 my ($ow, $oh) = ($w, $h); 392 my ($ow, $oh) = ($w, $h);
379 393
380 $w = List::Util::min $w, CFPlus::ceil $h * $self->{aspect}; 394 $w = List::Util::min $w, dc::ceil $h * $self->{aspect};
381 $h = List::Util::min $h, CFPlus::ceil $w / $self->{aspect}; 395 $h = List::Util::min $h, dc::ceil $w / $self->{aspect};
382 396
383 # use alignment to adjust x, y 397 # use alignment to adjust x, y
384 398
385 $x += int 0.5 * ($ow - $w); 399 $x += int 0.5 * ($ow - $w);
386 $y += int 0.5 * ($oh - $h); 400 $y += int 0.5 * ($oh - $h);
… …
427 441
428 return if $self->{tooltip} eq $tooltip; 442 return if $self->{tooltip} eq $tooltip;
429 443
430 $self->{tooltip} = $tooltip; 444 $self->{tooltip} = $tooltip;
431 445
432 if ($CFPlus::UI::TOOLTIP->{owner} == $self) { 446 if ($dc::UI::TOOLTIP->{owner} == $self) {
433 delete $CFPlus::UI::TOOLTIP->{owner}; 447 delete $dc::UI::TOOLTIP->{owner};
434 $CFPlus::UI::TOOLTIP_WATCHER->cb->(); 448 $dc::UI::TOOLTIP_WATCHER->invoke;
435 } 449 }
436} 450}
437 451
438# translate global coordinates to local coordinate system 452# translate global coordinates to local coordinate system
439sub coord2local { 453sub coord2local {
440 my ($self, $x, $y) = @_; 454 my ($self, $x, $y) = @_;
441 455
442 Carp::confess unless $self->{parent};#d# 456 return (undef, undef) unless $self->{parent};
443 457
444 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) 458 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
445} 459}
446 460
447# translate local coordinates to global coordinate system 461# translate local coordinates to global coordinate system
448sub coord2global { 462sub coord2global {
449 my ($self, $x, $y) = @_; 463 my ($self, $x, $y) = @_;
450 464
451 Carp::confess unless $self->{parent};#d# 465 return (undef, undef) unless $self->{parent};
452 466
453 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 467 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
454} 468}
455 469
456sub invoke_focus_in { 470sub invoke_focus_in {
… …
505sub connect { 519sub connect {
506 my ($self, $signal, $cb) = @_; 520 my ($self, $signal, $cb) = @_;
507 521
508 push @{ $self->{signal_cb}{$signal} }, $cb; 522 push @{ $self->{signal_cb}{$signal} }, $cb;
509 523
510 defined wantarray and CFPlus::guard { 524 defined wantarray and dc::guard {
511 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb, 525 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
512 @{ $self->{signal_cb}{$signal} }; 526 @{ $self->{signal_cb}{$signal} };
513 } 527 }
514} 528}
515 529
… …
547 561
548 # parent 562 # parent
549 $self->{parent} && $self->{parent}->emit ($signal, @args) 563 $self->{parent} && $self->{parent}->emit ($signal, @args)
550} 564}
551 565
552sub find_widget { 566#sub find_widget {
553 my ($self, $x, $y) = @_; 567# in .xs
554
555 return () unless $self->{can_events};
556
557 return $self
558 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
559 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
560
561 ()
562}
563 568
564sub set_parent { 569sub set_parent {
565 my ($self, $parent) = @_; 570 my ($self, $parent) = @_;
566 571
567 CFPlus::weaken ($self->{parent} = $parent); 572 dc::weaken ($self->{parent} = $parent);
568 $self->set_visible if $parent->{visible}; 573 $self->set_visible if $parent->{visible};
569} 574}
570 575
571sub realloc { 576sub realloc {
572 my ($self) = @_; 577 my ($self) = @_;
… …
598 603
599# using global variables seems a bit hacky, but passing through all drawing 604# using global variables seems a bit hacky, but passing through all drawing
600# functions seems pointless. 605# functions seems pointless.
601our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn 606our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
602 607
603sub draw { 608#sub draw {
604 my ($self) = @_; 609#CFPlus.xs
605
606 return unless $self->{h} && $self->{w};
607
608 # update screen rectangle
609 local $draw_x = $draw_x + $self->{x};
610 local $draw_y = $draw_y + $self->{y};
611
612 # skip widgets that are entirely outside the drawing area
613 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
614 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
615
616 glPushMatrix;
617 glTranslate $self->{x}, $self->{y}, 0;
618
619 if ($self == $HOVER && $self->{can_hover}) {
620 glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
621 glEnable GL_BLEND;
622 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
623 glBegin GL_QUADS;
624 glVertex 0 , 0;
625 glVertex $self->{w}, 0;
626 glVertex $self->{w}, $self->{h};
627 glVertex 0 , $self->{h};
628 glEnd;
629 glDisable GL_BLEND;
630 }
631
632 if ($ENV{CFPLUS_DEBUG} & 1) {
633 glPushMatrix;
634 glColor 1, 1, 0, 1;
635 glTranslate 0.375, 0.375;
636 glBegin GL_LINE_LOOP;
637 glVertex 0 , 0;
638 glVertex $self->{w} - 1, 0;
639 glVertex $self->{w} - 1, $self->{h} - 1;
640 glVertex 0 , $self->{h} - 1;
641 glEnd;
642 glPopMatrix;
643 #CFPlus::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
644 }
645
646 $self->_draw;
647 glPopMatrix;
648}
649 610
650sub _draw { 611sub _draw {
651 my ($self) = @_; 612 my ($self) = @_;
652 613
653 warn "no draw defined for $self\n"; 614 warn "no draw defined for $self\n";
654} 615}
655 616
656my $cntx;#d#
657sub DESTROY { 617sub DESTROY {
658 my ($self) = @_; 618 my ($self) = @_;
659 619
660 return if CFPlus::in_destruct; 620 return if dc::in_destruct;
661 621
622 local $@;
662 eval { $self->destroy }; 623 eval { $self->destroy };
663 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/; 624 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
664 625
665 delete $WIDGET{$self+0}; 626 delete $WIDGET{$self+0};
666} 627}
667 628
668############################################################################# 629#############################################################################
669 630
670package CFPlus::UI::DrawBG; 631package dc::UI::DrawBG;
671 632
672our @ISA = CFPlus::UI::Base::; 633our @ISA = dc::UI::Base::;
673 634
674use strict; 635use strict;
675use CFPlus::OpenGL; 636use dc::OpenGL;
676 637
677sub new { 638sub new {
678 my $class = shift; 639 my $class = shift;
679
680 # range [value, low, high, page]
681 640
682 $class->SUPER::new ( 641 $class->SUPER::new (
683 #bg => [0, 0, 0, 0.2], 642 #bg => [0, 0, 0, 0.2],
684 #active_bg => [1, 1, 1, 0.5], 643 #active_bg => [1, 1, 1, 0.5],
685 @_ 644 @_
… …
697 my ($w, $h) = @$self{qw(w h)}; 656 my ($w, $h) = @$self{qw(w h)};
698 657
699 glEnable GL_BLEND; 658 glEnable GL_BLEND;
700 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 659 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
701 glColor_premultiply @$color; 660 glColor_premultiply @$color;
702
703 glBegin GL_QUADS;
704 glVertex 0 , 0;
705 glVertex 0 , $h;
706 glVertex $w, $h; 661 glRect 0, 0, $w, $h;
707 glVertex $w, 0;
708 glEnd;
709
710 glDisable GL_BLEND; 662 glDisable GL_BLEND;
711 } 663 }
712} 664}
713 665
714############################################################################# 666#############################################################################
715 667
716package CFPlus::UI::Empty; 668package dc::UI::Empty;
717 669
718our @ISA = CFPlus::UI::Base::; 670our @ISA = dc::UI::Base::;
719 671
720sub new { 672sub new {
721 my ($class, %arg) = @_; 673 my ($class, %arg) = @_;
722 $class->SUPER::new (can_events => 0, %arg); 674 $class->SUPER::new (can_events => 0, %arg);
723} 675}
… …
730 682
731sub draw { } 683sub draw { }
732 684
733############################################################################# 685#############################################################################
734 686
735package CFPlus::UI::Container; 687package dc::UI::Container;
736 688
737our @ISA = CFPlus::UI::Base::; 689our @ISA = dc::UI::Base::;
738 690
739sub new { 691sub new {
740 my ($class, %arg) = @_; 692 my ($class, %arg) = @_;
741 693
742 my $children = delete $arg{children}; 694 my $children = delete $arg{children};
… …
746 can_events => 0, 698 can_events => 0,
747 %arg, 699 %arg,
748 ); 700 );
749 701
750 $self->add (@$children) 702 $self->add (@$children)
751 if $children; 703 if $children && @$children;
752 704
753 $self 705 $self
754} 706}
755 707
756sub realloc { 708sub realloc {
… …
765 my ($self, @widgets) = @_; 717 my ($self, @widgets) = @_;
766 718
767 $_->set_parent ($self) 719 $_->set_parent ($self)
768 for @widgets; 720 for @widgets;
769 721
722 # TODO: only do this in widgets that need it, e.g. root, fixed
770 use sort 'stable'; 723 use sort 'stable';
771 724
772 $self->{children} = [ 725 $self->{children} = [
773 sort { $a->{z} <=> $b->{z} } 726 sort { $a->{z} <=> $b->{z} }
774 @{$self->{children}}, @widgets 727 @{$self->{children}}, @widgets
775 ]; 728 ];
776 729
777 $self->realloc; 730 $self->realloc;
731
732 $self->emit (c_add => \@widgets);
733
734 map $_+0, @widgets
778} 735}
779 736
780sub children { 737sub children {
781 @{ $_[0]{children} } 738 @{ $_[0]{children} }
782} 739}
783 740
784sub remove { 741sub remove {
785 my ($self, $child) = @_; 742 my ($self, @widgets) = @_;
786 743
744 $self->emit (c_remove => \@widgets);
745
746 for my $child (@widgets) {
787 delete $child->{parent}; 747 delete $child->{parent};
788 $child->hide; 748 $child->hide;
789
790 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 749 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
750 }
791 751
792 $self->realloc; 752 $self->realloc;
793} 753}
794 754
795sub clear { 755sub clear {
796 my ($self) = @_; 756 my ($self) = @_;
797 757
798 my $children = delete $self->{children}; 758 my $children = $self->{children};
799 $self->{children} = []; 759 $self->{children} = [];
800 760
801 for (@$children) { 761 for (@$children) {
802 delete $_->{parent}; 762 delete $_->{parent};
803 $_->hide; 763 $_->hide;
… …
823} 783}
824 784
825sub _draw { 785sub _draw {
826 my ($self) = @_; 786 my ($self) = @_;
827 787
828 $_->draw for @{$self->{children}}; 788 $_->draw for $self->visible_children;
829} 789}
830 790
831############################################################################# 791#############################################################################
832 792
833package CFPlus::UI::Bin; 793package dc::UI::Bin;
834 794
835our @ISA = CFPlus::UI::Container::; 795our @ISA = dc::UI::Container::;
836 796
837sub new { 797sub new {
838 my ($class, %arg) = @_; 798 my ($class, %arg) = @_;
839 799
840 my $child = (delete $arg{child}) || new CFPlus::UI::Empty::; 800 my $child = (delete $arg{child}) || new dc::UI::Empty::;
841 801
842 $class->SUPER::new (children => [$child], %arg) 802 $class->SUPER::new (children => [$child], %arg)
843} 803}
844 804
845sub add { 805sub add {
846 my ($self, $child) = @_; 806 my ($self, $child) = @_;
847 807
848 $self->SUPER::remove ($_) for @{ $self->{children} }; 808 $self->clear;
849 $self->SUPER::add ($child); 809 $self->SUPER::add ($child);
850} 810}
851 811
852sub remove { 812sub remove {
853 my ($self, $widget) = @_; 813 my ($self, $widget) = @_;
854 814
855 $self->SUPER::remove ($widget); 815 $self->SUPER::remove ($widget);
856 816
857 $self->{children} = [new CFPlus::UI::Empty] 817 $self->{children} = [new dc::UI::Empty]
858 unless @{$self->{children}}; 818 unless @{$self->{children}};
859} 819}
860 820
861sub child { $_[0]->{children}[0] } 821sub child { $_[0]->{children}[0] }
862 822
… …
871 831
872 1 832 1
873} 833}
874 834
875############################################################################# 835#############################################################################
876
877# back-buffered drawing area 836# back-buffered drawing area
878 837
879package CFPlus::UI::Window; 838package dc::UI::Window;
880 839
881our @ISA = CFPlus::UI::Bin::; 840our @ISA = dc::UI::Bin::;
882 841
883use CFPlus::OpenGL; 842use dc::OpenGL;
884 843
885sub new { 844sub new {
886 my ($class, %arg) = @_; 845 my ($class, %arg) = @_;
887 846
888 my $self = $class->SUPER::new (%arg); 847 my $self = $class->SUPER::new (%arg);
… …
910} 869}
911 870
912sub render_child { 871sub render_child {
913 my ($self) = @_; 872 my ($self) = @_;
914 873
915 $self->{texture} = new_from_opengl CFPlus::Texture $self->{w}, $self->{h}, sub { 874 $self->{texture} = new_from_opengl dc::Texture $self->{w}, $self->{h}, sub {
916 glClearColor 0, 0, 0, 0; 875 glClearColor 0, 0, 0, 0;
917 glClear GL_COLOR_BUFFER_BIT; 876 glClear GL_COLOR_BUFFER_BIT;
918 877
919 { 878 {
920 package CFPlus::UI::Base; 879 package dc::UI::Base;
921 880
922 local ($draw_x, $draw_y, $draw_w, $draw_h) = 881 local ($draw_x, $draw_y, $draw_w, $draw_h) =
923 (0, 0, $self->{w}, $self->{h}); 882 (0, 0, $self->{w}, $self->{h});
924 883
925 $self->_render; 884 $self->_render;
… …
942 glDisable GL_TEXTURE_2D; 901 glDisable GL_TEXTURE_2D;
943} 902}
944 903
945############################################################################# 904#############################################################################
946 905
947package CFPlus::UI::ViewPort; 906package dc::UI::ViewPort;
948 907
949use List::Util qw(min max); 908use List::Util qw(min max);
950 909
951our @ISA = CFPlus::UI::Window::; 910our @ISA = dc::UI::Window::;
952 911
953sub new { 912sub new {
954 my $class = shift; 913 my $class = shift;
955 914
956 $class->SUPER::new ( 915 $class->SUPER::new (
… …
963sub size_request { 922sub size_request {
964 my ($self) = @_; 923 my ($self) = @_;
965 924
966 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 925 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
967 926
968 $w = 10 if $self->{scroll_x}; 927 $w = 1 if $self->{scroll_x};
969 $h = 10 if $self->{scroll_y}; 928 $h = 1 if $self->{scroll_y};
970 929
971 ($w, $h) 930 ($w, $h)
972} 931}
973 932
974sub invoke_size_allocate { 933sub invoke_size_allocate {
… …
998 $self->emit (changed => $x, $y); 957 $self->emit (changed => $x, $y);
999 $self->update; 958 $self->update;
1000 } 959 }
1001} 960}
1002 961
962sub set_center {
963 my ($self, $x, $y) = @_;
964
965 $self->set_offset ($x - $self->{w} * .5, $y - $self->{h} * .5);
966}
967
968sub make_visible {
969 my ($self, $x, $y, $border) = @_;
970
971 if ( $x < $self->{view_x} + $self->{w} * $border
972 || $x > $self->{view_x} + $self->{w} * (1 - $border)
973 || $y < $self->{view_y} + $self->{h} * $border
974 || $y > $self->{view_y} + $self->{h} * (1 - $border)
975 ) {
976 $self->set_center ($x, $y);
977 }
978}
979
1003# hmm, this does not work for topleft of $self... but we should not ask for that 980# hmm, this does not work for topleft of $self... but we should not ask for that
1004sub coord2local { 981sub coord2local {
1005 my ($self, $x, $y) = @_; 982 my ($self, $x, $y) = @_;
1006 983
1007 $self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y}) 984 $self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
… …
1020 my ($self, $x, $y) = @_; 997 my ($self, $x, $y) = @_;
1021 998
1022 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w} 999 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
1023 && $y >= $self->{y} && $y < $self->{y} + $self->{h} 1000 && $y >= $self->{y} && $y < $self->{y} + $self->{h}
1024 ) { 1001 ) {
1025 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y}) 1002 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
1026 } else { 1003 } else {
1027 $self->CFPlus::UI::Base::find_widget ($x, $y) 1004 $self->dc::UI::Base::find_widget ($x, $y)
1028 } 1005 }
1029} 1006}
1030 1007
1031sub _render { 1008sub _render {
1032 my ($self) = @_; 1009 my ($self) = @_;
1033 1010
1034 local $CFPlus::UI::Base::draw_x = $CFPlus::UI::Base::draw_x - $self->{view_x}; 1011 local $dc::UI::Base::draw_x = $dc::UI::Base::draw_x - $self->{view_x};
1035 local $CFPlus::UI::Base::draw_y = $CFPlus::UI::Base::draw_y - $self->{view_y}; 1012 local $dc::UI::Base::draw_y = $dc::UI::Base::draw_y - $self->{view_y};
1036 1013
1037 CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 1014 dc::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
1038 1015
1039 $self->SUPER::_render; 1016 $self->SUPER::_render;
1040} 1017}
1041 1018
1042############################################################################# 1019#############################################################################
1043 1020
1044package CFPlus::UI::ScrolledWindow; 1021package dc::UI::ScrolledWindow;
1045 1022
1046our @ISA = CFPlus::UI::Table::; 1023our @ISA = dc::UI::Table::;
1047 1024
1048sub new { 1025sub new {
1049 my ($class, %arg) = @_; 1026 my ($class, %arg) = @_;
1050 1027
1051 my $child = delete $arg{child}; 1028 my $child = delete $arg{child};
1052 1029
1053 my $self; 1030 my $self;
1054 1031
1055 my $hslider = new CFPlus::UI::Slider 1032 my $hslider = new dc::UI::Slider
1033 c_col => 0,
1034 c_row => 1,
1056 vertical => 0, 1035 vertical => 0,
1057 range => [0, 0, 1, 0.01], # HACK fix 1036 range => [0, 0, 1, 0.01], # HACK fix
1058 on_changed => sub { 1037 on_changed => sub {
1059 $self->{hpos} = $_[1]; 1038 $self->{hpos} = $_[1];
1060 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos}); 1039 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
1061 }, 1040 },
1062 ; 1041 ;
1063 1042
1064 my $vslider = new CFPlus::UI::Slider 1043 my $vslider = new dc::UI::Slider
1044 c_col => 1,
1045 c_row => 0,
1065 vertical => 1, 1046 vertical => 1,
1066 range => [0, 0, 1, 0.01], # HACK fix 1047 range => [0, 0, 1, 0.01], # HACK fix
1067 on_changed => sub { 1048 on_changed => sub {
1068 $self->{vpos} = $_[1]; 1049 $self->{vpos} = $_[1];
1069 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos}); 1050 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
… …
1079 col_expand => [1, 0], 1060 col_expand => [1, 0],
1080 row_expand => [1, 0], 1061 row_expand => [1, 0],
1081 %arg, 1062 %arg,
1082 ); 1063 );
1083 1064
1084 $self->{vp} = new CFPlus::UI::ViewPort 1065 $self->{vp} = new dc::UI::ViewPort
1066 c_col => 0,
1067 c_row => 0,
1085 expand => 1, 1068 expand => 1,
1086 scroll_x => $self->{scroll_x}, 1069 scroll_x => $self->{scroll_x},
1087 scroll_y => $self->{scroll_y}, 1070 scroll_y => $self->{scroll_y},
1088 on_changed => sub { 1071 on_changed => sub {
1089 my ($vp, $x, $y) = @_; 1072 my ($vp, $x, $y) = @_;
… …
1091 $vp->{parent}{hslider}->set_value ($x); 1074 $vp->{parent}{hslider}->set_value ($x);
1092 $vp->{parent}{vslider}->set_value ($y); 1075 $vp->{parent}{vslider}->set_value ($y);
1093 1076
1094 0 1077 0
1095 }, 1078 },
1096 ;
1097
1098 $self->SUPER::add_at (0, 0, $self->{vp});
1099
1100 $self->add ($child) if $child;
1101
1102 $self
1103}
1104
1105#TODO# update range on size_allocate depending on child
1106
1107sub add {
1108 my ($self, $widget) = @_;
1109
1110 $self->{vp}->add ($self->{child} = $widget);
1111}
1112
1113sub update_slider {
1114 my ($self) = @_;
1115
1116 my $child = ($self->{vp} or return)->child;
1117
1118 my ($w1, $w2) = ($child->{w}, $self->{vp}{w});
1119 $self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);
1120
1121 my $visible = $w1 > $w2;
1122 if ($visible != $self->{hslider}{visible}) {
1123 $visible ? $self->SUPER::add_at (0, 1, $self->{hslider})
1124 : $self->{hslider}->hide;
1125 }
1126
1127 my ($h1, $h2) = ($child->{h}, $self->{vp}{h});
1128 $self->{vslider}->set_range ([$self->{vslider}{range}[0], 0, $h1, $h2, 1]);
1129
1130 my $visible = $h1 > $h2;
1131 if ($visible != $self->{vslider}{visible}) {
1132 $visible ? $self->SUPER::add_at (1, 0, $self->{vslider})
1133#!/opt/bin/perl
1134
1135my $startup_done = sub { };
1136our $PANGO = "1.5.0";
1137
1138# do splash-screen thingy on win32
1139BEGIN {
1140 if (%PAR::LibCache && $^O eq "MSWin32") {
1141 while (my ($filename, $zip) = each %PAR::LibCache) {
1142 $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
1143 }
1144
1145 require Win32::GUI::SplashScreen;
1146
1147 Win32::GUI::SplashScreen::Show (
1148 -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
1149 );
1150
1151 $startup_done = sub {
1152 Win32::GUI::SplashScreen::Done (1);
1153 };
1154 }
1155}
1156
1157use strict;
1158use utf8;
1159
1160use Carp 'verbose';
1161
1162# do things only needed for single-binary version (par)
1163BEGIN {
1164 if (%PAR::LibCache) {
1165 @INC = grep ref, @INC; # weed out all paths except pars loader refs
1166
1167 my $tmp = $ENV{PAR_TEMP};
1168
1169 while (my ($filename, $zip) = each %PAR::LibCache) {
1170 for ($zip->memberNames) {
1171 next unless /^root\/(.*)/;
1172 $zip->extractMember ($_, "$tmp/$1")
1173 unless -e "$tmp/$1";
1174 }
1175 }
1176
1177 if ($^O eq "MSWin32") {
1178 # relocatable
1179 } else {
1180 # unix, need to patch pango rc file
1181 open my $fh, "<:perlio", "$tmp/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules"
1182 or die "$tmp/usr/lib/$PANGO/module-files.d/libpango1.0-0.modules: $!";
1183 local $/;
1184 my $rc = <$fh>;
1185 $rc =~ s/^\//$tmp\//gm; # replace abs paths by relative ones
1186
1187 mkdir "$tmp/pango-modules";
1188 open my $fh, ">:perlio", "$tmp/pango-modules/pango.modules"
1189 or die "$tmp/pango-modules/pango.modules: $!";
1190 print $fh $rc;
1191
1192 $ENV{PANGO_RC_FILE} = "$tmp/pango.rc";
1193 open my $fh, ">:perlio", $ENV{PANGO_RC_FILE}
1194 or die "$ENV{PANGO_RC_FILE}: $!";
1195 print $fh "[Pango]\nModuleFiles = $tmp/pango-modules\n";
1196 }
1197
1198 unshift @INC, $tmp;
1199 }
1200}
1201
1202# need to do it again because that pile of garbage called PAR nukes it before main
1203unshift @INC, $ENV{PAR_TEMP}
1204 if %PAR::LibCache;
1205
1206use Time::HiRes 'time';
1207use Event;
1208
1209use Crossfire;
1210use Crossfire::Protocol::Constants;
1211
1212use Compress::LZF;
1213
1214use CFPlus;
1215use CFPlus::OpenGL ();
1216use CFPlus::Protocol;
1217use CFPlus::DB;
1218use CFPlus::UI;
1219use CFPlus::UI::Inventory;
1220use CFPlus::UI::SpellList;
1221use CFPlus::Pod;
1222use CFPlus::MapWidget;
1223use CFPlus::Macro;
1224
1225$SIG{QUIT} = sub { Carp::cluck "QUIT" };
1226$SIG{PIPE} = 'IGNORE';
1227
1228$Event::Eval = 1;
1229$Event::DIED = sub {
1230 CFPlus::fatal Carp::longmess $_[1]
1231};
1232
1233my $MAX_FPS = 60;
1234my $MIN_FPS = 5; # unused as of yet
1235
1236our $META_SERVER = "http://metaserver.schmorp.de/current.json";
1237
1238our $LAST_REFRESH;
1239our $NOW;
1240
1241our $CFG;
1242our $CONN;
1243our $PROFILE; # current profile
1244our $FAST; # fast, low-quality mode, possibly useful for software-rendering
1245
1246our $WANT_REFRESH;
1247our $CAN_REFRESH;
1248
1249our @SDL_MODES;
1250our $WIDTH;
1251our $HEIGHT;
1252our $FULLSCREEN;
1253our $FONTSIZE;
1254
1255our $FONT_PROP;
1256our $FONT_FIXED;
1257
1258our $MAP;
1259our $MAPMAP;
1260our $MAPWIDGET;
1261our $BUTTONBAR;
1262our $LOGVIEW;
1263our $CONSOLE;
1264our $METASERVER;
1265our $LOGIN_BUTTON;
1266our $QUIT_DIALOG;
1267our $HOST_ENTRY;
1268our $FULLSCREEN_ENABLE;
1269our $PICKUP_ENABLE;
1270our $SERVER_INFO;
1271
1272our $SETUP_DIALOG;
1273our $SETUP_NOTEBOOK;
1274our $SETUP_SERVER;
1275our $SETUP_KEYBOARD;
1276
1277our $PL_NOTEBOOK;
1278our $PL_WINDOW;
1279
1280our $INVENTORY_PAGE;
1281our $STATS_PAGE;
1282our $SKILL_PAGE;
1283our $SPELL_PAGE;
1284our $SPELL_LIST;
1285
1286our $HELP_WINDOW;
1287our $MESSAGE_WINDOW;
1288our $FLOORBOX;
1289our $GAUGES;
1290our $STATWIDS;
1291
1292our $SDL_ACTIVE;
1293our %SDL_CB;
1294
1295our $SDL_MIXER;
1296our $MUSIC_DEFAULT = "in_a_heartbeat.ogg";
1297our @MUSIC_WANT;
1298our $MUSIC_START;
1299our $MUSIC_PLAYING;
1300our $MUSIC_PLAYER;
1301our $MUSIC_RESUME = 30; # resume music when players less than these many seconds before
1302our @SOUNDS; # event => file mapping
1303our %AUDIO_CHUNKS; # audio files
1304
1305our $ALT_ENTER_MESSAGE;
1306our $STATUSBOX;
1307our $DEBUG_STATUS;
1308
1309our $INV;
1310our $INVR;
1311our $INV_RIGHT_HB;
1312
1313our $PICKUP_CFG;
1314
1315our $IN_BUILD_MODE;
1316our $BUILD_BUTTON;
1317
1318sub status {
1319 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
1320}
1321
1322sub debug {
1323 $DEBUG_STATUS->set_text ($_[0]);
1324}
1325
1326sub message {
1327 my ($para) = @_;
1328
1329 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1330
1331 $para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";
1332
1333 $LOGVIEW->add_paragraph ($para);
1334 $LOGVIEW->scroll_to_bottom;
1335}
1336
1337sub destroy_query_dialog {
1338 (delete $_[0]{query_dialog})->destroy
1339 if $_[0]{query_dialog};
1340}
1341
1342# FIXME: a very ugly hack to wait for stat update look below! #d#
1343our $QUERY_TIMER; #d#
1344
1345# server query dialog
1346sub server_query {
1347 my ($conn, $flags, $prompt) = @_;
1348
1349 # FIXME: a very ugly hack to wait for stat update #d#
1350 if ($prompt =~ /roll new stats/ and not $conn->{stat_change_with}) {
1351 unless ($QUERY_TIMER) {
1352 $QUERY_TIMER =
1353 Event->timer (
1354 after => 1,
1355 cb => sub {
1356 server_query ($conn, $flags, $prompt, 1);
1357 $QUERY_TIMER = undef
1358 }
1359 );
1360 return;
1361 }
1362 }
1363
1364 $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel
1365 x => "center",
1366 y => "center",
1367 title => "Server Query",
1368 child => my $vbox = new CFPlus::UI::VBox,
1369 ;
1370
1371 my @dialog = my $label = new CFPlus::UI::Label
1372 max_w => $::WIDTH * 0.8,
1373 ellipsise => 0,
1374 text => $prompt;
1375
1376 if ($flags & CS_QUERY_YESNO) {
1377 push @dialog, my $hbox = new CFPlus::UI::HBox;
1378
1379 $hbox->add (new CFPlus::UI::Button
1380 text => "No",
1381 on_activate => sub {
1382 $conn->send ("reply n");
1383 $dialog->destroy;
1384 0
1385 }
1386 );
1387 $hbox->add (new CFPlus::UI::Button
1388 text => "Yes",
1389 on_activate => sub {
1390 $conn->send ("reply y");
1391 destroy_query_dialog $conn;
1392 0
1393 },
1394 );
1395
1396 $dialog->grab_focus;
1397
1398 } elsif ($flags & CS_QUERY_SINGLECHAR) {
1399 if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
1400 $dialog->{tooltip} = "#charcreation_focus";
1401
1402 unshift @dialog, new CFPlus::UI::Label
1403 max_w => $::WIDTH * 0.8,
1404 ellipsise => 0,
1405 markup => "\nOr use your keyboard and the text entry below:\n";
1406
1407 unshift @dialog, my $table = new CFPlus::UI::Table;
1408
1409 $table->add_at (0, 0, new CFPlus::UI::Button
1410 text => "Next Race",
1411 on_activate => sub {
1412 $conn->send ("reply n");
1413 destroy_query_dialog $conn;
1414 0
1415 },
1416 );
1417 $table->add_at (2, 0, new CFPlus::UI::Button
1418 text => "Accept",
1419 on_activate => sub {
1420 $conn->send ("reply d");
1421 destroy_query_dialog $conn;
1422 0
1423 },
1424 );
1425
1426 if ($conn->{chargen_race_description}) {
1427 unshift @dialog, new CFPlus::UI::Label
1428 max_w => $::WIDTH * 0.8,
1429 ellipsise => 0,
1430 markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",
1431 ;
1432 }
1433
1434 unshift @dialog, new CFPlus::UI::Face
1435 face => $conn->{player}{face},
1436 bg => [.2, .2, .2, 1],
1437 min_w => 64,
1438 min_h => 64,
1439 ;
1440
1441 if ($conn->{chargen_race_title}) {
1442 unshift @dialog, new CFPlus::UI::Label
1443 allign => 1,
1444 ellipsise => 0,
1445 markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",
1446 ;
1447 }
1448
1449 unshift @dialog, new CFPlus::UI::Label
1450 max_w => $::WIDTH * 0.4,
1451 ellipsise => 0,
1452 markup => (CFPlus::Pod::section_label ui => "chargen_race"),
1453 ;
1454
1455 } elsif ($prompt =~ /roll new stats/) {
1456 if (my $stat = delete $conn->{stat_change_with}) {
1457 $conn->send ("reply $stat");
1458 destroy_query_dialog $conn;
1459 return;
1460 }
1461
1462 unshift @dialog, new CFPlus::UI::Label
1463 max_w => $::WIDTH * 0.4,
1464 ellipsise => 0,
1465 markup => "\nOr use your keyboard and the text entry below:\n";
1466
1467 unshift @dialog, my $table = new CFPlus::UI::Table;
1468
1469 # left: re-roll
1470 $table->add_at (0, 0, new CFPlus::UI::Button
1471 text => "Roll Again",
1472 on_activate => sub {
1473 $conn->send ("reply y");
1474 destroy_query_dialog $conn;
1475 0
1476 },
1477 );
1478
1479 # center: swap stats
1480 my ($sw1, $sw2) = map +(new CFPlus::UI::Selector
1481 expand => 1,
1482 value => $_,
1483 options => [
1484 [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
1485 [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
1486 [3 => "Con", "Constitution ($conn->{stat}{+CS_STAT_CON})"],
1487 [4 => "Int", "Intelligence ($conn->{stat}{+CS_STAT_INT})"],
1488 [5 => "Wis", "Wisdom ($conn->{stat}{+CS_STAT_WIS})"],
1489 [6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],
1490 [7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],
1491 ],
1492 ), 1 .. 2;
1493
1494 $table->add_at (2, 0, new CFPlus::UI::Button
1495 text => "Swap Stats",
1496 on_activate => sub {
1497 $conn->{stat_change_with} = $sw2->{value};
1498 $conn->send ("reply $sw1->{value}");
1499 destroy_query_dialog $conn;
1500 0
1501 },
1502 );
1503 $table->add_at (2, 1, new CFPlus::UI::HBox children => [$sw1, $sw2]);
1504
1505 # right: accept
1506 $table->add_at (4, 0, new CFPlus::UI::Button
1507 text => "Accept",
1508 on_activate => sub {
1509 $conn->send ("reply n");
1510 $STATS_PAGE->hide;
1511 destroy_query_dialog $conn;
1512 0
1513 },
1514 );
1515
1516 unshift @dialog, my $hbox = new CFPlus::UI::HBox;
1517 for (
1518 [Str => CS_STAT_STR],
1519 [Dex => CS_STAT_DEX],
1520 [Con => CS_STAT_CON],
1521 [Int => CS_STAT_INT],
1522 [Wis => CS_STAT_WIS],
1523 [Pow => CS_STAT_POW],
1524 [Cha => CS_STAT_CHA],
1525 ) {
1526 my ($name, $id) = @$_;
1527 $hbox->add (new CFPlus::UI::Label
1528 markup => "$conn->{stat}{$id} <span foreground='yellow'>$name</span>",
1529 align => 0,
1530 expand => 1,
1531 can_events => 1,
1532 can_hover => 1,
1533 tooltip => "#stat_$name",
1534 );
1535 }
1536
1537 unshift @dialog, new CFPlus::UI::Label
1538 max_w => $::WIDTH * 0.4,
1539 ellipsise => 0,
1540 markup => (CFPlus::Pod::section_label ui => "chargen_stats"),
1541 ;
1542 }
1543
1544 push @dialog, my $entry = new CFPlus::UI::Entry
1545 on_changed => sub {
1546 $conn->send ("reply $_[1]");
1547 destroy_query_dialog $conn;
1548 0
1549 },
1550 ;
1551
1552 $entry->grab_focus;
1553
1554 } else {
1555 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1556
1557 push @dialog, my $entry = new CFPlus::UI::Entry
1558 $flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),
1559 on_activate => sub {
1560 $conn->send ("reply $_[1]");
1561 destroy_query_dialog $conn;
1562 0
1563 },
1564 ;
1565
1566 $entry->grab_focus;
1567 }
1568
1569 $vbox->add (@dialog);
1570 $dialog->show;
1571}
1572
1573sub start_game {
1574 status "logging in...";
1575
1576 $LOGIN_BUTTON->set_text ("Logout");
1577 $SETUP_DIALOG->hide;
1578
1579 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
1580
1581 my ($host, $port) = split /:/, $PROFILE->{host};
1582
1583 $MAP = new CFPlus::Map;
1584
1585 $CONN = eval {
1586 new CFPlus::Protocol
1587 host => $host,
1588 port => $port || 13327,
1589 user => $PROFILE->{user},
1590 pass => $PROFILE->{password},
1591 mapw => $mapsize,
1592 maph => $mapsize,
1593
1594 client => "cfplus $CFPlus::VERSION $] $^O",
1595
1596 map_widget => $MAPWIDGET,
1597 logview => $LOGVIEW,
1598 statusbox => $STATUSBOX,
1599 map => $MAP,
1600 mapmap => $MAPMAP,
1601 query => \&server_query,
1602
1603 setup_req => {
1604 smoothing => $CFG->{map_smoothing}*1,
1605 },
1606
1607 sound_play => sub {
1608 my ($x, $y, $soundnum, $type) = @_;
1609
1610 $SDL_MIXER
1611 or return;
1612
1613 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
1614 or return;
1615
1616 $chunk->play;
1617 },
1618 };
1619
1620 if ($CONN) {
1621 CFPlus::lowdelay fileno $CONN->{fh};
1622
1623 status "login successful";
1624 } else {
1625 status "unable to connect";
1626 stop_game();
1627 }
1628}
1629
1630sub stop_game {
1631 $LOGIN_BUTTON->set_text ("Login");
1632 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
1633 $SETUP_DIALOG->show;
1634 $PL_WINDOW->hide;
1635 $SPELL_LIST->clear_spells;
1636 $CFPlus::UI::ROOT->emit (stop_game => ! ! $CONN);
1637
1638 &audio_music_set ([]);
1639
1640 return unless $CONN;
1641
1642 status "connection closed";
1643
1644 destroy_query_dialog $CONN;
1645 $CONN->destroy;
1646 $CONN = 0; # false, does not autovivify
1647
1648 undef $MAP;
1649}
1650
1651sub graphics_setup {
1652 my $vbox = new CFPlus::UI::VBox;
1653
1654 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);
1655
1656 my $row = 0;
1657
1658 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "OpenGL Info");
1659 $table->add_at (1, $row++, new CFPlus::UI::Label valign => 0, fontsize => 0.8, text => CFPlus::OpenGL::gl_vendor . ", " . CFPlus::OpenGL::gl_version,
1660 can_events => 1,
1661 tooltip => "<tt><span size='8192'>" . (CFPlus::OpenGL::gl_extensions) . "</span></tt>");
1662
1663 my $vidmode_tooltip =
1664 "<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). "
1665 . "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>.";
1666
1667 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode");
1668 $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox);
1669
1670 $hbox->add (my $mode_slider = new CFPlus::UI::Slider
1671 force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1],
1672 tooltip => $vidmode_tooltip);
1673 $hbox->add (my $mode_label = new CFPlus::UI::Label
1674 align => 0, valign => 0, height => 0.8, template => "9999x9999@9+9",
1675 can_events => 1, tooltip => $vidmode_tooltip);
1676
1677 $mode_slider->connect (changed => sub {
1678 my ($self, $value) = @_;
1679
1680 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
1681 $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]});
1682 });
1683 $mode_slider->emit (changed => $mode_slider->{range}[0]);
1684
1685 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen");
1686 $table->add_at (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox
1687 state => $CFG->{fullscreen},
1688 tooltip => "Bring the client into fullscreen mode.",
1689 on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }
1690 );
1691
1692 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
1693 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
1694 state => $CFG->{fast},
1695 tooltip => "Lower the visual quality considerably to speed up rendering.",
1696 on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
1697 );
1698
1699 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
1700 $table->add_at (1, $row++, new CFPlus::UI::Slider
1701 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
1702 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
1703 on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
1704 );
1705
1706 $table->add_at (1, $row++, new CFPlus::UI::Button
1707 expand => 1, align => 0, text => "Apply",
1708 tooltip => "Apply the video settings above.",
1709 on_activate => sub { 1079 on_size_allocate => sub {
1710 video_shutdown (); 1080 my ($vp, $w, $h) = @_;
1711 video_init (); 1081 $vp->{parent}->update_slider;
1712 0
1713 }
1714 );
1715
1716 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale");
1717 $table->add_at (1, $row++, new CFPlus::UI::Slider
1718 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
1719 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
1720 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
1721 );
1722
1723 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Smoothing");
1724 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
1725 state => $CFG->{map_smoothing},
1726 tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "
1727 . "This increases load on the graphics subsystem and works only with 2.x servers. "
1728 . "Changes take effect at next connection only.",
1729 on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }
1730 );
1731
1732 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War");
1733 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
1734 state => $CFG->{fow_enable},
1735 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
1736 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
1737 );
1738
1739 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "FoW Intensity");
1740 $table->add_at (1, $row++, new CFPlus::UI::Slider
1741 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
1742 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
1743 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
1744 );
1745
1746 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize");
1747 $table->add_at (1, $row++, new CFPlus::UI::Slider
1748 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
1749 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
1750 on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
1751 );
1752
1753 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
1754 $table->add_at (1, $row++, new CFPlus::UI::Slider
1755 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
1756 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
1757 on_changed => sub {
1758 $CFG->{gauge_fontsize} = $_[1];
1759 &set_gauge_window_fontsize;
1760 0
1761 }
1762 );
1763
1764 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge size");
1765 $table->add_at (1, $row++, new CFPlus::UI::Slider
1766 range => [$CFG->{gauge_size}, 0.2, 0.8],
1767 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
1768 on_changed => sub {
1769 $CFG->{gauge_size} = $_[1];
1770 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
1771 0
1772 }
1773 );
1774
1775 $vbox
1776}
1777
1778sub audio_setup {
1779 my $vbox = new CFPlus::UI::VBox;
1780
1781 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);
1782
1783 my $row = 0;
1784
1785 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Audio Enable");
1786 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
1787 state => $CFG->{audio_enable},
1788 tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
1789 on_changed => sub { $CFG->{audio_enable} = $_[1]; 0 }
1790 );
1791# $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Effects Volume");
1792# $table->add_at (1, 8, new CFPlus::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
1793# $CFG->{effects_volume} = $_[1];
1794# });
1795 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Background Music");
1796 $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox);
1797 $hbox->add (new CFPlus::UI::CheckBox
1798 expand => 1, state => $CFG->{bgm_enable},
1799 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
1800 on_changed => sub { $CFG->{bgm_enable} = $_[1]; 0 }
1801 );
1802 $hbox->add (new CFPlus::UI::Slider
1803 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
1804 tooltip => "The volume of the background music. Changes are instant.",
1805 on_changed => sub { $CFG->{bgm_volume} = $_[1]; CFPlus::MixMusic::volume $_[1] * 128; 0 }
1806 );
1807
1808 $table->add_at (1, $row++, new CFPlus::UI::Button
1809 expand => 1, align => 0, text => "Apply",
1810 tooltip => "Apply the audio settings",
1811 on_activate => sub {
1812 audio_shutdown ();
1813 audio_init ();
1814 0
1815 }
1816 );
1817
1818 $vbox
1819}
1820
1821sub set_gauge_window_fontsize {
1822 for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
1823 $_->set_fontsize ($::CFG->{gauge_fontsize});
1824 }
1825}
1826
1827sub make_gauge_window {
1828 my $gh = int $HEIGHT * $CFG->{gauge_size};
1829
1830 my $win = new CFPlus::UI::Frame (
1831 force_x => 0,
1832 force_y => "max",
1833 force_w => $WIDTH,
1834 force_h => $gh,
1835 );
1836
1837 $win->add (my $hbox = new CFPlus::UI::HBox
1838 children => [
1839 (new CFPlus::UI::HBox expand => 1),
1840 (new CFPlus::UI::VBox children => [
1841 (new CFPlus::UI::Empty expand => 1),
1842 (new CFPlus::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFPlus::UI::Table)),
1843 ]),
1844 (my $vbox = new CFPlus::UI::VBox),
1845 ],
1846 );
1847
1848 $vbox->add (new CFPlus::UI::HBox
1849 expand => 1,
1850 children => [
1851 (new CFPlus::UI::Empty expand => 1),
1852 (my $hb = new CFPlus::UI::HBox),
1853 ],
1854 );
1855
1856 $hb->add (my $hg = new CFPlus::UI::Gauge type => 'hp', tooltip => "#stat_health");
1857 $hb->add (my $mg = new CFPlus::UI::Gauge type => 'mana', tooltip => "#stat_mana");
1858 $hb->add (my $gg = new CFPlus::UI::Gauge type => 'grace', tooltip => "#stat_grace");
1859 $hb->add (my $fg = new CFPlus::UI::Gauge type => 'food', tooltip => "#stat_food");
1860
1861 $vbox->add (my $exp = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");
1862 $vbox->add (my $rng = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");
1863
1864 $GAUGES = {
1865 exp => $exp, win => $win, range => $rng,
1866 food => $fg, mana => $mg, hp => $hg, grace => $gg
1867 };
1868
1869 &set_gauge_window_fontsize;
1870
1871 $win
1872}
1873
1874sub debug_setup {
1875 my $table = new CFPlus::UI::Table;
1876
1877 $table->add_at (0, 0, new CFPlus::UI::Label text => "Widget Borders");
1878 $table->add_at (1, 0, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
1879 $table->add_at (0, 1, new CFPlus::UI::Label text => "Tooltip Widget Info");
1880 $table->add_at (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
1881 $table->add_at (0, 2, new CFPlus::UI::Label text => "Show FPS");
1882 $table->add_at (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
1883 $table->add_at (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");
1884 $table->add_at (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
1885 $table->add_at (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { &CFPlus::debug() } );
1886
1887 $table->add_at (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d#
1888
1889 $table
1890}
1891
1892sub stats_window {
1893 my $r = new CFPlus::UI::ScrolledWindow (
1894 expand => 1,
1895 scroll_y => 1
1896 );
1897 $r->add (my $vb = new CFPlus::UI::VBox);
1898
1899 $vb->add (new CFPlus::UI::FancyFrame
1900 label => "Player",
1901 child => (my $pi = new CFPlus::UI::VBox),
1902 );
1903
1904 $pi->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
1905 can_hover => 1, can_events => 1,
1906 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
1907 $pi->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
1908 can_hover => 1, can_events => 1,
1909 tooltip => "The map you are currently on (if supported by the server).");
1910
1911 $pi->add (my $hb0 = new CFPlus::UI::HBox);
1912 $hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
1913 can_hover => 1, can_events => 1,
1914 tooltip => "The weight of the player including all inventory items.");
1915 $hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
1916 can_hover => 1, can_events => 1,
1917 tooltip => "The weight limit: you cannot carry more than this.");
1918
1919 $vb->add (new CFPlus::UI::FancyFrame
1920 label => "Primary/Secondary Statistics",
1921 child => (my $hb = new CFPlus::UI::HBox expand => 1),
1922 );
1923 $hb->add (my $tbl = new CFPlus::UI::Table expand => 1);
1924
1925 my $color2 = [1, 1, 0];
1926
1927 for (
1928 [0, 0, st_str => "Str", 30],
1929 [0, 1, st_dex => "Dex", 30],
1930 [0, 2, st_con => "Con", 30],
1931 [0, 3, st_int => "Int", 30],
1932 [0, 4, st_wis => "Wis", 30],
1933 [0, 5, st_pow => "Pow", 30],
1934 [0, 6, st_cha => "Cha", 30],
1935
1936 [2, 0, st_wc => "Wc", -120],
1937 [2, 1, st_ac => "Ac", -120],
1938 [2, 2, st_dam => "Dam", 120],
1939 [2, 3, st_arm => "Arm", 120],
1940 [2, 4, st_spd => "Spd", 10.54],
1941 [2, 5, st_wspd => "WSp", 10.54],
1942 ) {
1943 my ($col, $row, $id, $label, $template) = @$_;
1944
1945 $tbl->add ($col , $row, $STATWIDS->{$id} = new CFPlus::UI::Label
1946 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0,
1947 align => +1, template => $template, tooltip => "#stat_$label");
1948 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label
1949 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,
1950 align => -1, text => $label, tooltip => "#stat_$label");
1951 }
1952
1953 $vb->add (new CFPlus::UI::FancyFrame
1954 label => "Resistancies",
1955 child => (my $tbl2 = new CFPlus::UI::Table expand => 1),
1956 );
1957
1958 my $row = 0;
1959 my $col = 0;
1960
1961 my %resist_names = (
1962 slow => ["Slow",
1963 "<b>Slow</b> (slows you down when you are hit by the spell. Monsters will have an opportunity to come near you faster and hit you more often.)"],
1964 holyw => ["Holy Word",
1965 "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)"],
1966 conf => ["Confusion",
1967 "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)"],
1968 fire => ["Fire",
1969 "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)"],
1970 depl => ["Depletion",
1971 "<b>Depletion</b> (some monsters and other effects can cause stats depletion)"],
1972 magic => ["Magic",
1973 "<b>Magic</b> (resistance to magic spells like magic missile or similar)"],
1974 drain => ["Draining",
1975 "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)"],
1976 acid => ["Acid",
1977 "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)"],
1978 pois => ["Poison",
1979 "<b>Poison</b> (resistance to getting poisoned)"],
1980 para => ["Paralysation",
1981 "<b>Paralysation</b> (this resistance affects the chance you get paralysed)"],
1982 deat => ["Death",
1983 "<b>Death</b> (resistance against death spells)"],
1984 phys => ["Physical",
1985 "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat. The value displayed here is also displayed in the 'Arm' field on the left.)"],
1986 blind => ["Blind",
1987 "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)"],
1988 fear => ["Fear",
1989 "<b>Fear</b> (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)"],
1990 tund => ["Turn undead",
1991 "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead..."],
1992 elec => ["Electricity",
1993 "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)"],
1994 cold => ["Cold",
1995 "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)"],
1996 ghit => ["Ghost hit",
1997 "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)"],
1998 );
1999 for (qw/slow holyw conf fire depl magic
2000 drain acid pois para deat phys
2001 blind fear tund elec cold ghit/)
2002 {
2003 $tbl2->add ($col, $row,
2004 $STATWIDS->{"res_$_"} =
2005 new CFPlus::UI::Label
2006 font => $FONT_FIXED,
2007 template => "-100%",
2008 align => +1,
2009 valign => 0,
2010 can_events => 1,
2011 can_hover => 1,
2012 tooltip => $resist_names{$_}->[1],
2013 );
2014 $tbl2->add ($col + 1, $row, new CFPlus::UI::Image
2015 font => $FONT_FIXED,
2016 can_hover => 1,
2017 can_events => 1,
2018 path => "ui/resist/resist_$_.png",
2019 tooltip => $resist_names{$_}->[1],
2020 );
2021 $tbl2->add ($col + 2, $row, new CFPlus::UI::Label
2022 text => $resist_names{$_}->[0],
2023 font => $FONT_FIXED,
2024 can_hover => 1,
2025 can_events => 1,
2026 tooltip => $resist_names{$_}->[1],
2027 );
2028
2029 $row++;
2030 if ($row % 6 == 0) {
2031 $col += 3;
2032 $row = 0;
2033 }
2034 }
2035
2036 #update_stats_window ({});
2037
2038 $r
2039}
2040
2041sub skill_window {
2042 my $sw = new CFPlus::UI::ScrolledWindow (expand => 1);
2043 $sw->add ($STATWIDS->{skill_tbl} = new CFPlus::UI::Table expand => 1, col_expand => [0, 0, 1, 0, 0, 1]);
2044 $sw
2045}
2046
2047sub formsep($) {
2048 scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
2049}
2050
2051my $METASERVER_ATIME;
2052
2053sub update_metaserver {
2054 my ($metaserver_dialog) = @_;
2055
2056 $METASERVER = $metaserver_dialog
2057 if defined $metaserver_dialog;
2058
2059 return if $METASERVER_ATIME > time;
2060 $METASERVER_ATIME = time + 60;
2061
2062 my $table = $METASERVER->{table};
2063 $table->clear;
2064 $table->add_at (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
2065
2066 my $ok = 0;
2067
2068 CFPlus::background {
2069 my $ua = CFPlus::lwp_useragent;
2070
2071 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
2072 } sub {
2073 my ($msg) = @_;
2074 if ($msg) {
2075 $table->clear;
2076
2077 my @tip = (
2078 "The current number of users logged in on the server.",
2079 "The hostname of the server.",
2080 "The time this server has been running without being restarted.",
2081 "The server software version - a '+' indicates a Crossfire+ server.",
2082 "Short information about this server provided by its admins.",
2083 );
2084 my @col = qw(#Users Host Uptime Version Description);
2085 $table->add_at ($_, 0, new CFPlus::UI::Label
2086 can_hover => 1, can_events => 1,
2087 align => 0, fg => [1, 1, 0],
2088 text => $col[$_], tooltip => $tip[$_])
2089 for 0 .. $#col;
2090
2091 my @align = qw(1 0 1 1 -1);
2092
2093 my $y = 0;
2094 for my $m (@{ $msg->{servers} }) {
2095 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
2096 @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
2097
2098 for ($desc) {
2099 s/<br>/\n/gi;
2100 s/<li>/\n· /gi;
2101 s/<.*?>//sgi;
2102 s/&amp;/&/g;
2103 s/&lt;/</g;
2104 s/&gt;/>/g;
2105 }
2106
2107 $uptime = sprintf "%dd %02d:%02d:%02d",
2108 (int $uptime / 86400),
2109 (int $uptime / 3600) % 24,
2110 (int $uptime / 60) % 60,
2111 $uptime % 60;
2112
2113 $m = [$users, $host, $uptime, $version, $desc];
2114
2115 $y++;
2116
2117 $table->add_at (scalar @$m, $y, new CFPlus::UI::VBox children => [
2118 (new CFPlus::UI::Button
2119 text => "Use",
2120 tooltip => "Put this server into the <b>Host:Port</b> field",
2121 on_activate => sub {
2122 $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
2123 $METASERVER->hide;
2124 0
2125 },
2126 ),
2127 (new CFPlus::UI::Empty expand => 1),
2128 ]);
2129
2130 $table->add_at ($_, $y, new CFPlus::UI::Label
2131 max_w => $::WIDTH * 0.4,
2132 ellipsise => 0,
2133 align => $align[$_],
2134 text => $m->[$_],
2135 tooltip => $tip[$_],
2136 fg => ($highlight ? [1, 1, 1] : [.7, .7, .7]),
2137 can_hover => 1,
2138 can_events => 1,
2139 fontsize => 0.8)
2140 for 0 .. $#$m;
2141 }
2142 } else {
2143 $ok or $label->set_text ("error while contacting metaserver");
2144 }
2145 };
2146
2147}
2148
2149sub metaserver_dialog {
2150 my $vbox = new CFPlus::UI::VBox;
2151 my $table = new CFPlus::UI::Table;
2152 $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table);
2153
2154 my $dialog = new CFPlus::UI::Toplevel
2155 title => "Server List",
2156 name => 'metaserver_dialog',
2157 x => 'center',
2158 y => 'center',
2159 z => 3,
2160 force_w => $::WIDTH * 0.9,
2161 force_h => $::HEIGHT * 0.7,
2162 child => $vbox,
2163 has_close_button => 1,
2164 table => $table,
2165 on_visibility_change => sub {
2166 update_metaserver ($_[0]) if $_[1];
2167 0 1082 0
2168 }, 1083 },
2169 ; 1084 ;
2170 1085
2171 $dialog 1086 $self->SUPER::add ($self->{vp});
2172}
2173 1087
2174sub server_setup { 1088 $self->add ($child) if $child;
2175 my $vbox = new CFPlus::UI::VBox;
2176 1089
2177 $vbox->add (new CFPlus::UI::FancyFrame 1090 $self
2178 label => "Connection Settings",
2179 child => (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]),
2180 );
2181 $table->add_at (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port");
2182
2183 {
2184 $table->add_at (1, 2, my $vbox = new CFPlus::UI::VBox);
2185
2186 $vbox->add (
2187 $HOST_ENTRY = new CFPlus::UI::Entry
2188 expand => 1,
2189 text => $CFG->{profile}{default}{host},
2190 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
2191 on_changed => sub {
2192 my ($self, $value) = @_;
2193 $CFG->{profile}{default}{host} = $value;
2194 0
2195 }
2196 );
2197
2198 $vbox->add (new CFPlus::UI::Button
2199 expand => 1,
2200 text => "Server List",
2201 other => $METASERVER,
2202 tooltip => "Show a list of available crossfire servers",
2203 on_activate => sub { $METASERVER->toggle_visibility; 0 },
2204 on_visibility_change => sub { $METASERVER->hide unless $_[1]; 0 },
2205 );
2206 }
2207
2208 $table->add_at (0, 4, new CFPlus::UI::Label valign => 0, align => 1, text => "Username");
2209 $table->add_at (1, 4, new CFPlus::UI::Entry
2210 text => $CFG->{profile}{default}{user},
2211 tooltip => "The name of your character on the server",
2212 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value }
2213 );
2214
2215 $table->add_at (0, 5, new CFPlus::UI::Label valign => 0, align => 1, text => "Password");
2216 $table->add_at (1, 5, new CFPlus::UI::Entry
2217 text => $CFG->{profile}{default}{password},
2218 hidden => 1,
2219 tooltip => "The password for your character",
2220 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value }
2221 );
2222
2223 $table->add_at (0, 7, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Size");
2224 $table->add_at (1, 7, new CFPlus::UI::Slider
2225 force_w => 100,
2226 range => [$CFG->{mapsize}, 10, 100, 0, 1],
2227 tooltip => "This is the size of the portion of the map update the server sends you. "
2228 . "If you set this to a high value you will be able to see further, "
2229 . "but you also increase bandwidth requirements and latency. "
2230 . "This option is only used once at log-in.",
2231 on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 0 },
2232 );
2233
2234 $table->add_at (0, 8, new CFPlus::UI::Label valign => 0, align => 1, text => "Face Prefetch");
2235 $table->add_at (1, 8, new CFPlus::UI::CheckBox
2236 state => $CFG->{face_prefetch},
2237 tooltip => "<b>Background Image Prefetch</b>\n\n"
2238 . "If enabled, the client automatically pre-fetches images from the server. "
2239 . "This might increase or create lag, but increases the chances "
2240 . "of faces being ready for display when you encounter them. "
2241 . "It also uses up server bandwidth on every connect, "
2242 . "so only set it if you really need to prefetch images. "
2243 . "This option can be set and unset any time.",
2244 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
2245 );
2246
2247 $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate");
2248 $table->add_at (1, 9, new CFPlus::UI::Entry
2249 text => $CFG->{output_rate},
2250 tooltip => "The approximate bandwidth in bytes per second that the server should not exceed "
2251 . "when sending images, to ensure interactiveness. When 0 or unset, the server "
2252 . "default will be used, which is usually around 100kb/s.",
2253 on_changed => sub { $CFG->{output_rate} = $_[1]; 0 },
2254 );
2255
2256 $table->add_at (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count");
2257 $table->add_at (1, 10, new CFPlus::UI::Entry
2258 text => $CFG->{output_count},
2259 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
2260 on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
2261 );
2262
2263 $table->add_at (0, 11, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync");
2264 $table->add_at (1, 11, new CFPlus::UI::Entry
2265 text => $CFG->{output_sync},
2266 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
2267 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
2268 );
2269
2270 $table->add_at (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button
2271 expand => 1,
2272 align => 0,
2273 text => "Login",
2274 on_activate => sub {
2275 $CONN ? stop_game
2276 : start_game;
2277 0
2278 },
2279 );
2280
2281 $vbox->add (new CFPlus::UI::FancyFrame
2282 label => "Server Info",
2283 child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0),
2284 );
2285
2286 $vbox
2287} 1091}
2288 1092
2289sub client_setup { 1093sub add {
2290 my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1];
2291
2292 my $row = 0;
2293
2294 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command");
2295 $table->add_at (1, $row++, my $saycmd = new CFPlus::UI::Entry
2296 text => $CFG->{say_command},
2297 tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "
2298 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
2299 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
2300 on_changed => sub {
2301 my ($self, $value) = @_; 1094 my ($self, $widget) = @_;
2302 $CFG->{say_command} = $value; 1095
2303 0 1096 $self->{vp}->add ($self->{child} = $widget);
1097}
1098
1099sub set_offset { shift->{vp}->set_offset (@_) }
1100sub set_center { shift->{vp}->set_center (@_) }
1101sub make_visible { shift->{vp}->make_visible (@_) }
1102
1103sub update_slider {
1104 my ($self) = @_;
1105
1106 my $child = ($self->{vp} or return)->child;
1107
1108 if ($self->{scroll_x}) {
1109 my ($w1, $w2) = ($child->{req_w}, $self->{vp}{w});
1110 $self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);
1111
1112 my $visible = $w1 > $w2;
1113 if ($visible != $self->{hslider_visible}) {
1114 $self->{hslider_visible} = $visible;
1115 $visible ? $self->SUPER::add ($self->{hslider})
1116 : $self->SUPER::remove ($self->{hslider});
2304 } 1117 }
2305 ); 1118 }
2306 1119
2307 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day"); 1120 if ($self->{scroll_y}) {
2308 $table->add_at (1, $row++, new CFPlus::UI::CheckBox 1121 my ($h1, $h2) = ($child->{req_h}, $self->{vp}{h});
2309 state => $CFG->{show_tips}, 1122 $self->{vslider}->set_range ([$self->{vslider}{range}[0], 0, $h1, $h2, 1]);
2310 tooltip => "Show the <b>Tip of the day</b> window at startup?", 1123
2311 on_changed => sub { 1124 my $visible = $h1 > $h2;
2312 my ($self, $value) = @_; 1125 if ($visible != $self->{vslider_visible}) {
2313 $CFG->{show_tips} = $value; 1126 $self->{vslider_visible} = $visible;
2314 0 1127 $visible ? $self->SUPER::add ($self->{vslider})
1128 : $self->SUPER::remove ($self->{vslider});
2315 } 1129 }
2316 ); 1130 }
1131}
2317 1132
2318 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Messages Window Size"); 1133sub start_dragging {
2319 $table->add_at (1, $row++, my $saycmd = new CFPlus::UI::Entry
2320 text => $CFG->{logview_max_par},
2321 tooltip => "This is maximum number of messages remembered in the <b>Messages</b> window. If the server "
2322 . "sends more messages than this number, older messages get removed to save memory and "
2323 . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
2324 on_changed => sub {
2325 my ($self, $value) = @_; 1134 my ($self, $ev) = @_;
2326 $LOGVIEW->{max_par} = $CFG->{logview_max_par} = $value*1; 1135
2327 0 1136 $self->grab_focus;
2328 }, 1137
1138 my $ox = $self->{vp}{view_x};
1139 my $oy = $self->{vp}{view_y};
2329 ); 1140
1141 $self->{motion} = sub {
1142 my ($ev, $x, $y) = @_;
2330 1143
2331 $table 1144 $ox -= $ev->{xrel};
2332} 1145 $oy -= $ev->{yrel};
2333 1146
2334sub message_window { 1147 $self->{vp}->set_offset ($ox, $oy);
2335 my $window = new CFPlus::UI::Toplevel
2336 name => "message_window",
2337 title => "Messages",
2338 border_bg => [1, 1, 1, 1],
2339 x => "max",
2340 y => 0,
2341 force_w => $::WIDTH * 0.4,
2342 force_h => $::HEIGHT * 0.5,
2343 child => (my $vbox = new CFPlus::UI::VBox),
2344 has_close_button => 1;
2345
2346 $vbox->add ($LOGVIEW);
2347
2348 $vbox->add (my $input = new CFPlus::UI::Entry
2349 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
2350 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
2351 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
2352 . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
2353 on_focus_in => sub {
2354 my ($input, $prev_focus) = @_;
2355
2356 delete $input->{refocus_map};
2357
2358 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
2359 $input->{refocus_map} = 1;
2360 }
2361 delete $input->{auto_activated};
2362
2363 0
2364 },
2365 on_activate => sub {
2366 my ($input, $text) = @_;
2367 $input->set_text ('');
2368
2369 if ($text =~ /^\/(.*)/) {
2370 $::CONN->user_send ($1);
2371 } else {
2372 my $say_cmd = $::CFG->{say_command} || 'say';
2373 $::CONN->user_send ("$say_cmd $text");
2374 }
2375 if ($input->{refocus_map}) {
2376 delete $input->{refocus_map};
2377 $MAPWIDGET->focus_in
2378 }
2379
2380 0
2381 },
2382 on_escape => sub {
2383 $MAPWIDGET->grab_focus;
2384
2385 0
2386 },
2387 );
2388
2389 $CONSOLE = {
2390 window => $window,
2391 input => $input,
2392 }; 1148 };
2393
2394 $window
2395}
2396
2397sub autopickup_setup {
2398 my $r = new CFPlus::UI::ScrolledWindow (
2399 expand => 1,
2400 scroll_y => 1
2401 );
2402 $r->add (my $table = new CFPlus::UI::Table
2403 row_expand => [0],
2404 col_expand => [0, 1, 0, 1],
2405 );
2406
2407 for (
2408 ["General", 0, 0,
2409 ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE],
2410 ["Inhibit autopickup" => PICKUP_INHIBIT],
2411 ["Stop before pickup" => PICKUP_STOP],
2412 ["Debug autopickup" => PICKUP_DEBUG],
2413 ],
2414 ["Weapons", 0, 6,
2415 ["All weapons" => PICKUP_ALLWEAPON],
2416 ["Missile weapons" => PICKUP_MISSILEWEAPON],
2417 ["Bows" => PICKUP_BOW],
2418 ["Arrows" => PICKUP_ARROW],
2419 ],
2420 ["Armour", 0, 12,
2421 ["Helmets" => PICKUP_HELMET],
2422 ["Shields" => PICKUP_SHIELD],
2423 ["Body Armour" => PICKUP_ARMOUR],
2424 ["Boots" => PICKUP_BOOTS],
2425 ["Gloves" => PICKUP_GLOVES],
2426 ["Cloaks" => PICKUP_CLOAK],
2427 ],
2428
2429 ["Readables", 2, 0,
2430 ["Spellbooks" => PICKUP_SPELLBOOK],
2431 ["Skillscrolls" => PICKUP_SKILLSCROLL],
2432 ["Normal Books/Scrolls" => PICKUP_READABLES],
2433 ],
2434 ["Misc", 2, 5,
2435 ["Food" => PICKUP_FOOD],
2436 ["Drinks" => PICKUP_DRINK],
2437 ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
2438 ["Keys" => PICKUP_KEY],
2439 ["Magical Items" => PICKUP_MAGICAL],
2440 ["Potions" => PICKUP_POTION],
2441 ["Magic Devices" => PICKUP_MAGIC_DEVICE],
2442 ["Ignore cursed" => PICKUP_NOT_CURSED],
2443 ["Jewelery" => PICKUP_JEWELS],
2444 ["Flesh" => PICKUP_FLESH],
2445 ],
2446 ["Weight/Value ratio", 2, 17]
2447 )
2448 {
2449 my ($title, $x, $y, @bits) = @$_;
2450 $table->add_at ($x, $y, new CFPlus::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
2451
2452 for (@bits) {
2453 ++$y;
2454
2455 my $mask = $_->[1];
2456 $table->add_at ($x , $y, new CFPlus::UI::Label text => $_->[0], align => 1, expand => 1);
2457 $table->add_at ($x+1, $y, my $checkbox = new CFPlus::UI::CheckBox
2458 state => $::CFG->{pickup} & $mask,
2459 on_changed => sub {
2460 my ($box, $value) = @_;
2461
2462 if ($value) {
2463 $::CFG->{pickup} |= $mask;
2464 } else {
2465 $::CFG->{pickup} &= ~$mask;
2466 }
2467
2468 $::CONN->send_command ("pickup $::CFG->{pickup}")
2469 if defined $::CONN;
2470
2471 0
2472 });
2473
2474 ${$_->[2]} = $checkbox if $_->[2];
2475 }
2476 }
2477
2478 $table->add_at (2, 18, new CFPlus::UI::ValSlider
2479 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
2480 template => ">= 99",
2481 to_value => sub { ">= " . 5 * $_[0] },
2482 on_changed => sub {
2483 my ($slider, $value) = @_;
2484
2485 $::CFG->{pickup} &= ~0xF;
2486 $::CFG->{pickup} |= int $value
2487 if $value;
2488 1;
2489 });
2490
2491 $table->add_at (3, 18, new CFPlus::UI::Button
2492 text => "set",
2493 on_activate => sub {
2494 $::CONN->send_command ("pickup $::CFG->{pickup}")
2495 if defined $::CONN;
2496 0
2497 });
2498
2499 $r
2500}
2501
2502my %SORT_ORDER = (
2503 type => undef,
2504 mtime => sub {
2505 my $NOW = time;
2506 sort {
2507 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
2508 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
2509
2510 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
2511 or $btime <=> $atime
2512 or $a->{type} <=> $b->{type}
2513 } @_
2514 },
2515 weight => sub { sort {
2516 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
2517 or $a->{type} <=> $b->{type}
2518 } @_ },
2519);
2520
2521sub inventory_widget {
2522 my $hb = new CFPlus::UI::HBox homogeneous => 1;
2523
2524 $hb->add (my $vb1 = new CFPlus::UI::VBox);
2525 $vb1->add (new CFPlus::UI::Label align => 0, text => "Player");
2526
2527 $vb1->add (my $hb1 = new CFPlus::UI::HBox);
2528
2529 use sort 'stable';
2530
2531 $hb1->add (new CFPlus::UI::Selector
2532 value => $::CFG->{inv_sort},
2533 options => [
2534 [type => "Type/Name"],
2535 [mtime => "Recent/Normal/Locked"],
2536 [weight => "Weight/Type"],
2537 ],
2538 on_changed => sub {
2539 $::CFG->{inv_sort} = $_[1];
2540 $INV->set_sort_order ($SORT_ORDER{$_[1]});
2541 },
2542 );
2543 $hb1->add (new CFPlus::UI::Label text => "Weight: ", align => 1, expand => 1);
2544 #TODO# update to weigh/maxweight
2545 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
2546
2547 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
2548 $sw1->add ($INV = new CFPlus::UI::Inventory);
2549 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
2550
2551 $hb->add (my $vb2 = new CFPlus::UI::VBox);
2552
2553 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
2554
2555 $vb2->add (my $sw2 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
2556 $sw2->add ($INVR = new CFPlus::UI::Inventory);
2557
2558 # XXX: Call after $INVR = ... because set_opencont sets the items
2559 CFPlus::Protocol::set_opencont ($::CONN, 0, "Floor");
2560
2561 $hb
2562}
2563
2564sub toggle_player_page {
2565 my ($widget) = @_;
2566
2567 if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
2568 $PL_WINDOW->hide;
2569 } else {
2570 $PL_NOTEBOOK->set_current_page ($widget);
2571 $PL_WINDOW->show;
2572 }
2573}
2574
2575sub player_window {
2576 my $plwin = $PL_WINDOW = new CFPlus::UI::Toplevel
2577 x => "center",
2578 y => "center",
2579 force_w => $WIDTH * 9/10,
2580 force_h => $HEIGHT * 9/10,
2581 title => "Player",
2582 name => "playerbook",
2583 has_close_button => 1
2584 ;
2585
2586 my $ntb =
2587 $PL_NOTEBOOK =
2588 new CFPlus::UI::Notebook expand => 1;
2589
2590 $ntb->add (
2591 "Statistics (F2)" => $STATS_PAGE = stats_window,
2592 "Shows statistics, where all your Stats and Resistances are shown."
2593 );
2594 $ntb->add (
2595 "Skills (F3)" => $SKILL_PAGE = skill_window,
2596 "Shows all your Skills."
2597 );
2598
2599 my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
2600 $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
2601 $ntb->add (
2602 "Spellbook (F4)" => $spellsw,
2603 "Displays all spells you have and lets you edit keyboard shortcuts for them."
2604 );
2605 $ntb->add (
2606 "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
2607 "Toggles the inventory window, where you can manage your loot (or treasures :). "
2608 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
2609 );
2610 $ntb->add (Pickup => autopickup_setup,
2611 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
2612
2613 $ntb->set_current_page ($INVENTORY_PAGE);
2614
2615 $plwin->add ($ntb);
2616 $plwin
2617}
2618
2619sub keyboard_setup {
2620 CFPlus::Macro::keyboard_setup
2621}
2622
2623sub help_window {
2624 my $win = new CFPlus::UI::Toplevel
2625 x => 'center',
2626 y => 'center',
2627 z => 4,
2628 name => 'doc_browser',
2629 force_w => int $WIDTH * 7/8,
2630 force_h => int $HEIGHT * 7/8,
2631 title => "Help Browser",
2632 has_close_button => 1;
2633
2634 $win->add (my $vbox = new CFPlus::UI::VBox);
2635
2636 $vbox->add (new CFPlus::UI::FancyFrame
2637 label => "Navigation",
2638 child => (my $buttons = new CFPlus::UI::HBox),
2639 );
2640 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
2641 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
2642
2643 my @history;
2644 my @future;
2645 my $curnode;
2646
2647 my $load_node; $load_node = sub {
2648 my ($node, $para) = @_;
2649
2650 $buttons->clear;
2651
2652 $buttons->add (new CFPlus::UI::Button
2653 text => "⇤",
2654 tooltip => "back to the starting page",
2655 on_activate => sub {
2656 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
2657 unshift @future, @history;
2658 @history = ();
2659 $load_node->(@{shift @future});
2660 },
2661 );
2662
2663 if (@history) {
2664 $buttons->add (new CFPlus::UI::Button
2665 text => "⋘",
2666 tooltip => "back to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $history[-1][0]) . "</i>",
2667 on_activate => sub {
2668 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
2669 $load_node->(@{pop @history});
2670 },
2671 );
2672 }
2673
2674 if (@future) {
2675 $buttons->add (new CFPlus::UI::Button
2676 text => "⋙",
2677 tooltip => "forward to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $future[0][0]) . "</i>",
2678 on_activate => sub {
2679 push @history, [$curnode, $viewer->current_paragraph];
2680 $load_node->(@{shift @future});
2681 },
2682 );
2683 }
2684
2685 $buttons->add (new CFPlus::UI::Label text => " ");
2686
2687 my @path = CFPlus::Pod::full_path_of $node;
2688 pop @path; # drop current node
2689
2690 for my $node (@path) {
2691 $buttons->add (new CFPlus::UI::Button
2692 text => $node->{kw}[0],
2693 tooltip => "go to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $node) . "</i>",
2694 on_activate => sub {
2695 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
2696 $load_node->($node);
2697 },
2698 );
2699 $buttons->add (new CFPlus::UI::Label text => "/");
2700 }
2701
2702 $buttons->add (new CFPlus::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4);
2703
2704 $curnode = $node;
2705
2706 $viewer->clear;
2707 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode);
2708 $viewer->scroll_to ($para);
2709 };
2710
2711 $load_node->(CFPlus::Pod::find pod => "mainpage");
2712
2713 $CFPlus::Pod::goto_document = sub {
2714 my (@path) = @_;
2715
2716 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
2717
2718 $load_node->((CFPlus::Pod::find @path)[0]);
2719 $win->show;
2720 };
2721
2722 $win
2723}
2724
2725sub open_string_query {
2726 my ($title, $cb, $txt, $tooltip) = @_;
2727 my $dialog = new CFPlus::UI::Toplevel
2728 x => "center",
2729 y => "center",
2730 z => 50,
2731 force_w => $WIDTH * 4/5,
2732 title => $title;
2733
2734 $dialog->add (
2735 my $e = new CFPlus::UI::Entry
2736 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
2737 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
2738 tooltip => $tooltip
2739 );
2740
2741 $e->grab_focus;
2742 $e->set_text ($txt) if $txt;
2743 $dialog->show;
2744}
2745
2746sub open_quit_dialog {
2747 unless ($QUIT_DIALOG) {
2748 $QUIT_DIALOG = new CFPlus::UI::Toplevel
2749 x => "center",
2750 y => "center",
2751 z => 50,
2752 title => "Really Quit?",
2753 on_key_down => sub {
2754 my ($dialog, $ev) = @_;
2755 $ev->{sym} == 27 and $dialog->hide;
2756 }
2757 ;
2758
2759 $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
2760
2761 $vb->add (new CFPlus::UI::Label
2762 text => "You should find a savebed and apply it first!",
2763 max_w => $WIDTH * 0.25,
2764 ellipsize => 0,
2765 );
2766 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
2767 $hb->add (new CFPlus::UI::Button
2768 text => "Ok",
2769 expand => 1,
2770 on_activate => sub { $QUIT_DIALOG->hide; 0 },
2771 );
2772 $hb->add (new CFPlus::UI::Button
2773 text => "Quit anyway",
2774 expand => 1,
2775 on_activate => sub { exit },
2776 );
2777 }
2778
2779 $QUIT_DIALOG->show;
2780 $QUIT_DIALOG->grab_focus;
2781}
2782
2783sub show_tip_of_the_day {
2784 # find all tips
2785 my @tod = CFPlus::Pod::find tip_of_the_day => "*";
2786
2787 CFPlus::DB::get state => "tip_of_the_day", sub {
2788 my ($todindex) = @_;
2789 $todindex = 0 if $todindex >= @tod;
2790 CFPlus::DB::put state => tip_of_the_day => $todindex + 1, sub { };
2791
2792 # create dialog
2793 my $dialog;
2794
2795 my $close = sub {
2796 $dialog->destroy;
2797 };
2798
2799 $dialog = new CFPlus::UI::Toplevel
2800 x => "center",
2801 y => "center",
2802 z => 3,
2803 name => 'tip_of_the_day',
2804 force_w => int $WIDTH * 4/9,
2805 force_h => int $WIDTH * 2/9,
2806 title => "Tip of the day #" . (1 + $todindex),
2807 child => my $vbox = new CFPlus::UI::VBox,
2808 has_close_button => 1,
2809 on_delete => $close,
2810 ;
2811
2812 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
2813 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
2814 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]);
2815
2816 $vbox->add (my $table = new CFPlus::UI::Table col_expand => [0, 1]);
2817
2818 $table->add_at (0, 0, new CFPlus::UI::Button
2819 text => "Close",
2820 tooltip => "Close the tip of the day window. To never see it again, disable the tip of the day in the <b>Server Setup</b>.",
2821 on_activate => $close,
2822 );
2823
2824 $table->add_at (2, 0, new CFPlus::UI::Button
2825 text => "Next",
2826 tooltip => "Show the next <b>Tip of the day</b>.",
2827 on_activate => sub {
2828 $close->();
2829 &show_tip_of_the_day;
2830 },
2831 );
2832
2833 $dialog->show;
2834 };
2835}
2836
2837sub sdl_init {
2838 CFPlus::SDL_Init
2839 and die "SDL::Init failed!\n";
2840}
2841
2842sub video_init {
2843 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
2844
2845 my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
2846
2847 ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
2848 $FULLSCREEN = $CFG->{fullscreen};
2849 $FAST = $CFG->{fast};
2850
2851 CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
2852 or die "SDL_SetVideoMode failed: " . (CFPlus::SDL_GetError) . "\n";
2853
2854 $SDL_ACTIVE = 1;
2855 $LAST_REFRESH = time - 0.01;
2856
2857 CFPlus::OpenGL::init;
2858
2859 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
2860
2861 $CFPlus::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
2862
2863 #############################################################################
2864
2865 if ($DEBUG_STATUS) {
2866 CFPlus::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
2867 } else {
2868 # create the widgets
2869
2870 $DEBUG_STATUS = new CFPlus::UI::Label
2871 padding => 0,
2872 z => 100,
2873 force_x => "max",
2874 force_y => 0;
2875 $DEBUG_STATUS->show;
2876
2877 $STATUSBOX = new CFPlus::UI::Statusbox;
2878 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
2879
2880 (new CFPlus::UI::Frame
2881 bg => [0, 0, 0, 0.4],
2882 force_x => 0,
2883 force_y => "max",
2884 child => $STATUSBOX,
2885 )->show;
2886
2887 CFPlus::UI::Toplevel->new (
2888 title => "Map",
2889 name => "mapmap",
2890 x => 0,
2891 y => $FONTSIZE + 8,
2892 border_bg => [1, 1, 1, 192/255],
2893 bg => [1, 1, 1, 0],
2894 child => ($MAPMAP = new CFPlus::MapWidget::MapMap
2895 tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
2896 ),
2897 )->show;
2898
2899 $MAPWIDGET = new CFPlus::MapWidget;
2900 $MAPWIDGET->connect (activate_console => sub {
2901 my ($mapwidget, $preset) = @_;
2902
2903 if ($CONSOLE) {
2904 $CONSOLE->{input}->{auto_activated} = 1;
2905 $CONSOLE->{input}->grab_focus;
2906
2907 if ($preset && $CONSOLE->{input}->get_text eq '') {
2908 $CONSOLE->{input}->set_text ($preset);
2909 }
2910 }
2911 });
2912 $MAPWIDGET->show;
2913 $MAPWIDGET->grab_focus;
2914
2915 $LOGVIEW = new CFPlus::UI::TextScroller
2916 expand => 1,
2917 font => $FONT_FIXED,
2918 fontsize => $::CFG->{log_fontsize},
2919 indent => -4,
2920 can_hover => 1,
2921 can_events => 1,
2922 max_par => $CFG->{logview_max_par},
2923 tooltip => "<b>Server Log</b>. This text viewer contains all recent messages sent by the server.",
2924 ;
2925
2926 $SETUP_DIALOG = new CFPlus::UI::Toplevel
2927 title => "Setup",
2928 name => "setup_dialog",
2929 x => 'center',
2930 y => 'center',
2931 z => 2,
2932 force_w => $::WIDTH * 0.6,
2933 force_h => $::HEIGHT * 0.6,
2934 has_close_button => 1,
2935 ;
2936
2937 $METASERVER = metaserver_dialog;
2938
2939 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1,
2940 filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
2941
2942 $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
2943 "Configure the server to play on, your username, password and other server-related options.");
2944 $SETUP_NOTEBOOK->add (Client => client_setup,
2945 "Configure various client-specific settings.");
2946 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
2947 "Configure the video mode, performance, fonts and other graphical aspects of the game.");
2948 $SETUP_NOTEBOOK->add (Audio => audio_setup,
2949 "Configure the use of audio, sound effects and background music.");
2950 $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
2951 "Lets you define, edit and delete key bindings."
2952 . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
2953 . "with nothing set and the recording started. After doing the actions you "
2954 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
2955 . "After pressing the combo the binding will be saved automatically and the "
2956 . "binding editor closes");
2957 $SETUP_NOTEBOOK->add (Debug => debug_setup,
2958 "Some debuggin' options. Do not ask.");
2959
2960 $BUTTONBAR = new CFPlus::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
2961
2962 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
2963 tooltip => "Toggles a dialog where you can configure all aspects of this client.");
2964
2965 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
2966 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2967
2968 make_gauge_window->show; # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
2969
2970 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Playerbook", other => player_window,
2971 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
2972
2973 $BUTTONBAR->add (new CFPlus::UI::Button
2974 text => "Save Config",
2975 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
2976 on_activate => sub {
2977 $::CFG->{layout} = CFPlus::UI::get_layout;
2978 CFPlus::write_cfg "$Crossfire::VARDIR/cfplusrc";
2979 status "Configuration Saved";
2980 0
2981 },
2982 );
2983
2984 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
2985 tooltip => "View Documentation");
2986
2987
2988 $BUTTONBAR->add (new CFPlus::UI::Button
2989 text => "Quit",
2990 tooltip => "Terminates the program",
2991 on_activate => sub {
2992 if ($CONN) {
2993 open_quit_dialog;
2994 } else {
2995 exit;
2996 }
2997 0
2998 },
2999 );
3000
3001 $BUTTONBAR->show;
3002 $SETUP_DIALOG->show;
3003 }
3004
3005 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
3006}
3007
3008sub setup_build_button {
3009 my ($enabled) = @_;
3010 if ($enabled) {
3011 $BUILD_BUTTON->hide if $BUILD_BUTTON;
3012 $BUILD_BUTTON ||= new CFPlus::UI::Button
3013 text => "Build",
3014 tooltip => "Opens the ingame builder",
3015 on_activate => sub {
3016 if ($CONN) {
3017 $CONN->send_ext_req (builder_player_items => sub {
3018 open_ingame_editor ($_[0]) if exists $_[0]->{items};
3019 });
3020 }
3021 0
3022 };
3023 $BUTTONBAR->add ($BUILD_BUTTON);
3024 } else {
3025 $BUILD_BUTTON->hide if $BUILD_BUTTON;
3026 }
3027}
3028
3029sub open_ingame_editor {
3030 my ($msg) = @_;
3031
3032 my $win = new CFPlus::UI::Toplevel
3033 x => 0,
3034 y => 'center',
3035 z => 4,
3036 name => 'builder_window',
3037 force_w => int $WIDTH * 1/4,
3038 force_h => int $HEIGHT * 3/4,
3039 title => "In game builder",
3040 has_close_button => 1;
3041
3042 my $r = new CFPlus::UI::ScrolledWindow (
3043 expand => 1,
3044 scroll_y => 1
3045 );
3046 $r->add (my $vb = new CFPlus::UI::VBox);
3047 $win->add ($r);
3048
3049
3050 $vb->add (
3051 new CFPlus::UI::Button
3052 text => "Disable build mode",
3053 on_activate => sub { $::IN_BUILD_MODE = undef }
3054 );
3055 $vb->add (
3056 new CFPlus::UI::Button
3057 text => "ERASE",
3058 on_activate => sub { $::IN_BUILD_MODE = { do_erase => 1 } }
3059 );
3060
3061 for my $itemarchname (
3062 sort {
3063 $msg->{items}->{$a}->{build_arch_name}
3064 cmp $msg->{items}->{$b}->{build_arch_name}
3065 } keys %{$msg->{items}}
3066 ) {
3067 my $info = $msg->{items}->{$itemarchname};
3068 $vb->add (
3069 new CFPlus::UI::Button text => $info->{build_arch_name},
3070 on_activate => sub {
3071 $::IN_BUILD_MODE = { item => $itemarchname, info => $info };
3072
3073 if (grep { $msg->{items}->{$itemarchname}->{$_} } qw/has_connection has_name has_text/) {
3074 build_mode_query_arch_info ();
3075 }
3076 }
3077 );
3078 }
3079
3080 $win->show;
3081}
3082
3083sub build_mode_query_arch_info {
3084 my ($iteminfo) = $::IN_BUILD_MODE;
3085 my $itemarchname = $iteminfo->{item};
3086 my $info = $iteminfo->{info};
3087
3088 my $dialog = new CFPlus::UI::Toplevel
3089 x => "center",
3090 y => "center",
3091 z => 50,
3092 force_w => int $WIDTH * 1/2,
3093 title => "Enter information for placement of '$itemarchname'",
3094 has_close_button => 1;
3095
3096 $dialog->add (my $vb = new CFPlus::UI::VBox expand => 1);
3097
3098 $vb->add (my $table = new CFPlus::UI::Table expand => 1);
3099 my $row = 0;
3100 if ($info->{has_name}) {
3101 $table->add_at (0, $row, new CFPlus::UI::Label text => "Name:");
3102 $table->add_at (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{name} = $_[1]; 0 });
3103 }
3104 if ($info->{has_text}) {
3105 $table->add_at (0, $row, new CFPlus::UI::Label text => "Text:");
3106 $table->add_at (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{text} = $_[1]; 0 });
3107 }
3108 if ($info->{has_connection}) {
3109 $table->add_at (0, $row, new CFPlus::UI::Label text => "Connection ID:");
3110 $table->add_at (1, $row++,
3111 new CFPlus::UI::Entry
3112 expand => 1,
3113 on_changed => sub { $::IN_BUILD_MODE->{connection} = $_[1]; 0 },
3114 tooltip => "Enter the connection ID here. The connection ID connects actors like a lever to a gate or a magic ear to a gate"
3115 );
3116 }
3117
3118 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
3119 $hb->add (new CFPlus::UI::Button
3120 text => "Close",
3121 expand => 1,
3122 on_activate => sub { $dialog->hide; 0 },
3123 );
3124 $dialog->show;
3125}
3126
3127sub video_shutdown {
3128 CFPlus::OpenGL::shutdown;
3129
3130 undef $SDL_ACTIVE;
3131}
3132
3133sub audio_channel_finished {
3134 my ($channel) = @_;
3135
3136 #warn "channel $channel finished\n";#d#
3137}
3138
3139sub audio_music_set {
3140 my ($songs) = @_;
3141
3142 my @want =
3143 grep $_,
3144 map $CONN->{music_meta}{$_},
3145 @$songs;
3146
3147 if (@want) {
3148 @MUSIC_WANT = @want;
3149 &audio_music_changed ();
3150 }
3151}
3152
3153sub audio_music_start {
3154 my $path = $MUSIC_PLAYING->{path}
3155 or return;
3156
3157 CFPlus::DB::prefetch_file $path, 1024_000, sub {
3158 # music might have changed...
3159 $path eq $MUSIC_PLAYING->{path}
3160 or return &audio_music_start ();
3161
3162 $MUSIC_PLAYER = new_from_file CFPlus::MixMusic $path;
3163
3164 my $NOW = time;
3165
3166 if ($MUSIC_PLAYING->{stop_time} > $NOW - $MUSIC_RESUME) {
3167 my $pos = $MUSIC_PLAYING->{stop_pos};
3168 $MUSIC_PLAYER->fade_in_pos (0, 1000, $pos);
3169 $MUSIC_START = time - $pos;
3170 } else {
3171 $MUSIC_PLAYER->play (0);
3172 $MUSIC_START = time;
3173 }
3174
3175 delete $MUSIC_PLAYING->{stop_time};
3176 delete $MUSIC_PLAYING->{stop_pos};
3177 }
3178}
3179
3180sub audio_music_changed {
3181 return unless $CFG->{bgm_enable};
3182
3183 # default MUSIC_WANT == MUSIC_DEFAULT
3184 @MUSIC_WANT = { path => CFPlus::find_rcfile "music/$MUSIC_DEFAULT" } unless @MUSIC_WANT;
3185
3186 # if the currently playing song is acceptable, let it continue
3187 return if $MUSIC_PLAYING
3188 && grep $MUSIC_PLAYING->{path} eq $_->{path}, @MUSIC_WANT;
3189
3190 my $NOW = time;
3191
3192 if ($MUSIC_PLAYING) {
3193 $MUSIC_PLAYING->{stop_time} = $NOW;
3194 $MUSIC_PLAYING->{stop_pos} = $NOW - $MUSIC_START;
3195 CFPlus::MixMusic::fade_out 1000;
3196 } else {
3197 # sort by stop time, oldest first
3198 @MUSIC_WANT = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_WANT;
3199
3200 # if the most recently-played piece played very recently,
3201 # resume it, else choose the oldest piece for rotation.
3202 $MUSIC_PLAYING =
3203 $MUSIC_WANT[-1]{stop_time} > $NOW - $MUSIC_RESUME
3204 ? $MUSIC_WANT[-1]
3205 : $MUSIC_WANT[0];
3206
3207 audio_music_start;
3208 }
3209}
3210
3211sub audio_music_finished {
3212 $MUSIC_PLAYING = undef;
3213 undef $MUSIC_PLAYER;
3214
3215 audio_music_changed;
3216}
3217
3218sub audio_init {
3219 if ($CFG->{audio_enable}) {
3220 if (open my $fh, "<", CFPlus::find_rcfile "sounds/config") {
3221 $SDL_MIXER = !CFPlus::Mix_OpenAudio;
3222
3223 unless ($SDL_MIXER) {
3224 status "Unable to open sound device: there will be no sound";
3225 return;
3226 }
3227
3228 CFPlus::Mix_AllocateChannels 8;
3229 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;
3230
3231 audio_music_finished;
3232
3233 local $_;
3234 while (<$fh>) {
3235 next if /^\s*#/;
3236 next if /^\s*$/;
3237
3238 my ($file, $volume, $event) = split /\s+/, $_, 3;
3239
3240 push @SOUNDS, "$volume,$file";
3241
3242 $AUDIO_CHUNKS{"$volume,$file"} ||= do {
3243 my $chunk = new_from_file CFPlus::MixChunk CFPlus::find_rcfile "sounds/$file";
3244 $chunk->volume ($volume * 128 / 100);
3245 $chunk
3246 };
3247 }
3248 } else {
3249 status "unable to open sound config: $!";
3250 }
3251 }
3252}
3253
3254sub audio_shutdown {
3255 CFPlus::Mix_CloseAudio if $SDL_MIXER;
3256 undef $SDL_MIXER;
3257 @SOUNDS = ();
3258 %AUDIO_CHUNKS = ();
3259}
3260
3261my %animate_object;
3262my $animate_timer;
3263
3264my $fps = 9;
3265
3266my %demo;#d#
3267
3268sub force_refresh {
3269 $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
3270 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
3271
3272 $CFPlus::UI::ROOT->draw;
3273
3274 $WANT_REFRESH = 0;
3275 $CAN_REFRESH = 0;
3276 $LAST_REFRESH = $NOW;
3277
3278 CFPlus::SDL_GL_SwapBuffers;
3279}
3280
3281my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
3282 $NOW = time;
3283
3284 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
3285 for CFPlus::poll_events;
3286
3287 if (%animate_object) {
3288 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
3289 ++$WANT_REFRESH;
3290 }
3291
3292 if ($WANT_REFRESH) {
3293 force_refresh;
3294 } else {
3295 $CAN_REFRESH = 1;
3296 }
3297});
3298
3299sub animation_start {
3300 my ($widget) = @_;
3301 $animate_object{$widget} = $widget;
3302}
3303
3304sub animation_stop {
3305 my ($widget) = @_;
3306 delete $animate_object{$widget};
3307}
3308
3309# check once/second for faces that need to be prefetched
3310# this should, of course, only run on demand, but
3311# SDL forces worse things on us....
3312
3313Event->timer (after => 1, interval => 0.25, cb => sub {
3314 $CONN->face_prefetch
3315 if $CONN;
3316});
3317
3318%SDL_CB = (
3319 CFPlus::SDL_QUIT => sub {
3320 exit;
3321 },
3322 CFPlus::SDL_VIDEORESIZE => sub {
3323 },
3324 CFPlus::SDL_VIDEOEXPOSE => sub {
3325 CFPlus::UI::full_refresh;
3326 },
3327 CFPlus::SDL_ACTIVEEVENT => sub {
3328# not useful, as APPACTIVE include sonly iconified state, not unmapped
3329# printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, CFPlus::SDL_GetAppState;#d#
3330# printf "a %x\n", CFPlus::SDL_GetAppState & CFPlus::SDL_APPACTIVE;#d#
3331# printf "A\n" if $_[0]{state} & CFPlus::SDL_APPACTIVE;
3332# printf "K\n" if $_[0]{state} & CFPlus::SDL_APPINPUTFOCUS;
3333# printf "M\n" if $_[0]{state} & CFPlus::SDL_APPMOUSEFOCUS;
3334 },
3335 CFPlus::SDL_KEYDOWN => sub {
3336 if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) {
3337 # alt-enter
3338 $FULLSCREEN_ENABLE->toggle;
3339 video_shutdown;
3340 video_init;
3341 } else {
3342 CFPlus::UI::feed_sdl_key_down_event ($_[0]);
3343 }
3344 },
3345 CFPlus::SDL_KEYUP => \&CFPlus::UI::feed_sdl_key_up_event,
3346 CFPlus::SDL_MOUSEMOTION => \&CFPlus::UI::feed_sdl_motion_event,
3347 CFPlus::SDL_MOUSEBUTTONDOWN => \&CFPlus::UI::feed_sdl_button_down_event,
3348 CFPlus::SDL_MOUSEBUTTONUP => \&CFPlus::UI::feed_sdl_button_up_event,
3349 CFPlus::SDL_USEREVENT => sub {
3350 if ($_[0]{code} == 1) {
3351 audio_channel_finished $_[0]{data1};
3352 } elsif ($_[0]{code} == 0) {
3353 audio_music_finished;
3354 }
3355 },
3356);
3357
3358#############################################################################
3359
3360$SIG{INT} = $SIG{TERM} = sub { exit };
3361
3362{
3363 CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc";
3364 CFPlus::DB::Server::run;
3365
3366 CFPlus::UI::set_layout ($::CFG->{layout});
3367
3368 my %DEF_CFG = (
3369 sdl_mode => 0,
3370 width => 640,
3371 height => 480,
3372 fullscreen => 0,
3373 fast => 0,
3374 map_scale => 1,
3375 fow_enable => 1,
3376 fow_intensity => 0,
3377 map_smoothing => 1,
3378 gui_fontsize => 1,
3379 log_fontsize => 0.7,
3380 gauge_fontsize => 1,
3381 gauge_size => 0.35,
3382 stat_fontsize => 0.7,
3383 mapsize => 100,
3384 say_command => 'chat',
3385 audio_enable => 1,
3386 bgm_enable => 1,
3387 bgm_volume => 0.25,
3388 face_prefetch => 0,
3389 output_sync => 1,
3390 output_count => 1,
3391 output_rate => "",
3392 pickup => 0,
3393 inv_sort => "mtime",
3394 default => "profile", # default profile
3395 show_tips => 1,
3396 logview_max_par => 1000,
3397 );
3398
3399 while (my ($k, $v) = each %DEF_CFG) {
3400 $CFG->{$k} = $v unless exists $CFG->{$k};
3401 }
3402
3403 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
3404 $PROFILE = $CFG->{profile}{default};
3405
3406 # convert old bindings (only default profile matters)
3407 if (my $bindings = delete $PROFILE->{bindings}) {
3408 while (my ($mod, $syms) = each %$bindings) {
3409 while (my ($sym, $cmds) = each %$syms) {
3410 push @{ $PROFILE->{macro} }, {
3411 accelkey => [$mod*1, $sym*1],
3412 action => $cmds,
3413 };
3414 }
3415 }
3416 }
3417
3418 sdl_init;
3419
3420 @SDL_MODES = CFPlus::SDL_ListModes 8, 8;
3421 @SDL_MODES = CFPlus::SDL_ListModes 5, 0 unless @SDL_MODES;
3422 @SDL_MODES or CFPlus::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
3423
3424 @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
3425
3426 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
3427
3428 {
3429 my @fonts = map CFPlus::find_rcfile "fonts/$_", qw(
3430 DejaVuSans.ttf
3431 DejaVuSansMono.ttf
3432 DejaVuSans-Bold.ttf
3433 DejaVuSansMono-Bold.ttf
3434 DejaVuSans-Oblique.ttf
3435 DejaVuSansMono-Oblique.ttf
3436 DejaVuSans-BoldOblique.ttf
3437 DejaVuSansMono-BoldOblique.ttf
3438 );
3439
3440 CFPlus::add_font $_ for @fonts;
3441
3442 CFPlus::pango_init;
3443
3444 $FONT_PROP = new_from_file CFPlus::Font $fonts[0];
3445 $FONT_FIXED = new_from_file CFPlus::Font $fonts[1];
3446
3447 $FONT_PROP->make_default;
3448 }
3449
3450# compare mono (ft) vs. rgba (cairo)
3451# ft - 1.8s, cairo 3s, even in alpha-only mode
3452# for my $rgba (0..1) {
3453# my $t1 = Time::HiRes::time;
3454# for (1..1000) {
3455# my $layout = CFPlus::Layout->new ($rgba);
3456# $layout->set_text ("hallo" x 100);
3457# $layout->render;
3458# }
3459# my $t2 = Time::HiRes::time;
3460# warn $t2-$t1;
3461# }
3462
3463 $startup_done->();
3464
3465 video_init;
3466 audio_init;
3467}
3468
3469show_tip_of_the_day if $CFG->{show_tips};
3470
3471Event::loop;
3472#CFPlus::SDL_Quit;
3473#CFPlus::_exit 0;
3474
3475END {
3476 CFPlus::SDL_Quit;
3477 CFPlus::DB::Server::stop;
3478}
3479
3480=head1 NAME
3481
3482cfplus - A Crossfire+ and Crossfire game client
3483
3484=head1 SYNOPSIS
3485
3486Just run it - no commandline arguments are supported.
3487
3488=head1 USAGE
3489
3490cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
3491fullscreen and interactively.
3492
3493=head1 DEBUGGING
3494
3495
3496CFPLUS_DEBUG - environment variable
3497
3498 1 draw borders around widgets
3499 2 add low-level widget info to tooltips
3500 4 show fps
3501 8 suppress tooltips
3502
3503=head1 AUTHOR
3504
3505Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
3506
3507
3508
3509 : $self->{vslider}->hide;
3510 }
3511}
3512
3513sub update {
3514 my ($self) = @_;
3515
3516 $self->SUPER::update;
3517 $self->update_slider;
3518} 1149}
3519 1150
3520sub invoke_mouse_wheel { 1151sub invoke_mouse_wheel {
3521 my ($self, $ev) = @_; 1152 my ($self, $ev) = @_;
3522 1153
3523 return 0 unless $ev->{dy}; # only vertical movements for now
3524
3525 $self->{vslider}->emit (mouse_wheel => $ev); 1154 $self->{vslider}->emit (mouse_wheel => $ev) if $self->{vslider_visible};
1155 $self->{hslider}->emit (mouse_wheel => $ev) if $self->{hslider_visible};
3526 1156
3527 1 1157 1
3528} 1158}
3529 1159
3530sub invoke_button_down { 1160sub invoke_button_down {
3531 my ($self, $ev, $x, $y) = @_; 1161 my ($self, $ev, $x, $y) = @_;
3532 1162
3533 if ($ev->{button} == 2) { 1163 if ($ev->{button} == 2) {
3534 $self->grab_focus; 1164 $self->start_dragging ($ev);
3535
3536 my $ox = $self->{vp}{view_x} + $ev->{x};
3537 my $oy = $self->{vp}{view_y} + $ev->{y};
3538
3539 $self->{motion} = sub {
3540 my ($ev, $x, $y) = @_;
3541
3542 $self->{vp}->set_offset ($ox - $ev->{x}, $oy - $ev->{y});
3543 $self->update;
3544 };
3545
3546 return 1; 1165 return 1;
3547 } 1166 }
3548 1167
3549 0 1168 0
3550} 1169}
… …
3577 $self->SUPER::invoke_size_allocate ($w, $h) 1196 $self->SUPER::invoke_size_allocate ($w, $h)
3578} 1197}
3579 1198
3580############################################################################# 1199#############################################################################
3581 1200
3582package CFPlus::UI::Frame; 1201package dc::UI::Frame;
3583 1202
3584our @ISA = CFPlus::UI::Bin::; 1203our @ISA = dc::UI::Bin::;
3585 1204
3586use CFPlus::OpenGL; 1205use dc::OpenGL;
3587 1206
3588sub new { 1207sub new {
3589 my $class = shift; 1208 my $class = shift;
3590 1209
3591 $class->SUPER::new ( 1210 $class->SUPER::new (
… …
3601 my ($w, $h) = @$self{qw(w h)}; 1220 my ($w, $h) = @$self{qw(w h)};
3602 1221
3603 glEnable GL_BLEND; 1222 glEnable GL_BLEND;
3604 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 1223 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
3605 glColor_premultiply @{ $self->{bg} }; 1224 glColor_premultiply @{ $self->{bg} };
3606
3607 glBegin GL_QUADS;
3608 glVertex 0 , 0;
3609 glVertex 0 , $h;
3610 glVertex $w, $h; 1225 glRect 0, 0, $w, $h;
3611 glVertex $w, 0;
3612 glEnd;
3613
3614 glDisable GL_BLEND; 1226 glDisable GL_BLEND;
3615 } 1227 }
3616 1228
3617 $self->SUPER::_draw; 1229 $self->SUPER::_draw;
3618} 1230}
3619 1231
3620############################################################################# 1232#############################################################################
3621 1233
3622package CFPlus::UI::FancyFrame; 1234package dc::UI::FancyFrame;
3623 1235
3624our @ISA = CFPlus::UI::Bin::; 1236our @ISA = dc::UI::Bin::;
3625 1237
3626use CFPlus::OpenGL; 1238use dc::OpenGL;
3627 1239
3628sub new { 1240sub new {
3629 my ($class, %arg) = @_; 1241 my ($class, %arg) = @_;
3630 1242
3631 if ((exists $arg{label}) && !ref $arg{label}) { 1243 if ((exists $arg{label}) && !ref $arg{label}) {
3632 $arg{label} = new CFPlus::UI::Label 1244 $arg{label} = new dc::UI::Label
3633 align => 1, 1245 align => 1,
3634 valign => 0, 1246 valign => 0,
3635 text => $arg{label}, 1247 text => $arg{label},
3636 fontsize => ($arg{border} || 0.8) * 0.75; 1248 fontsize => ($arg{border} || 0.8) * 0.75;
3637 } 1249 }
… …
3649 1261
3650sub add { 1262sub add {
3651 my ($self, @widgets) = @_; 1263 my ($self, @widgets) = @_;
3652 1264
3653 $self->SUPER::add (@widgets); 1265 $self->SUPER::add (@widgets);
3654 $self->CFPlus::UI::Container::add ($self->{label}) if $self->{label}; 1266 $self->dc::UI::Container::add ($self->{label}) if $self->{label};
3655} 1267}
3656 1268
3657sub border { 1269sub border {
3658 int $_[0]{border} * $::FONTSIZE 1270 int $_[0]{border} * $::FONTSIZE
3659} 1271}
… …
3717 } 1329 }
3718} 1330}
3719 1331
3720############################################################################# 1332#############################################################################
3721 1333
3722package CFPlus::UI::Toplevel; 1334package dc::UI::Toplevel;
3723 1335
3724our @ISA = CFPlus::UI::Bin::; 1336our @ISA = dc::UI::Bin::;
3725 1337
3726use CFPlus::OpenGL; 1338use dc::OpenGL;
3727 1339
3728my $bg = 1340my $bg =
3729 new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png", 1341 new_from_file dc::Texture dc::find_rcfile "d1_bg.png",
3730 mipmap => 1, wrap => 1; 1342 mipmap => 1, wrap => 1;
3731 1343
3732my @border = 1344my @border =
3733 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 1345 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
3734 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1346 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
3735 1347
3736my @icon = 1348my @icon =
3737 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 1349 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
3738 qw(x1_move.png x1_resize.png); 1350 qw(x1_move.png x1_resize.png);
3739 1351
3740sub new { 1352sub new {
3741 my ($class, %arg) = @_; 1353 my ($class, %arg) = @_;
3742 1354
… …
3748 min_w => 64, 1360 min_w => 64,
3749 min_h => 32, 1361 min_h => 32,
3750 %arg, 1362 %arg,
3751 ); 1363 );
3752 1364
3753 $self->{title_widget} = new CFPlus::UI::Label 1365 $self->{title_widget} = new dc::UI::Label
3754 align => 0, 1366 align => 0,
3755 valign => 1, 1367 valign => 1,
3756 text => $self->{title}, 1368 text => $self->{title},
3757 fontsize => $self->{border}, 1369 fontsize => $self->{border},
3758 if exists $self->{title}; 1370 if exists $self->{title};
3759 1371
3760 if ($self->{has_close_button}) { 1372 if ($self->{has_close_button}) {
3761 $self->{close_button} = 1373 $self->{close_button} =
3762 new CFPlus::UI::ImageButton 1374 new dc::UI::ImageButton
3763 path => 'x1_close.png', 1375 path => 'x1_close.png',
3764 on_activate => sub { $self->emit ("delete") }; 1376 on_activate => sub { $self->emit ("delete") };
3765 1377
3766 $self->CFPlus::UI::Container::add ($self->{close_button}); 1378 $self->dc::UI::Container::add ($self->{close_button});
3767 } 1379 }
3768 1380
3769 $self 1381 $self
3770} 1382}
3771 1383
3772sub add { 1384sub add {
3773 my ($self, @widgets) = @_; 1385 my ($self, @widgets) = @_;
3774 1386
3775 $self->SUPER::add (@widgets); 1387 $self->SUPER::add (@widgets);
3776 $self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button}; 1388 $self->dc::UI::Container::add ($self->{close_button}) if $self->{close_button};
3777 $self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget}; 1389 $self->dc::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
3778} 1390}
3779 1391
3780sub border { 1392sub border {
3781 int $_[0]{border} * $::FONTSIZE 1393 int $_[0]{border} * $::FONTSIZE
1394}
1395
1396sub get_max_wh {
1397 my ($self) = @_;
1398
1399 return ($self->{w}, $self->{h})
1400 if $self->{visible} && $self->{w};
1401
1402 $self->SUPER::get_max_wh
3782} 1403}
3783 1404
3784sub size_request { 1405sub size_request {
3785 my ($self) = @_; 1406 my ($self) = @_;
3786 1407
… …
3958 if $self->{close_button}; 1579 if $self->{close_button};
3959} 1580}
3960 1581
3961############################################################################# 1582#############################################################################
3962 1583
3963package CFPlus::UI::Table; 1584package dc::UI::Table;
3964 1585
3965our @ISA = CFPlus::UI::Base::; 1586our @ISA = dc::UI::Container::;
3966 1587
3967use List::Util qw(max sum); 1588use List::Util qw(max sum);
3968 1589
3969use CFPlus::OpenGL; 1590use dc::OpenGL;
3970 1591
3971sub new { 1592sub new {
3972 my $class = shift; 1593 my $class = shift;
3973 1594
3974 $class->SUPER::new ( 1595 $class->SUPER::new (
3975 children => [],
3976 col_expand => [], 1596 col_expand => [],
3977 row_expand => [], 1597 row_expand => [],
3978 @_, 1598 @_,
3979 ) 1599 )
3980} 1600}
3981 1601
3982sub children {
3983 grep $_, map @$_, grep $_, @{ $_[0]{children} }
3984}
3985
3986# TODO: store row/col info in child widget and use standard add/del
3987sub add { 1602sub add {
3988 my $self = shift; 1603 my ($self, @widgets) = @_;
3989 1604
3990 Carp::cluck "please use the add_at method instead of calling add, thank you.\n";#d# 1605 for my $child (@widgets) {
3991 $self->add_at (@_); 1606 $child->{c_rowspan} ||= 1;
1607 $child->{c_colspan} ||= 1;
1608 }
1609
1610 $self->SUPER::add (@widgets);
3992} 1611}
3993 1612
3994sub add_at { 1613sub add_at {
3995 my $self = shift; 1614 my $self = shift;
3996 1615
1616 my @widgets;
1617
3997 while (@_) { 1618 while (@_) {
3998 my ($col, $row, $child) = splice @_, 0, 3, (); 1619 my ($col, $row, $child) = splice @_, 0, 3, ();
3999 1620
4000 $child->set_parent ($self); 1621 $child->{c_row} = $row;
4001 $self->{children}[$row][$col] = $child; 1622 $child->{c_col} = $col;
4002 }
4003 1623
4004 $self->{force_realloc} = 1; 1624 push @widgets, $child;
4005 $self->{force_size_alloc} = 1; 1625 }
4006 $self->realloc;
4007}
4008 1626
4009sub remove { 1627 $self->add (@widgets);
1628}
1629
1630sub get_wh {
4010 my ($self, $child) = @_; 1631 my ($self) = @_;
4011 1632
4012 for (@{ $self->{children} }) { 1633 my (@w, @h);
4013 for (@{ $_ || [] }) { 1634
4014 $_ = undef if $_ == $child; 1635 my @children = $self->children;
1636
1637 # first pass, columns
1638 for my $widget (sort { $a->{c_colspan} <=> $b->{c_colspan} } @children) {
1639 my ($c, $w, $cs) = @$widget{qw(c_col req_w c_colspan)};
1640
1641 my $sw = sum @w[$c .. $c + $cs - 1];
1642
1643 if ($w > $sw) {
1644 $_ += ($w - $sw) / ($sw ? $sw / $_ : $cs) for @w[$c .. $c + $cs - 1];
4015 } 1645 }
4016 } 1646 }
4017}
4018 1647
4019# TODO: move to container class maybe? send children a signal on removal? 1648 # second pass, rows
4020sub clear { 1649 for my $widget (sort { $a->{c_rowspan} <=> $b->{c_rowspan} } @children) {
4021 my ($self) = @_;
4022
4023 my @children = $self->children;
4024 delete $self->{children};
4025
4026 for (@children) {
4027 delete $_->{parent};
4028 $_->hide;
4029 }
4030
4031 $self->realloc;
4032}
4033
4034sub get_wh {
4035 my ($self) = @_;
4036
4037 my (@w, @h);
4038
4039 for my $y (0 .. $#{$self->{children}}) {
4040 my $row = $self->{children}[$y]
4041 or next;
4042
4043 for my $x (0 .. $#$row) {
4044 my $widget = $row->[$x]
4045 or next;
4046 my ($w, $h) = @$widget{qw(req_w req_h)}; 1650 my ($r, $h, $rs) = @$widget{qw(c_row req_h c_rowspan)};
4047 1651
4048 $w[$x] = max $w[$x], $w; 1652 my $sh = sum @h[$r .. $r + $rs - 1];
4049 $h[$y] = max $h[$y], $h; 1653
1654 if ($h > $sh) {
1655 $_ += ($h - $sh) / ($sh ? $sh / $_ : $rs) for @h[$r .. $r + $rs - 1];
4050 } 1656 }
4051 } 1657 }
4052 1658
4053 (\@w, \@h) 1659 (\@w, \@h)
4054} 1660}
… …
4070 my ($ws, $hs) = $self->get_wh; 1676 my ($ws, $hs) = $self->get_wh;
4071 1677
4072 my $req_w = (sum @$ws) || 1; 1678 my $req_w = (sum @$ws) || 1;
4073 my $req_h = (sum @$hs) || 1; 1679 my $req_h = (sum @$hs) || 1;
4074 1680
4075 # TODO: nicer code 1681 # now linearly scale the rows/columns to the allocated size
4076 my @col_expand = @{$self->{col_expand}}; 1682 my @col_expand = @{$self->{col_expand}};
4077 @col_expand = (1) x @$ws unless @col_expand; 1683 @col_expand = (1) x @$ws unless @col_expand;
4078 my $col_expand = (sum @col_expand) || 1; 1684 my $col_expand = (sum @col_expand) || 1;
4079 1685
4080 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws; 1686 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
4081 1687
4082 CFPlus::UI::harmonize $ws; 1688 dc::UI::harmonize $ws;
4083 1689
4084 my @row_expand = @{$self->{row_expand}}; 1690 my @row_expand = @{$self->{row_expand}};
4085 @row_expand = (1) x @$ws unless @row_expand; 1691 @row_expand = (1) x @$ws unless @row_expand;
4086 my $row_expand = (sum @row_expand) || 1; 1692 my $row_expand = (sum @row_expand) || 1;
4087 1693
4088 $hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs; 1694 $hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs;
4089 1695
4090 CFPlus::UI::harmonize $hs; 1696 dc::UI::harmonize $hs;
4091 1697
4092 my $y; 1698 my @x; for (0 .. $#$ws) { $x[$_ + 1] = $x[$_] + $ws->[$_] }
1699 my @y; for (0 .. $#$hs) { $y[$_ + 1] = $y[$_] + $hs->[$_] }
4093 1700
4094 for my $r (0 .. $#{$self->{children}}) { 1701 for my $widget ($self->children) {
4095 my $row = $self->{children}[$r] 1702 my ($r, $c, $w, $h, $rs, $cs) = @$widget{qw(c_row c_col req_w req_h c_rowspan c_colspan)};
4096 or next;
4097 1703
4098 my $x = 0; 1704 $widget->configure (
4099 my $row_h = $hs->[$r]; 1705 $x[$c], $y[$r],
1706 $x[$c + $cs] - $x[$c], $y[$r + $rs] - $y[$r],
4100 1707 );
4101 for my $c (0 .. $#$row) {
4102 my $col_w = $ws->[$c];
4103
4104 if (my $widget = $row->[$c]) {
4105 $widget->configure ($x, $y, $col_w, $row_h);
4106 }
4107
4108 $x += $col_w;
4109 }
4110
4111 $y += $row_h;
4112 } 1708 }
4113 1709
4114 1 1710 1
4115} 1711}
4116 1712
4117sub find_widget {
4118 my ($self, $x, $y) = @_;
4119
4120 $x -= $self->{x};
4121 $y -= $self->{y};
4122
4123 my $res;
4124
4125 for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
4126 $res = $_->find_widget ($x, $y)
4127 and return $res;
4128 }
4129
4130 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
4131}
4132
4133sub _draw {
4134 my ($self) = @_;
4135
4136 for (grep $_, @{$self->{children}}) {
4137 $_->draw for grep $_, @$_;
4138 }
4139}
4140
4141############################################################################# 1713#############################################################################
4142 1714
4143package CFPlus::UI::Fixed; 1715package dc::UI::Fixed;
4144 1716
4145use List::Util qw(min max); 1717use List::Util qw(min max);
4146 1718
4147our @ISA = CFPlus::UI::Container::; 1719our @ISA = dc::UI::Container::;
4148
4149sub add {
4150 my ($self, $child, $posmode, $x, $y, $sizemode, $w, $h) = @_;
4151
4152 $child->{_fixed} = [$posmode, $x, $y, $sizemode, $w, $h];
4153 $self->SUPER::add ($child);
4154}
4155 1720
4156sub _scale($$$) { 1721sub _scale($$$) {
4157 my ($mode, $val, $max) = @_; 1722 my ($rel, $val, $max) = @_;
4158 1723
4159 $mode eq "abs" ? $val 1724 $rel ? $val * $max : $val
4160 : $mode eq "rel" ? $val * $max
4161 : 0
4162} 1725}
4163 1726
4164sub size_request { 1727sub size_request {
4165 my ($self) = @_; 1728 my ($self) = @_;
4166 1729
4167 my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0); 1730 my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0);
4168 1731
4169 # determine overall size by querying abs widgets 1732 # determine overall size by querying abs widgets
4170 for my $child ($self->visible_children) { 1733 for my $child ($self->visible_children) {
4171 my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} }; 1734 unless ($child->{c_rel}) {
1735 my $x = $child->{c_x};
1736 my $y = $child->{c_y};
4172 1737
4173 if ($pos eq "abs") {
4174 $w = _scale $size, $w, $child->{req_w};
4175 $h = _scale $size, $h, $child->{req_h};
4176
4177 $x1 = min $x1, $x; $x2 = max $x2, $x + $w; 1738 $x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
4178 $y1 = min $y1, $y; $y2 = max $y2, $y + $h; 1739 $y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
4179 } 1740 }
4180 } 1741 }
4181 1742
4182 my $W = $x2 - $x1; 1743 my $W = $x2 - $x1;
4183 my $H = $y2 - $y1; 1744 my $H = $y2 - $y1;
4184 1745
4185 # now layout remaining widgets 1746 # now layout remaining widgets
4186 for my $child ($self->visible_children) { 1747 for my $child ($self->visible_children) {
4187 my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} }; 1748 if ($child->{c_rel}) {
1749 my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
1750 my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
4188 1751
4189 if ($pos ne "abs") {
4190 $x = _scale $pos, $x, $W;
4191 $y = _scale $pos, $x, $H;
4192 $w = _scale $size, $w, $child->{req_w};
4193 $h = _scale $size, $h, $child->{req_h};
4194
4195 $x1 = min $x1, $x; $x2 = max $x2, $x + $w; 1752 $x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
4196 $y1 = min $y1, $y; $y2 = max $y2, $y + $h; 1753 $y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
4197 } 1754 }
4198 } 1755 }
4199 1756
4200 my $W = $x2 - $x1; 1757 my $W = $x2 - $x1;
4201 my $H = $y2 - $y1; 1758 my $H = $y2 - $y1;
… …
4205 1762
4206sub invoke_size_allocate { 1763sub invoke_size_allocate {
4207 my ($self, $W, $H) = @_; 1764 my ($self, $W, $H) = @_;
4208 1765
4209 for my $child ($self->visible_children) { 1766 for my $child ($self->visible_children) {
4210 my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} }; 1767 my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
1768 my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
4211 1769
4212 $x = _scale $pos, $x, $W; 1770 $x += $child->{c_halign} * $child->{req_w};
4213 $y = _scale $pos, $x, $H; 1771 $y += $child->{c_valign} * $child->{req_h};
4214 $w = _scale $size, $w, $child->{req_w};
4215 $h = _scale $size, $h, $child->{req_h};
4216 1772
4217 $child->configure ($x, $y, $w, $h); 1773 $child->configure (int $x, int $y, $child->{req_w}, $child->{req_h});
4218 } 1774 }
4219 1775
4220 1 1776 1
4221} 1777}
4222 1778
4223############################################################################# 1779#############################################################################
4224 1780
4225package CFPlus::UI::Box; 1781package dc::UI::Box;
4226 1782
4227our @ISA = CFPlus::UI::Container::; 1783our @ISA = dc::UI::Container::;
4228 1784
4229sub size_request { 1785sub size_request {
4230 my ($self) = @_; 1786 my ($self) = @_;
1787
1788 my @children = $self->visible_children;
4231 1789
4232 $self->{vertical} 1790 $self->{vertical}
4233 ? ( 1791 ? (
4234 (List::Util::max map $_->{req_w}, @{$self->{children}}), 1792 (List::Util::max map $_->{req_w}, @children),
4235 (List::Util::sum map $_->{req_h}, @{$self->{children}}), 1793 (List::Util::sum map $_->{req_h}, @children),
4236 ) 1794 )
4237 : ( 1795 : (
4238 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1796 (List::Util::sum map $_->{req_w}, @children),
4239 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1797 (List::Util::max map $_->{req_h}, @children),
4240 ) 1798 )
4241} 1799}
4242 1800
4243sub invoke_size_allocate { 1801sub invoke_size_allocate {
4244 my ($self, $w, $h) = @_; 1802 my ($self, $w, $h) = @_;
… …
4265 $req[$_] += $space * $children[$_]{expand} 1823 $req[$_] += $space * $children[$_]{expand}
4266 for 0 .. $#children; 1824 for 0 .. $#children;
4267 } 1825 }
4268 } 1826 }
4269 1827
4270 CFPlus::UI::harmonize \@req; 1828 dc::UI::harmonize \@req;
4271 1829
4272 my $pos = 0; 1830 my $pos = 0;
4273 for (0 .. $#children) { 1831 for (0 .. $#children) {
4274 my $alloc = $req[$_]; 1832 my $alloc = $req[$_];
4275 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1833 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
… …
4280 1 1838 1
4281} 1839}
4282 1840
4283############################################################################# 1841#############################################################################
4284 1842
4285package CFPlus::UI::HBox; 1843package dc::UI::HBox;
4286 1844
4287our @ISA = CFPlus::UI::Box::; 1845our @ISA = dc::UI::Box::;
4288 1846
4289sub new { 1847sub new {
4290 my $class = shift; 1848 my $class = shift;
4291 1849
4292 $class->SUPER::new ( 1850 $class->SUPER::new (
… …
4295 ) 1853 )
4296} 1854}
4297 1855
4298############################################################################# 1856#############################################################################
4299 1857
4300package CFPlus::UI::VBox; 1858package dc::UI::VBox;
4301 1859
4302our @ISA = CFPlus::UI::Box::; 1860our @ISA = dc::UI::Box::;
4303 1861
4304sub new { 1862sub new {
4305 my $class = shift; 1863 my $class = shift;
4306 1864
4307 $class->SUPER::new ( 1865 $class->SUPER::new (
… …
4310 ) 1868 )
4311} 1869}
4312 1870
4313############################################################################# 1871#############################################################################
4314 1872
4315package CFPlus::UI::Label; 1873package dc::UI::Label;
4316 1874
4317our @ISA = CFPlus::UI::DrawBG::; 1875our @ISA = dc::UI::DrawBG::;
4318 1876
4319use CFPlus::OpenGL; 1877use dc::OpenGL;
4320 1878
4321sub new { 1879sub new {
4322 my ($class, %arg) = @_; 1880 my ($class, %arg) = @_;
4323 1881
4324 my $self = $class->SUPER::new ( 1882 my $self = $class->SUPER::new (
… …
4329 #text => initial text 1887 #text => initial text
4330 #markup => initial narkup 1888 #markup => initial narkup
4331 #max_w => maximum pixel width 1889 #max_w => maximum pixel width
4332 #style => 0, # render flags 1890 #style => 0, # render flags
4333 ellipsise => 3, # end 1891 ellipsise => 3, # end
4334 layout => (new CFPlus::Layout), 1892 layout => (new dc::Layout),
4335 fontsize => 1, 1893 fontsize => 1,
4336 align => -1, 1894 align => -1,
4337 valign => -1, 1895 valign => -1,
4338 padding_x => 2, 1896 padding_x => 2,
4339 padding_y => 2, 1897 padding_y => 2,
4340 can_events => 0, 1898 can_events => 0,
4341 %arg 1899 %arg
4342 ); 1900 );
4343 1901
4344 if (exists $self->{template}) { 1902 if (exists $self->{template}) {
4345 my $layout = new CFPlus::Layout; 1903 my $layout = new dc::Layout;
4346 $layout->set_text (delete $self->{template}); 1904 $layout->set_text (delete $self->{template});
4347 $self->{template} = $layout; 1905 $self->{template} = $layout;
4348 } 1906 }
4349 1907
4350 if (exists $self->{markup}) { 1908 if (exists $self->{markup}) {
… …
4368 1926
4369 delete $self->{ox}; 1927 delete $self->{ox};
4370 $self->SUPER::realloc; 1928 $self->SUPER::realloc;
4371} 1929}
4372 1930
1931sub clear {
1932 my ($self) = @_;
1933
1934 $self->set_text ("");
1935}
1936
4373sub set_text { 1937sub set_text {
4374 my ($self, $text) = @_; 1938 my ($self, $text) = @_;
4375 1939
4376 return if $self->{text} eq "T$text"; 1940 return if $self->{text} eq "T$text";
4377 $self->{text} = "T$text"; 1941 $self->{text} = "T$text";
… …
4400 1964
4401sub size_request { 1965sub size_request {
4402 my ($self) = @_; 1966 my ($self) = @_;
4403 1967
4404 $self->{size_req} ||= do { 1968 $self->{size_req} ||= do {
1969 my ($max_w, $max_h) = $self->get_max_wh;
1970
4405 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1971 $self->{layout}->set_font ($self->{font}) if $self->{font};
4406 $self->{layout}->set_width ($self->{max_w} || -1); 1972 $self->{layout}->set_width ($self->{max_w} || $max_w || -1);
4407 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1973 $self->{layout}->set_ellipsise ($self->{ellipsise});
4408 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1974 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
4409 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1975 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
4410 1976
4411 my ($w, $h) = $self->{layout}->size; 1977 my ($w, $h) = $self->{layout}->size;
… …
4483 : ($self->{w} - $size->[0]) * 0.5); 2049 : ($self->{w} - $size->[0]) * 0.5);
4484 2050
4485 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 2051 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
4486 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y} 2052 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
4487 : ($self->{h} - $size->[1]) * 0.5); 2053 : ($self->{h} - $size->[1]) * 0.5);
2054
2055 $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
4488 }; 2056 };
4489 2057
4490 my $w = List::Util::min $self->{w} + 4, $size->[0]; 2058# unless ($self->{list}) {
4491 my $h = List::Util::min $self->{h} + 2, $size->[1]; 2059# $self->{list} = dc::OpenGL::glGenList;
4492 2060# dc::OpenGL::glNewList $self->{list};
4493 $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style}); 2061# $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
2062# dc::OpenGL::glEndList;
2063# }
2064#
2065# dc::OpenGL::glCallList $self->{list};
2066
2067 $self->{layout}->draw;
4494} 2068}
2069
2070#sub destroy {
2071# my ($self) = @_;
2072#
2073# dc::OpenGL::glDeleteList delete $self->{list} if $self->{list};
2074#
2075# $self->SUPER::destroy;
2076#}
4495 2077
4496############################################################################# 2078#############################################################################
4497 2079
4498package CFPlus::UI::EntryBase; 2080package dc::UI::EntryBase;
4499 2081
4500our @ISA = CFPlus::UI::Label::; 2082our @ISA = dc::UI::Label::;
4501 2083
4502use CFPlus::OpenGL; 2084use dc::OpenGL;
4503 2085
4504sub new { 2086sub new {
4505 my $class = shift; 2087 my $class = shift;
4506 2088
4507 $class->SUPER::new ( 2089 $class->SUPER::new (
4508 fg => [1, 1, 1], 2090 fg => [1, 1, 1],
4509 bg => [0, 0, 0, 0.2], 2091 bg => [0, 0, 0, 0.2],
2092 outline => [0.6, 0.3, 0.1],
4510 active_bg => [1, 1, 1, 0.5], 2093 active_bg => [0, 0, 1, .2],
4511 active_fg => [0, 0, 0], 2094 active_fg => [1, 1, 1],
2095 active_outline => [1, 1, 0],
4512 can_hover => 1, 2096 can_hover => 1,
4513 can_focus => 1, 2097 can_focus => 1,
4514 valign => 0, 2098 valign => 0,
4515 can_events => 1, 2099 can_events => 1,
4516 ellipsise => 0, 2100 ellipsise => 0,
… …
4572 2156
4573 if ($uni == 8) { 2157 if ($uni == 8) {
4574 substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; 2158 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
4575 } elsif ($uni == 127) { 2159 } elsif ($uni == 127) {
4576 substr $text, $self->{cursor}, 1, ""; 2160 substr $text, $self->{cursor}, 1, "";
4577 } elsif ($sym == CFPlus::SDLK_LEFT) { 2161 } elsif ($sym == dc::SDLK_LEFT) {
4578 --$self->{cursor} if $self->{cursor}; 2162 --$self->{cursor} if $self->{cursor};
4579 } elsif ($sym == CFPlus::SDLK_RIGHT) { 2163 } elsif ($sym == dc::SDLK_RIGHT) {
4580 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 2164 ++$self->{cursor} if $self->{cursor} < length $self->{text};
4581 } elsif ($sym == CFPlus::SDLK_HOME) { 2165 } elsif ($sym == dc::SDLK_HOME) {
4582 # what a hack 2166 # what a hack
4583 $self->{cursor} = 2167 $self->{cursor} =
4584 (substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/ 2168 (substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
4585 ? length $1 2169 ? length $1
4586 : 0; 2170 : 0;
4587 } elsif ($sym == CFPlus::SDLK_END) { 2171 } elsif ($sym == dc::SDLK_END) {
4588 # uh, again 2172 # uh, again
4589 $self->{cursor} = 2173 $self->{cursor} =
4590 (substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/ 2174 (substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
4591 ? $self->{cursor} + length $1 2175 ? $self->{cursor} + length $1
4592 : length $self->{text}; 2176 : length $self->{text};
… …
4656 glColor_premultiply @{$self->{bg}}; 2240 glColor_premultiply @{$self->{bg}};
4657 } 2241 }
4658 2242
4659 glEnable GL_BLEND; 2243 glEnable GL_BLEND;
4660 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2244 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
4661 glBegin GL_QUADS;
4662 glVertex 0 , 0;
4663 glVertex 0 , $self->{h};
4664 glVertex $self->{w}, $self->{h}; 2245 glRect 0, 0, $self->{w}, $self->{h};
4665 glVertex $self->{w}, 0;
4666 glEnd;
4667 glDisable GL_BLEND; 2246 glDisable GL_BLEND;
4668 2247
4669 $self->SUPER::_draw; 2248 $self->SUPER::_draw;
4670 2249
4671 #TODO: force update every cursor change :( 2250 #TODO: force update every cursor change :(
… …
4673 2252
4674 unless (exists $self->{cur_h}) { 2253 unless (exists $self->{cur_h}) {
4675 my $text = substr $self->{text}, 0, $self->{cursor}; 2254 my $text = substr $self->{text}, 0, $self->{cursor};
4676 utf8::encode $text; 2255 utf8::encode $text;
4677 2256
4678 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text) 2257 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
4679 } 2258 }
4680 2259
2260 glColor_premultiply @{$self->{active_fg}};
4681 glBegin GL_LINES; 2261 glBegin GL_LINES;
4682 glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy}; 2262 glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy};
4683 glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h}; 2263 glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy} + $self->{cur_h};
4684 glEnd; 2264 glEnd;
2265
2266 glLineWidth 3;
2267 glColor @{$self->{active_outline}};
2268 glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
2269 glLineWidth 1;
2270
2271 } else {
2272 glColor @{$self->{outline}};
2273 glBegin GL_LINE_STRIP;
2274 glVertex .5, $self->{h} * .5;
2275 glVertex .5, $self->{h} - 2.5;
2276 glVertex $self->{w} - .5, $self->{h} - 2.5;
2277 glVertex $self->{w} - .5, $self->{h} * .5;
2278 glEnd;
4685 } 2279 }
4686} 2280}
4687 2281
4688############################################################################# 2282#############################################################################
4689 2283
4690package CFPlus::UI::Entry; 2284package dc::UI::Entry;
4691 2285
4692our @ISA = CFPlus::UI::EntryBase::; 2286our @ISA = dc::UI::EntryBase::;
4693 2287
4694use CFPlus::OpenGL; 2288use dc::OpenGL;
4695 2289
4696sub invoke_key_down { 2290sub invoke_key_down {
4697 my ($self, $ev) = @_; 2291 my ($self, $ev) = @_;
4698 2292
4699 my $sym = $ev->{sym}; 2293 my $sym = $ev->{sym};
… …
4705 $self->{history_pointer} = -1; 2299 $self->{history_pointer} = -1;
4706 $self->{history_saveback} = ''; 2300 $self->{history_saveback} = '';
4707 $self->emit (activate => $txt); 2301 $self->emit (activate => $txt);
4708 $self->update; 2302 $self->update;
4709 2303
4710 } elsif ($sym == CFPlus::SDLK_UP) { 2304 } elsif ($sym == dc::SDLK_UP) {
4711 if ($self->{history_pointer} < 0) { 2305 if ($self->{history_pointer} < 0) {
4712 $self->{history_saveback} = $self->get_text; 2306 $self->{history_saveback} = $self->get_text;
4713 } 2307 }
4714 if (@{$self->{history} || []} > 0) { 2308 if (@{$self->{history} || []} > 0) {
4715 $self->{history_pointer}++; 2309 $self->{history_pointer}++;
… …
4717 $self->{history_pointer} = @{$self->{history} || []} - 1; 2311 $self->{history_pointer} = @{$self->{history} || []} - 1;
4718 } 2312 }
4719 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2313 $self->set_text ($self->{history}->[$self->{history_pointer}]);
4720 } 2314 }
4721 2315
4722 } elsif ($sym == CFPlus::SDLK_DOWN) { 2316 } elsif ($sym == dc::SDLK_DOWN) {
4723 $self->{history_pointer}--; 2317 $self->{history_pointer}--;
4724 $self->{history_pointer} = -1 if $self->{history_pointer} < 0; 2318 $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
4725 2319
4726 if ($self->{history_pointer} >= 0) { 2320 if ($self->{history_pointer} >= 0) {
4727 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2321 $self->set_text ($self->{history}->[$self->{history_pointer}]);
… …
4736 1 2330 1
4737} 2331}
4738 2332
4739############################################################################# 2333#############################################################################
4740 2334
4741package CFPlus::UI::TextEdit; 2335package dc::UI::TextEdit;
4742 2336
4743our @ISA = CFPlus::UI::EntryBase::; 2337our @ISA = dc::UI::EntryBase::;
4744 2338
4745use CFPlus::OpenGL; 2339use dc::OpenGL;
4746 2340
4747sub move_cursor_ver { 2341sub move_cursor_ver {
4748 my ($self, $dy) = @_; 2342 my ($self, $dy) = @_;
4749 2343
4750 my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor}); 2344 my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
… …
4762sub invoke_key_down { 2356sub invoke_key_down {
4763 my ($self, $ev) = @_; 2357 my ($self, $ev) = @_;
4764 2358
4765 my $sym = $ev->{sym}; 2359 my $sym = $ev->{sym};
4766 2360
4767 if ($sym == CFPlus::SDLK_UP) { 2361 if ($sym == dc::SDLK_UP) {
4768 $self->move_cursor_ver (-1); 2362 $self->move_cursor_ver (-1);
4769 } elsif ($sym == CFPlus::SDLK_DOWN) { 2363 } elsif ($sym == dc::SDLK_DOWN) {
4770 $self->move_cursor_ver (+1); 2364 $self->move_cursor_ver (+1);
4771 } else { 2365 } else {
4772 return $self->SUPER::invoke_key_down ($ev) 2366 return $self->SUPER::invoke_key_down ($ev)
4773 } 2367 }
4774 2368
4775 1 2369 1
4776} 2370}
4777 2371
4778############################################################################# 2372#############################################################################
4779 2373
4780package CFPlus::UI::Button; 2374package dc::UI::ButtonBin;
4781 2375
4782our @ISA = CFPlus::UI::Label::; 2376our @ISA = dc::UI::Bin::;
4783 2377
4784use CFPlus::OpenGL; 2378use dc::OpenGL;
4785 2379
4786my @tex = 2380my @tex =
4787 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2381 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
2382 qw(b1_button_inactive.png b1_button_active.png);
2383
2384sub new {
2385 my $class = shift;
2386
2387 $class->SUPER::new (
2388 can_hover => 1,
2389 align => 0,
2390 valign => 0,
2391 can_events => 1,
2392 @_
2393 )
2394}
2395
2396sub invoke_button_up {
2397 my ($self, $ev, $x, $y) = @_;
2398
2399 $self->emit ("activate")
2400 if $x >= 0 && $x < $self->{w}
2401 && $y >= 0 && $y < $self->{h};
2402
2403 1
2404}
2405
2406sub _draw {
2407 my ($self) = @_;
2408
2409 glEnable GL_TEXTURE_2D;
2410 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2411 glColor 0, 0, 0, 1;
2412
2413 my $tex = $tex[$GRAB == $self];
2414 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2415
2416 glDisable GL_TEXTURE_2D;
2417
2418 $self->SUPER::_draw;
2419}
2420
2421#############################################################################
2422
2423package dc::UI::Button;
2424
2425our @ISA = dc::UI::Label::;
2426
2427use dc::OpenGL;
2428
2429my @tex =
2430 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
4788 qw(b1_button_inactive.png b1_button_active.png); 2431 qw(b1_button_inactive.png b1_button_active.png);
4789 2432
4790sub new { 2433sub new {
4791 my $class = shift; 2434 my $class = shift;
4792 2435
… …
4830 $self->SUPER::_draw; 2473 $self->SUPER::_draw;
4831} 2474}
4832 2475
4833############################################################################# 2476#############################################################################
4834 2477
4835package CFPlus::UI::CheckBox; 2478package dc::UI::CheckBox;
4836 2479
4837our @ISA = CFPlus::UI::DrawBG::; 2480our @ISA = dc::UI::DrawBG::;
4838 2481
4839my @tex = 2482my @tex =
4840 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2483 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
4841 qw(c1_checkbox_bg.png c1_checkbox_active.png); 2484 qw(c1_checkbox_bg.png c1_checkbox_active.png);
4842 2485
4843use CFPlus::OpenGL; 2486use dc::OpenGL;
4844 2487
4845sub new { 2488sub new {
4846 my $class = shift; 2489 my $class = shift;
4847 2490
4848 $class->SUPER::new ( 2491 $class->SUPER::new (
… …
4888sub _draw { 2531sub _draw {
4889 my ($self) = @_; 2532 my ($self) = @_;
4890 2533
4891 $self->SUPER::_draw; 2534 $self->SUPER::_draw;
4892 2535
4893 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0; 2536 glTranslate $self->{padding_x}, $self->{padding_y}, 0;
4894 2537
4895 my ($w, $h) = @$self{qw(w h)}; 2538 my ($w, $h) = @$self{qw(w h)};
4896 2539
4897 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2; 2540 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
4898 2541
… …
4905 glDisable GL_TEXTURE_2D; 2548 glDisable GL_TEXTURE_2D;
4906} 2549}
4907 2550
4908############################################################################# 2551#############################################################################
4909 2552
4910package CFPlus::UI::Image; 2553package dc::UI::Image;
4911 2554
4912our @ISA = CFPlus::UI::Base::; 2555our @ISA = dc::UI::Base::;
4913 2556
4914use CFPlus::OpenGL; 2557use dc::OpenGL;
4915 2558
4916our %texture_cache; 2559our %texture_cache;
4917 2560
4918sub new { 2561sub new {
4919 my $class = shift; 2562 my $class = shift;
4920 2563
4921 my $self = $class->SUPER::new ( 2564 my $self = $class->SUPER::new (
4922 can_events => 0, 2565 can_events => 0,
2566 scale => 1,
4923 @_, 2567 @_,
4924 ); 2568 );
4925 2569
4926 $self->{path} || $self->{tex} 2570 $self->{path} || $self->{tex}
4927 or Carp::croak "'path' or 'tex' attributes required"; 2571 or Carp::croak "'path' or 'tex' attributes required";
4928 2572
4929 $self->{tex} ||= $texture_cache{$self->{path}} ||= 2573 $self->{tex} ||= $texture_cache{$self->{path}} ||=
4930 new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1; 2574 new_from_file dc::Texture dc::find_rcfile $self->{path}, mipmap => 1;
4931 2575
4932 CFPlus::weaken $texture_cache{$self->{path}}; 2576 dc::weaken $texture_cache{$self->{path}};
4933 2577
4934 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; 2578 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
4935 2579
4936 $self 2580 $self
4937} 2581}
4938 2582
4939sub STORABLE_freeze { 2583sub STORABLE_freeze {
4940 my ($self, $cloning) = @_; 2584 my ($self, $cloning) = @_;
4941 2585
4942 $self->{path} 2586 $self->{path}
4943 or die "cannot serialise CFPlus::UI::Image on non-loadable images\n"; 2587 or die "cannot serialise dc::UI::Image on non-loadable images\n";
4944 2588
4945 $self->{path} 2589 $self->{path}
4946} 2590}
4947 2591
4948sub STORABLE_attach { 2592sub STORABLE_attach {
… …
4952} 2596}
4953 2597
4954sub size_request { 2598sub size_request {
4955 my ($self) = @_; 2599 my ($self) = @_;
4956 2600
4957 ($self->{tex}{w}, $self->{tex}{h}) 2601 (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
4958} 2602}
4959 2603
4960sub _draw { 2604sub _draw {
4961 my ($self) = @_; 2605 my ($self) = @_;
4962 2606
… …
4972 } 2616 }
4973 2617
4974 glEnable GL_TEXTURE_2D; 2618 glEnable GL_TEXTURE_2D;
4975 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2619 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
4976 2620
4977 $tex->draw_quad (0, 0, $w, $h); 2621 $tex->draw_quad_alpha (0, 0, $w, $h);
4978 2622
4979 glDisable GL_TEXTURE_2D; 2623 glDisable GL_TEXTURE_2D;
4980} 2624}
4981 2625
4982############################################################################# 2626#############################################################################
4983 2627
4984package CFPlus::UI::ImageButton; 2628package dc::UI::ImageButton;
4985 2629
4986our @ISA = CFPlus::UI::Image::; 2630our @ISA = dc::UI::Image::;
4987 2631
4988use CFPlus::OpenGL; 2632use dc::OpenGL;
4989 2633
4990my %textures; 2634my %textures;
4991 2635
4992sub new { 2636sub new {
4993 my $class = shift; 2637 my $class = shift;
… …
5003 can_events => 1, 2647 can_events => 1,
5004 @_ 2648 @_
5005 ); 2649 );
5006} 2650}
5007 2651
2652sub invoke_button_down {
2653 my ($self, $ev, $x, $y) = @_;
2654
2655 1
2656}
2657
5008sub invoke_button_up { 2658sub invoke_button_up {
5009 my ($self, $ev, $x, $y) = @_; 2659 my ($self, $ev, $x, $y) = @_;
5010 2660
5011 $self->emit ("activate") 2661 $self->emit ("activate")
5012 if $x >= 0 && $x < $self->{w} 2662 if $x >= 0 && $x < $self->{w}
… …
5015 1 2665 1
5016} 2666}
5017 2667
5018############################################################################# 2668#############################################################################
5019 2669
5020package CFPlus::UI::VGauge; 2670package dc::UI::VGauge;
5021 2671
5022our @ISA = CFPlus::UI::Base::; 2672our @ISA = dc::UI::Base::;
5023 2673
5024use List::Util qw(min max); 2674use List::Util qw(min max);
5025 2675
5026use CFPlus::OpenGL; 2676use dc::OpenGL;
5027 2677
5028my %tex = ( 2678my %tex = (
5029 food => [ 2679 food => [
5030 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2680 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
5031 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ 2681 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
5032 ], 2682 ],
5033 grace => [ 2683 grace => [
5034 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2684 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
5035 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ 2685 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
5036 ], 2686 ],
5037 hp => [ 2687 hp => [
5038 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2688 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
5039 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ 2689 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
5040 ], 2690 ],
5041 mana => [ 2691 mana => [
5042 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2692 map { new_from_file dc::Texture dc::find_rcfile $_, mipmap => 1 }
5043 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ 2693 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
5044 ], 2694 ],
5045); 2695);
5046 2696
5047# eg. VGauge->new (gauge => 'food'), default gauge: food 2697# eg. VGauge->new (gauge => 'food'), default gauge: food
… …
5150 glDisable GL_TEXTURE_2D; 2800 glDisable GL_TEXTURE_2D;
5151} 2801}
5152 2802
5153############################################################################# 2803#############################################################################
5154 2804
2805package dc::UI::Progress;
2806
2807our @ISA = dc::UI::Label::;
2808
2809use dc::OpenGL;
2810
2811sub new {
2812 my ($class, %arg) = @_;
2813
2814 my $self = $class->SUPER::new (
2815 fg => [1, 1, 1],
2816 bg => [0, 0, 1, 0.2],
2817 bar => [0.7, 0.5, 0.1, 0.8],
2818 outline => [0.4, 0.3, 0],
2819 fontsize => 0.9,
2820 valign => 0,
2821 align => 0,
2822 can_events => 1,
2823 ellipsise => 1,
2824 label => "%d%%",
2825 %arg,
2826 );
2827
2828 $self->set_value ($arg{value} || -1);
2829
2830 $self
2831}
2832
2833sub set_label {
2834 my ($self, $label) = @_;
2835
2836 return if $self->{label} eq $label;
2837 $self->{label} = $label;
2838
2839 $self->dc::UI::Progress::set_value (0 + delete $self->{value});
2840}
2841
2842sub set_value {
2843 my ($self, $value) = @_;
2844
2845 if ($self->{value} ne $value) {
2846 $self->{value} = $value;
2847
2848 if ($value < 0) {
2849 $self->set_text ("-");
2850 } else {
2851 $self->set_text (sprintf $self->{label}, $value * 100);
2852 }
2853
2854 $self->update;
2855 }
2856}
2857
2858sub _draw {
2859 my ($self) = @_;
2860
2861 glEnable GL_BLEND;
2862 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2863
2864 if ($self->{value} >= 0) {
2865 my $s = int 2 + ($self->{w} - 4) * $self->{value};
2866
2867 glColor_premultiply @{$self->{bar}};
2868 glRect 2, 2, $s, $self->{h} - 2;
2869 glColor_premultiply @{$self->{bg}};
2870 glRect $s, 2, $self->{w} - 2, $self->{h} - 2;
2871 }
2872
2873 glColor_premultiply @{$self->{outline}};
2874 glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
2875
2876 glDisable GL_BLEND;
2877
2878 {
2879 local $self->{bg}; # do not draw background
2880 $self->SUPER::_draw;
2881 }
2882}
2883
2884#############################################################################
2885
2886package dc::UI::ExperienceProgress;
2887
2888our @ISA = dc::UI::Progress::;
2889
2890sub new {
2891 my ($class, %arg) = @_;
2892
2893 my $self = $class->SUPER::new (
2894 tooltip => sub {
2895 my ($self) = @_;
2896
2897 sprintf "level %d\n%s points\n%s next level\n%s to go",
2898 $self->{lvl},
2899 ::formsep ($self->{exp}),
2900 ::formsep ($self->{nxt}),
2901 ::formsep ($self->{nxt} - $self->{exp}),
2902 },
2903 %arg
2904 );
2905
2906 $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) }
2907 if $::CONN;
2908
2909 $self
2910}
2911
2912sub DESTROY {
2913 my ($self) = @_;
2914
2915 delete $::CONN->{on_exp_update}{$self+0}
2916 if $::CONN;
2917
2918 $self->SUPER::DESTROY;
2919}
2920
2921sub set_value {
2922 my ($self, $lvl, $exp) = @_;
2923
2924 $self->{lvl} = $lvl;
2925 $self->{exp} = $exp;
2926
2927 my $v = -1;
2928
2929 if ($::CONN && (my $table = $::CONN->{exp_table})) {
2930 my $l0 = $table->[$lvl - 1];
2931 my $l1 = $table->[$lvl];
2932
2933 $self->{nxt} = $l1;
2934
2935 $v = ($exp - $l0) / ($l1 - $l0);
2936 }
2937
2938 $self->SUPER::set_value ($v);
2939}
2940
2941#############################################################################
2942
5155package CFPlus::UI::Gauge; 2943package dc::UI::Gauge;
5156 2944
5157our @ISA = CFPlus::UI::VBox::; 2945our @ISA = dc::UI::VBox::;
5158 2946
5159sub new { 2947sub new {
5160 my ($class, %arg) = @_; 2948 my ($class, %arg) = @_;
5161 2949
5162 my $self = $class->SUPER::new ( 2950 my $self = $class->SUPER::new (
… …
5164 can_hover => 1, 2952 can_hover => 1,
5165 can_events => 1, 2953 can_events => 1,
5166 %arg, 2954 %arg,
5167 ); 2955 );
5168 2956
5169 $self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999"); 2957 $self->add ($self->{value} = new dc::UI::Label valign => +1, align => 0, template => "999");
5170 $self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1); 2958 $self->add ($self->{gauge} = new dc::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
5171 $self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999"); 2959 $self->add ($self->{max} = new dc::UI::Label valign => -1, align => 0, template => "999");
5172 2960
5173 $self 2961 $self
5174} 2962}
5175 2963
5176sub set_fontsize { 2964sub set_fontsize {
… …
5197 $self->{value}->set_text ($val); 2985 $self->{value}->set_text ($val);
5198} 2986}
5199 2987
5200############################################################################# 2988#############################################################################
5201 2989
5202package CFPlus::UI::Slider; 2990package dc::UI::Slider;
5203 2991
5204use strict; 2992use strict;
5205 2993
5206use CFPlus::OpenGL; 2994use dc::OpenGL;
5207 2995
5208our @ISA = CFPlus::UI::DrawBG::; 2996our @ISA = dc::UI::DrawBG::;
5209 2997
5210my @tex = 2998my @tex =
5211 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ } 2999 map { new_from_file dc::Texture dc::find_rcfile $_ }
5212 qw(s1_slider.png s1_slider_bg.png); 3000 qw(s1_slider.png s1_slider_bg.png);
5213 3001
5214sub new { 3002sub new {
5215 my $class = shift; 3003 my $class = shift;
5216 3004
… …
5284 3072
5285 $self->SUPER::invoke_button_down ($ev, $x, $y); 3073 $self->SUPER::invoke_button_down ($ev, $x, $y);
5286 3074
5287 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 3075 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
5288 3076
5289 $self->invoke_mouse_motion ($ev, $x, $y) 3077 $self->invoke_mouse_motion ($ev, $x, $y);
3078
3079 1
5290} 3080}
5291 3081
5292sub invoke_mouse_motion { 3082sub invoke_mouse_motion {
5293 my ($self, $ev, $x, $y) = @_; 3083 my ($self, $ev, $x, $y) = @_;
5294 3084
… …
5310sub invoke_mouse_wheel { 3100sub invoke_mouse_wheel {
5311 my ($self, $ev) = @_; 3101 my ($self, $ev) = @_;
5312 3102
5313 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx}; 3103 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
5314 3104
5315 my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2; 3105 my $pagepart = $ev->{mod} & dc::KMOD_SHIFT ? 1 : 0.2;
5316 3106
5317 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart); 3107 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
5318 3108
5319 ! ! $delta 3109 1
5320} 3110}
5321 3111
5322sub update { 3112sub update {
5323 my ($self) = @_; 3113 my ($self) = @_;
5324 3114
… …
5373 glDisable GL_TEXTURE_2D; 3163 glDisable GL_TEXTURE_2D;
5374} 3164}
5375 3165
5376############################################################################# 3166#############################################################################
5377 3167
5378package CFPlus::UI::ValSlider; 3168package dc::UI::ValSlider;
5379 3169
5380our @ISA = CFPlus::UI::HBox::; 3170our @ISA = dc::UI::HBox::;
5381 3171
5382sub new { 3172sub new {
5383 my ($class, %arg) = @_; 3173 my ($class, %arg) = @_;
5384 3174
5385 my $range = delete $arg{range}; 3175 my $range = delete $arg{range};
5386 3176
5387 my $self = $class->SUPER::new ( 3177 my $self = $class->SUPER::new (
5388 slider => (new CFPlus::UI::Slider expand => 1, range => $range), 3178 slider => (new dc::UI::Slider expand => 1, range => $range),
5389 entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}), 3179 entry => (new dc::UI::Label text => "", template => delete $arg{template}),
5390 to_value => sub { shift }, 3180 to_value => sub { shift },
5391 from_value => sub { shift }, 3181 from_value => sub { shift },
5392 %arg, 3182 %arg,
5393 ); 3183 );
5394 3184
… …
5414sub set_range { shift->{slider}->set_range (@_) } 3204sub set_range { shift->{slider}->set_range (@_) }
5415sub set_value { shift->{slider}->set_value (@_) } 3205sub set_value { shift->{slider}->set_value (@_) }
5416 3206
5417############################################################################# 3207#############################################################################
5418 3208
5419package CFPlus::UI::TextScroller; 3209package dc::UI::TextScroller;
5420 3210
5421our @ISA = CFPlus::UI::HBox::; 3211our @ISA = dc::UI::HBox::;
5422 3212
5423use CFPlus::OpenGL; 3213use dc::OpenGL;
5424 3214
5425sub new { 3215sub new {
5426 my $class = shift; 3216 my $class = shift;
5427 3217
5428 my $self = $class->SUPER::new ( 3218 my $self = $class->SUPER::new (
… …
5430 can_events => 1, 3220 can_events => 1,
5431 indent => 0, 3221 indent => 0,
5432 #font => default_font 3222 #font => default_font
5433 @_, 3223 @_,
5434 3224
5435 layout => (new CFPlus::Layout), 3225 layout => (new dc::Layout),
5436 par => [], 3226 par => [],
5437 max_par => 0, 3227 max_par => 0,
5438 height => 0, 3228 height => 0,
5439 children => [ 3229 children => [
5440 (new CFPlus::UI::Empty expand => 1), 3230 (new dc::UI::Empty expand => 1),
5441 (new CFPlus::UI::Slider vertical => 1), 3231 (new dc::UI::Slider vertical => 1),
5442 ], 3232 ],
5443 ); 3233 );
5444 3234
5445 $self->{children}[1]->connect (changed => sub { $self->update }); 3235 $self->{children}[1]->connect (changed => sub { $self->update });
5446 3236
… …
5455} 3245}
5456 3246
5457sub size_request { 3247sub size_request {
5458 my ($self) = @_; 3248 my ($self) = @_;
5459 3249
5460 my ($empty, $slider) = @{ $self->{children} }; 3250 my ($empty, $slider) = $self->visible_children;
5461 3251
5462 local $self->{children} = [$empty, $slider]; 3252 local $self->{children} = [$empty, $slider];
5463 $self->SUPER::size_request 3253 $self->SUPER::size_request
5464} 3254}
5465 3255
… …
5629 $ROOT->on_post_alloc ($self => sub { 3419 $ROOT->on_post_alloc ($self => sub {
5630 $self->force_uptodate; 3420 $self->force_uptodate;
5631 3421
5632 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 3422 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
5633 3423
5634 $self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub { 3424 $self->{texture} ||= new_from_opengl dc::Texture $W, $H, sub {
5635 glClearColor 0, 0, 0, 0; 3425 glClearColor 0, 0, 0, 0;
5636 glClear GL_COLOR_BUFFER_BIT; 3426 glClear GL_COLOR_BUFFER_BIT;
5637 3427
5638 package CFPlus::UI::Base; 3428 package dc::UI::Base;
5639 local ($draw_x, $draw_y, $draw_w, $draw_h) = 3429 local ($draw_x, $draw_y, $draw_w, $draw_h) =
5640 (0, 0, $self->{w}, $self->{h}); 3430 (0, 0, $self->{w}, $self->{h});
5641 3431
5642 my $top = int $self->{children}[1]{range}[0]; 3432 my $top = int $self->{children}[1]{range}[0];
5643 3433
… …
5654 3444
5655 if ($y0 < $y + $h && $y < $y1) { 3445 if ($y0 < $y + $h && $y < $y1) {
5656 my $layout = $self->get_layout ($para); 3446 my $layout = $self->get_layout ($para);
5657 3447
5658 $layout->render ($para->{indent}, $y - $y0); 3448 $layout->render ($para->{indent}, $y - $y0);
3449 $layout->draw;
5659 3450
5660 if (my @w = @{ $para->{widget} }) { 3451 if (my @w = @{ $para->{widget} }) {
5661 my @s = $layout->get_shapes; 3452 my @s = $layout->get_shapes;
5662 3453
5663 for (@w) { 3454 for (@w) {
… …
5701 $self->{children}[1]->draw; 3492 $self->{children}[1]->draw;
5702} 3493}
5703 3494
5704############################################################################# 3495#############################################################################
5705 3496
5706package CFPlus::UI::Animator; 3497package dc::UI::Animator;
5707 3498
5708use CFPlus::OpenGL; 3499use dc::OpenGL;
5709 3500
5710our @ISA = CFPlus::UI::Bin::; 3501our @ISA = dc::UI::Bin::;
5711 3502
5712sub moveto { 3503sub moveto {
5713 my ($self, $x, $y) = @_; 3504 my ($self, $x, $y) = @_;
5714 3505
5715 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 3506 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
… …
5743 glPopMatrix; 3534 glPopMatrix;
5744} 3535}
5745 3536
5746############################################################################# 3537#############################################################################
5747 3538
5748package CFPlus::UI::Flopper; 3539package dc::UI::Flopper;
5749 3540
5750our @ISA = CFPlus::UI::Button::; 3541our @ISA = dc::UI::Button::;
5751 3542
5752sub new { 3543sub new {
5753 my $class = shift; 3544 my $class = shift;
5754 3545
5755 my $self = $class->SUPER::new ( 3546 my $self = $class->SUPER::new (
… …
5767 $self->{other}->toggle_visibility; 3558 $self->{other}->toggle_visibility;
5768} 3559}
5769 3560
5770############################################################################# 3561#############################################################################
5771 3562
5772package CFPlus::UI::Tooltip; 3563package dc::UI::Tooltip;
5773 3564
5774our @ISA = CFPlus::UI::Bin::; 3565our @ISA = dc::UI::Bin::;
5775 3566
5776use CFPlus::OpenGL; 3567use dc::OpenGL;
5777 3568
5778sub new { 3569sub new {
5779 my $class = shift; 3570 my $class = shift;
5780 3571
5781 $class->SUPER::new ( 3572 $class->SUPER::new (
… …
5785} 3576}
5786 3577
5787sub set_tooltip_from { 3578sub set_tooltip_from {
5788 my ($self, $widget) = @_; 3579 my ($self, $widget) = @_;
5789 3580
5790 $widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
5791 if $widget->{tooltip} =~ /^#(.*)$/;
5792
5793 my $tooltip = $widget->{tooltip}; 3581 my $tip = $widget->{tooltip};
3582 $tip = $tip->($widget) if "CODE" eq ref $tip;
3583
3584 $tip = dc::Pod::section_label tooltip => $1
3585 if $tip =~ /^#(.*)$/;
5794 3586
5795 if ($ENV{CFPLUS_DEBUG} & 2) { 3587 if ($ENV{CFPLUS_DEBUG} & 2) {
5796 $tooltip .= "\n\n" . (ref $widget) . "\n" 3588 $tip .= "\n\n" . (ref $widget) . "\n"
5797 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" 3589 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
5798 . "req $widget->{req_w} $widget->{req_h}\n" 3590 . "req $widget->{req_w} $widget->{req_h}\n"
5799 . "visible $widget->{visible}"; 3591 . "visible $widget->{visible}";
5800 } 3592 }
5801 3593
5802 $tooltip =~ s/^\n+//; 3594 $tip =~ s/^\n+//;
5803 $tooltip =~ s/\n+$//; 3595 $tip =~ s/\n+$//;
5804 3596
5805 $self->add (new CFPlus::UI::Label 3597 $self->add (new dc::UI::Label
5806 markup => $tooltip, 3598 markup => $tip,
5807 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3599 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
5808 fontsize => 0.8, 3600 fontsize => 0.8,
5809 style => 1, # FLAG_INVERSE 3601 style => 1, # FLAG_INVERSE
5810 ellipsise => 0, 3602 ellipsise => 0,
5811 font => ($widget->{tooltip_font} || $::FONT_PROP), 3603 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
5849} 3641}
5850 3642
5851sub _draw { 3643sub _draw {
5852 my ($self) = @_; 3644 my ($self) = @_;
5853 3645
5854 glTranslate 0.375, 0.375;
5855
5856 my ($w, $h) = @$self{qw(w h)}; 3646 my ($w, $h) = @$self{qw(w h)};
5857 3647
5858 glColor 1, 0.8, 0.4; 3648 glColor 1, 0.8, 0.4;
5859 glBegin GL_QUADS; 3649 glRect 0, 0, $w, $h;
5860 glVertex 0 , 0;
5861 glVertex 0 , $h;
5862 glVertex $w, $h;
5863 glVertex $w, 0;
5864 glEnd;
5865 3650
5866 glColor 0, 0, 0; 3651 glColor 0, 0, 0;
5867 glBegin GL_LINE_LOOP; 3652 glRect_lineloop .5, .5, $w + .5, $h + .5;
5868 glVertex 0 , 0;
5869 glVertex 0 , $h;
5870 glVertex $w, $h;
5871 glVertex $w, 0;
5872 glEnd;
5873 3653
5874 glTranslate 2 - 0.375, 2 - 0.375; 3654 glTranslate 2, 2;
5875 3655
5876 $self->SUPER::_draw; 3656 $self->SUPER::_draw;
5877} 3657}
5878 3658
5879############################################################################# 3659#############################################################################
5880 3660
5881package CFPlus::UI::Face; 3661package dc::UI::Face;
5882 3662
5883our @ISA = CFPlus::UI::DrawBG::; 3663our @ISA = dc::UI::DrawBG::;
5884 3664
5885use CFPlus::OpenGL; 3665use dc::OpenGL;
5886 3666
5887sub new { 3667sub new {
5888 my $class = shift; 3668 my $class = shift;
5889 3669
5890 my $self = $class->SUPER::new ( 3670 my $self = $class->SUPER::new (
… …
5894 can_events => 0, 3674 can_events => 0,
5895 @_, 3675 @_,
5896 ); 3676 );
5897 3677
5898 if ($self->{anim} && $self->{animspeed}) { 3678 if ($self->{anim} && $self->{animspeed}) {
5899 CFPlus::weaken (my $widget = $self); 3679 dc::weaken (my $widget = $self);
5900 3680
5901 $widget->{animspeed} = List::Util::max 0.05, $widget->{animspeed}; 3681 $self->{animspeed} = List::Util::max 0.05, $self->{animspeed};
5902 $widget->{anim_start} = $self->{animspeed} * Event::time / $self->{animspeed}; 3682 $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub {
5903 $self->{timer} = Event->timer (
5904 parked => 1,
5905 cb => sub {
5906 return unless $::CONN && $widget; 3683 return unless $::CONN;
5907 3684
3685 my $w = $widget
3686 or return;
3687
5908 ++$widget->{frame}; 3688 ++$w->{frame};
5909 $widget->update_face; 3689 $w->update_face;
3690
3691 # somehow, $widget can go away
5910 $widget->update; 3692 $w->update;
5911
5912 $widget->update_timer; 3693 $w->update_timer;
5913 },
5914 ); 3694 };
5915 3695
5916 $self->update_face; 3696 $self->update_face;
5917 $self->update_timer; 3697 $self->update_timer;
5918 } 3698 }
5919 3699
… …
5924 my ($self) = @_; 3704 my ($self) = @_;
5925 3705
5926 return unless $self->{timer}; 3706 return unless $self->{timer};
5927 3707
5928 if ($self->{visible}) { 3708 if ($self->{visible}) {
5929 $self->{timer}->at (
5930 $self->{anim_start}
5931 + $self->{animspeed}
5932 * int 1.5 + (Event::time - $self->{anim_start}) / $self->{animspeed}
5933 );
5934 $self->{timer}->start; 3709 $self->{timer}->start;
5935 } else { 3710 } else {
5936 $self->{timer}->stop; 3711 $self->{timer}->stop;
5937 } 3712 }
5938} 3713}
5939 3714
5940sub update_face { 3715sub update_face {
5941 my ($self) = @_; 3716 my ($self) = @_;
5942 3717
5943 return unless $::CONN;
5944
5945 if (my $anim = $::CONN->{anim}[$self->{anim}]) {
5946 if ($anim && @$anim) {
5947 delete $self->{wait_face};
5948 $self->{face} = $anim->[ $self->{frame} % @$anim ];
5949 }
5950 }
5951}
5952
5953sub size_request {
5954 my ($self) = @_;
5955
5956 if ($::CONN) { 3718 if ($::CONN) {
5957 if (my $faceid = $::CONN->{faceid}[$self->{face}]) { 3719 if (my $anim = $::CONN->{anim}[$self->{anim}]) {
5958 if (my $tex = $::CONN->{texture}[$faceid]) { 3720 if ($anim && @$anim) {
5959 return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h}); 3721 $self->{face} = $anim->[ $self->{frame} % @$anim ];
5960 } else { 3722 delete $self->{face_change_cb};
5961 $self->{wait_face} ||= $::CONN->connect_face_update ($faceid, sub { 3723
5962 $self->realloc; 3724 if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{face}[$self->{face}]{id} ]) {
3725 unless ($tex->{name} || $tex->{loading}) {
3726 $tex->upload (sub { $self->reconfigure });
3727 }
5963 }); 3728 }
5964 } 3729 }
5965 } 3730 }
5966 } 3731 }
3732}
3733
3734sub size_request {
3735 my ($self) = @_;
3736
3737 if ($::CONN) {
3738 if (my $faceid = $::CONN->{face}[$self->{face}]{id}) {
3739 if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
3740 if ($tex->{name}) {
3741 return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
3742 } elsif (!$tex->{loading}) {
3743 $tex->upload (sub { $self->reconfigure });
3744 }
3745 }
3746
3747 $self->{face_change_cb} ||= $::CONN->on_face_change ($self->{face}, sub { $self->reconfigure });
3748 }
3749 }
5967 3750
5968 ($self->{size_w} || 8, $self->{size_h} || 8) 3751 ($self->{size_w} || 8, $self->{size_h} || 8)
5969} 3752}
5970 3753
5971sub update { 3754sub update {
… …
5985} 3768}
5986 3769
5987sub _draw { 3770sub _draw {
5988 my ($self) = @_; 3771 my ($self) = @_;
5989 3772
5990 return unless $::CONN;
5991
5992 $self->SUPER::_draw; 3773 $self->SUPER::_draw;
5993 3774
5994 my $faceid = $::CONN->{faceid}[$self->{face}] 3775 if (my $tex = $self->{tex}) {
5995 or return;
5996
5997 my $tex = $::CONN->{texture}[$faceid];
5998
5999 if ($tex) {
6000 glEnable GL_TEXTURE_2D; 3776 glEnable GL_TEXTURE_2D;
6001 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 3777 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
6002 glColor 0, 0, 0, 1; 3778 glColor 0, 0, 0, 1;
6003 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3779 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
6004 glDisable GL_TEXTURE_2D; 3780 glDisable GL_TEXTURE_2D;
… …
6014 $self->SUPER::destroy; 3790 $self->SUPER::destroy;
6015} 3791}
6016 3792
6017############################################################################# 3793#############################################################################
6018 3794
6019package CFPlus::UI::Buttonbar; 3795package dc::UI::Buttonbar;
6020 3796
6021our @ISA = CFPlus::UI::HBox::; 3797our @ISA = dc::UI::HBox::;
6022 3798
6023# TODO: should actually wrap buttons and other goodies. 3799# TODO: should actually wrap buttons and other goodies.
6024 3800
6025############################################################################# 3801#############################################################################
6026 3802
6027package CFPlus::UI::Menu; 3803package dc::UI::Menu;
6028 3804
6029our @ISA = CFPlus::UI::Toplevel::; 3805our @ISA = dc::UI::Toplevel::;
6030 3806
6031use CFPlus::OpenGL; 3807use dc::OpenGL;
6032 3808
6033sub new { 3809sub new {
6034 my $class = shift; 3810 my $class = shift;
6035 3811
6036 my $self = $class->SUPER::new ( 3812 my $self = $class->SUPER::new (
6037 items => [], 3813 items => [],
6038 z => 100, 3814 z => 100,
6039 @_, 3815 @_,
6040 ); 3816 );
6041 3817
6042 $self->add ($self->{vbox} = new CFPlus::UI::VBox); 3818 $self->add ($self->{vbox} = new dc::UI::VBox);
6043 3819
6044 for my $item (@{ $self->{items} }) { 3820 for my $item (@{ $self->{items} }) {
6045 my ($widget, $cb, $tooltip) = @$item; 3821 my ($widget, $cb, $tooltip) = @$item;
6046 3822
6047 # handle various types of items, only text for now 3823 # handle various types of items, only text for now
6048 if (!ref $widget) { 3824 if (!ref $widget) {
6049 if ($widget =~ /\t/) { 3825 if ($widget =~ /\t/) {
6050 my ($left, $right) = split /\t/, $widget, 2; 3826 my ($left, $right) = split /\t/, $widget, 2;
6051 3827
6052 $widget = new CFPlus::UI::HBox 3828 $widget = new dc::UI::HBox
6053 can_hover => 1, 3829 can_hover => 1,
6054 can_events => 1, 3830 can_events => 1,
6055 tooltip => $tooltip, 3831 tooltip => $tooltip,
6056 children => [ 3832 children => [
6057 (new CFPlus::UI::Label markup => $left, expand => 1), 3833 (new dc::UI::Label markup => $left, expand => 1),
6058 (new CFPlus::UI::Label markup => $right, align => +1), 3834 (new dc::UI::Label markup => $right, align => +1),
6059 ], 3835 ],
6060 ; 3836 ;
6061 3837
6062 } else { 3838 } else {
6063 $widget = new CFPlus::UI::Label 3839 $widget = new dc::UI::Label
6064 can_hover => 1, 3840 can_hover => 1,
6065 can_events => 1, 3841 can_events => 1,
6066 markup => $widget, 3842 markup => $widget,
6067 tooltip => $tooltip; 3843 tooltip => $tooltip;
6068 } 3844 }
… …
6116 1 3892 1
6117} 3893}
6118 3894
6119############################################################################# 3895#############################################################################
6120 3896
6121package CFPlus::UI::Multiplexer; 3897package dc::UI::Multiplexer;
6122 3898
6123our @ISA = CFPlus::UI::Container::; 3899our @ISA = dc::UI::Container::;
6124 3900
6125sub new { 3901sub new {
6126 my $class = shift; 3902 my $class = shift;
6127 3903
6128 my $self = $class->SUPER::new ( 3904 my $self = $class->SUPER::new (
… …
6189 $self->{current}->draw; 3965 $self->{current}->draw;
6190} 3966}
6191 3967
6192############################################################################# 3968#############################################################################
6193 3969
6194package CFPlus::UI::Notebook; 3970package dc::UI::Notebook;
6195 3971
3972use dc::OpenGL;
3973
6196our @ISA = CFPlus::UI::VBox::; 3974our @ISA = dc::UI::VBox::;
6197 3975
6198sub new { 3976sub new {
6199 my $class = shift; 3977 my $class = shift;
6200 3978
6201 my $self = $class->SUPER::new ( 3979 my $self = $class->SUPER::new (
6202 buttonbar => (new CFPlus::UI::Buttonbar), 3980 buttonbar => (new dc::UI::Buttonbar),
6203 multiplexer => (new CFPlus::UI::Multiplexer expand => 1), 3981 multiplexer => (new dc::UI::Multiplexer expand => 1),
3982 active_outline => [.7, .7, 0.2],
6204 # filter => # will be put between multiplexer and $self 3983 # filter => # will be put between multiplexer and $self
6205 @_, 3984 @_,
6206 ); 3985 );
6207 3986
6208 $self->{filter}->add ($self->{multiplexer}) if $self->{filter}; 3987 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
6209 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer}); 3988 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
6210 3989
3990 {
3991 Scalar::Util::weaken (my $wself = $self);
3992
3993 $self->{multiplexer}->connect (c_add => sub {
3994 my ($mplex, $widgets) = @_;
3995
3996 for my $child (@$widgets) {
3997 Scalar::Util::weaken $child;
3998 $child->{c_tab_} ||= do {
3999 my $tab =
4000 (UNIVERSAL::isa $child->{c_tab}, "dc::UI::Base")
4001 ? $child->{c_tab}
4002 : new dc::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
4003
4004 $tab->connect (activate => sub {
4005 $wself->set_current_page ($child);
4006 });
4007
4008 $tab
4009 };
4010
4011 $self->{buttonbar}->add ($child->{c_tab_});
4012 }
4013 });
4014
4015 $self->{multiplexer}->connect (c_remove => sub {
4016 my ($mplex, $widgets) = @_;
4017
4018 for my $child (@$widgets) {
4019 $wself->{buttonbar}->remove ($child->{c_tab_});
4020 }
4021 });
4022 }
4023
6211 $self 4024 $self
6212} 4025}
6213 4026
6214sub add { 4027sub add {
4028 my ($self, @widgets) = @_;
4029
4030 $self->{multiplexer}->add (@widgets)
4031}
4032
4033sub remove {
4034 my ($self, @widgets) = @_;
4035
4036 $self->{multiplexer}->remove (@widgets)
4037}
4038
4039sub pages {
4040 my ($self) = @_;
4041 $self->{multiplexer}->children
4042}
4043
4044sub add_tab {
6215 my ($self, $title, $widget, $tooltip) = @_; 4045 my ($self, $title, $widget, $tooltip) = @_;
6216 4046
6217 CFPlus::weaken $self; 4047 $title = [$title, $tooltip] unless ref $title;
4048 $widget->{c_tab} = $title;
6218 4049
6219 $self->{buttonbar}->add (new CFPlus::UI::Button
6220 markup => $title,
6221 tooltip => $tooltip,
6222 on_activate => sub { $self->set_current_page ($widget) },
6223 );
6224
6225 $self->{multiplexer}->add ($widget); 4050 $self->add ($widget);
6226} 4051}
6227 4052
6228sub get_current_page { 4053sub get_current_page {
6229 my ($self) = @_; 4054 my ($self) = @_;
6230 4055
… …
6236 4061
6237 $self->{multiplexer}->set_current_page ($page); 4062 $self->{multiplexer}->set_current_page ($page);
6238 $self->emit (page_changed => $self->{multiplexer}{current}); 4063 $self->emit (page_changed => $self->{multiplexer}{current});
6239} 4064}
6240 4065
4066sub _draw {
4067 my ($self) = @_;
4068
4069 $self->SUPER::_draw ();
4070
4071 if (my $cur = $self->{multiplexer}{current}) {
4072 if ($cur = $cur->{c_tab_}) {
4073 glTranslate $self->{buttonbar}{x} + $cur->{x},
4074 $self->{buttonbar}{y} + $cur->{y};
4075 glLineWidth 3;
4076 #glEnable GL_BLEND;
4077 #glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
4078 glColor @{$self->{active_outline}};
4079 glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
4080 glLineWidth 1;
4081 #glDisable GL_BLEND;
4082 }
4083 }
4084}
4085
6241############################################################################# 4086#############################################################################
6242 4087
6243package CFPlus::UI::Selector; 4088package dc::UI::Selector;
6244 4089
6245use utf8; 4090use utf8;
6246 4091
6247our @ISA = CFPlus::UI::Button::; 4092our @ISA = dc::UI::Button::;
6248 4093
6249sub new { 4094sub new {
6250 my $class = shift; 4095 my $class = shift;
6251 4096
6252 my $self = $class->SUPER::new ( 4097 my $self = $class->SUPER::new (
… …
6269 my ($value, $title, $tooltip) = @$_; 4114 my ($value, $title, $tooltip) = @$_;
6270 4115
6271 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }]; 4116 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
6272 } 4117 }
6273 4118
6274 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev); 4119 dc::UI::Menu->new (items => \@menu_items)->popup ($ev);
6275} 4120}
6276 4121
6277sub _set_value { 4122sub _set_value {
6278 my ($self, $value) = @_; 4123 my ($self, $value) = @_;
6279 4124
6280 my ($item) = grep $_->[0] eq $value, @{ $self->{options} } 4125 my ($item) = grep $_->[0] eq $value, @{ $self->{options} };
4126 $item ||= $self->{options}[0]
6281 or return; 4127 or return;
6282 4128
6283 $self->{value} = $item->[0]; 4129 $self->{value} = $item->[0];
6284 $self->set_markup ("$item->[1] ⇓"); 4130 $self->set_markup ("$item->[1] ⇓");
6285 $self->set_tooltip ($item->[2]); 4131# $self->set_tooltip ($item->[2]);
6286} 4132}
6287 4133
6288sub set_value { 4134sub set_value {
6289 my ($self, $value) = @_; 4135 my ($self, $value) = @_;
6290 4136
… …
6292 4138
6293 $self->_set_value ($value); 4139 $self->_set_value ($value);
6294 $self->emit (changed => $value); 4140 $self->emit (changed => $value);
6295} 4141}
6296 4142
4143sub set_options {
4144 my ($self, $options) = @_;
4145
4146 $self->{options} = $options;
4147 $self->_set_value ($self->{value});
4148}
4149
6297############################################################################# 4150#############################################################################
6298 4151
6299package CFPlus::UI::Statusbox; 4152package dc::UI::Statusbox;
6300 4153
6301our @ISA = CFPlus::UI::VBox::; 4154our @ISA = dc::UI::VBox::;
6302 4155
6303sub new { 4156sub new {
6304 my $class = shift; 4157 my $class = shift;
6305 4158
6306 my $self = $class->SUPER::new ( 4159 my $self = $class->SUPER::new (
6307 fontsize => 0.8, 4160 fontsize => 0.8,
6308 @_, 4161 @_,
6309 ); 4162 );
6310 4163
6311 CFPlus::weaken (my $this = $self); 4164 dc::weaken (my $this = $self);
6312 4165
6313 $self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder }); 4166 $self->{timer} = EV::timer 1, 1, sub { $this->reorder };
6314 4167
6315 $self 4168 $self
6316} 4169}
6317 4170
6318sub reorder { 4171sub reorder {
6319 my ($self) = @_; 4172 my ($self) = @_;
6320 my $NOW = Time::HiRes::time; 4173 my $NOW = Time::HiRes::time;
6321 4174
6322 # freeze display when hovering over any label 4175 # freeze display when hovering over any label
6323 return if $CFPlus::UI::TOOLTIP->{owner} 4176 return if $dc::UI::TOOLTIP->{owner}
6324 && grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label}, 4177 && grep $dc::UI::TOOLTIP->{owner} == $_->{label},
6325 values %{ $self->{item} }; 4178 values %{ $self->{item} };
6326 4179
6327 while (my ($k, $v) = each %{ $self->{item} }) { 4180 while (my ($k, $v) = each %{ $self->{item} }) {
6328 delete $self->{item}{$k} if $v->{timeout} < $NOW; 4181 delete $self->{item}{$k} if $v->{timeout} < $NOW;
6329 } 4182 }
4183
4184 $self->{timer}->set (1, 1);
6330 4185
6331 my @widgets; 4186 my @widgets;
6332 4187
6333 my @items = sort { 4188 my @items = sort {
6334 $a->{pri} <=> $b->{pri} 4189 $a->{pri} <=> $b->{pri}
6335 or $b->{id} <=> $a->{id} 4190 or $b->{id} <=> $a->{id}
6336 } values %{ $self->{item} }; 4191 } values %{ $self->{item} };
6337
6338 $self->{timer}->interval (1);
6339 4192
6340 my $count = 10 + 1; 4193 my $count = 10 + 1;
6341 for my $item (@items) { 4194 for my $item (@items) {
6342 last unless --$count; 4195 last unless --$count;
6343 4196
… …
6350 for ($short) { 4203 for ($short) {
6351 s/^\s+//; 4204 s/^\s+//;
6352 s/\s+/ /g; 4205 s/\s+/ /g;
6353 } 4206 }
6354 4207
6355 new CFPlus::UI::Label 4208 new dc::UI::Label
6356 markup => $short, 4209 markup => $short,
6357 tooltip => $item->{tooltip}, 4210 tooltip => $item->{tooltip},
6358 tooltip_font => $::FONT_PROP, 4211 tooltip_font => $::FONT_PROP,
6359 tooltip_width => 0.67, 4212 tooltip_width => 0.67,
6360 fontsize => $item->{fontsize} || $self->{fontsize}, 4213 fontsize => $item->{fontsize} || $self->{fontsize},
… …
6367 if ((my $diff = $item->{timeout} - $NOW) < 2) { 4220 if ((my $diff = $item->{timeout} - $NOW) < 2) {
6368 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2; 4221 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
6369 $label->update; 4222 $label->update;
6370 $label->set_max_size (undef, $label->{req_h} * $diff) 4223 $label->set_max_size (undef, $label->{req_h} * $diff)
6371 if $diff < 1; 4224 if $diff < 1;
6372 $self->{timer}->interval (1/30); 4225 $self->{timer}->set (1/30, 1/30);
6373 } else { 4226 } else {
6374 $label->{fg}[3] = $item->{fg}[3] || 1; 4227 $label->{fg}[3] = $item->{fg}[3] || 1;
6375 } 4228 }
6376 4229
6377 push @widgets, $label; 4230 push @widgets, $label;
… …
6439 $self->SUPER::destroy; 4292 $self->SUPER::destroy;
6440} 4293}
6441 4294
6442############################################################################# 4295#############################################################################
6443 4296
6444package CFPlus::UI::Root; 4297package dc::UI::Root;
6445 4298
6446our @ISA = CFPlus::UI::Container::; 4299our @ISA = dc::UI::Container::;
6447 4300
6448use List::Util qw(min max); 4301use List::Util qw(min max);
6449 4302
6450use CFPlus::OpenGL; 4303use dc::OpenGL;
6451 4304
6452sub new { 4305sub new {
6453 my $class = shift; 4306 my $class = shift;
6454 4307
6455 my $self = $class->SUPER::new ( 4308 my $self = $class->SUPER::new (
6456 visible => 1, 4309 visible => 1,
6457 @_, 4310 @_,
6458 ); 4311 );
6459 4312
6460 CFPlus::weaken ($self->{root} = $self); 4313 dc::weaken ($self->{root} = $self);
6461 4314
6462 $self 4315 $self
6463} 4316}
6464 4317
6465sub size_request { 4318sub size_request {
… …
6513} 4366}
6514 4367
6515sub update { 4368sub update {
6516 my ($self) = @_; 4369 my ($self) = @_;
6517 4370
6518 $::WANT_REFRESH++; 4371 $::WANT_REFRESH = 1;
6519} 4372}
6520 4373
6521sub add { 4374sub add {
6522 my ($self, @children) = @_; 4375 my ($self, @children) = @_;
6523 4376
… …
6560 while ($self->{refresh_hook}) { 4413 while ($self->{refresh_hook}) {
6561 $_->() 4414 $_->()
6562 for values %{delete $self->{refresh_hook}}; 4415 for values %{delete $self->{refresh_hook}};
6563 } 4416 }
6564 4417
6565 if ($self->{realloc}) { 4418 while ($self->{realloc}) {
6566 my %queue; 4419 my %queue;
6567 my @queue; 4420 my @queue;
6568 my $widget; 4421 my $widget;
6569 4422
6570 outer: 4423 outer:
… …
6617 } 4470 }
6618 } 4471 }
6619 4472
6620 delete $self->{realloc}{$widget+0}; 4473 delete $self->{realloc}{$widget+0};
6621 } 4474 }
6622 }
6623 4475
6624 while (my $size_alloc = delete $self->{size_alloc}) { 4476 while (my $size_alloc = delete $self->{size_alloc}) {
6625 my @queue = sort { $b->{visible} <=> $a->{visible} } 4477 my @queue = sort { $a->{visible} <=> $b->{visible} }
6626 values %$size_alloc; 4478 values %$size_alloc;
6627 4479
6628 while () { 4480 while () {
6629 my $widget = pop @queue || last; 4481 my $widget = pop @queue || last;
6630 4482
6631 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 4483 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
6632 4484
6633 $w = 0 if $w < 0;
6634 $h = 0 if $h < 0;
6635
6636 $w = max $widget->{min_w}, $w; 4485 $w = max $widget->{min_w}, $w;
6637 $h = max $widget->{min_h}, $h; 4486 $h = max $widget->{min_h}, $h;
6638 4487
6639# $w = min $self->{w} - $widget->{x}, $w if $self->{w}; 4488# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
6640# $h = min $self->{h} - $widget->{y}, $h if $self->{h}; 4489# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
6641 4490
6642 $w = min $widget->{max_w}, $w if exists $widget->{max_w}; 4491 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
6643 $h = min $widget->{max_h}, $h if exists $widget->{max_h}; 4492 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
6644 4493
6645 $w = int $w + 0.5; 4494 $w = int $w + 0.5;
6646 $h = int $h + 0.5; 4495 $h = int $h + 0.5;
6647 4496
6648 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 4497 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
6649 $widget->{old_w} = $widget->{w}; 4498 $widget->{old_w} = $widget->{w};
6650 $widget->{old_h} = $widget->{h}; 4499 $widget->{old_h} = $widget->{h};
6651 4500
6652 $widget->{w} = $w; 4501 $widget->{w} = $w;
6653 $widget->{h} = $h; 4502 $widget->{h} = $h;
6654 4503
6655 $widget->emit (size_allocate => $w, $h); 4504 $widget->emit (size_allocate => $w, $h);
4505 }
6656 } 4506 }
6657 } 4507 }
6658 } 4508 }
6659 4509
6660 while ($self->{post_alloc_hook}) { 4510 while ($self->{post_alloc_hook}) {
… …
6671 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 4521 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
6672 glMatrixMode GL_MODELVIEW; 4522 glMatrixMode GL_MODELVIEW;
6673 glLoadIdentity; 4523 glLoadIdentity;
6674 4524
6675 { 4525 {
6676 package CFPlus::UI::Base; 4526 package dc::UI::Base;
6677 4527
6678 local ($draw_x, $draw_y, $draw_w, $draw_h) = 4528 local ($draw_x, $draw_y, $draw_w, $draw_h) =
6679 (0, 0, $self->{w}, $self->{h}); 4529 (0, 0, $self->{w}, $self->{h});
6680 4530
6681 $self->_draw; 4531 $self->_draw;
6682 } 4532 }
6683} 4533}
6684 4534
6685############################################################################# 4535#############################################################################
6686 4536
6687package CFPlus::UI; 4537package dc::UI;
6688 4538
6689$ROOT = new CFPlus::UI::Root; 4539$ROOT = new dc::UI::Root;
6690$TOOLTIP = new CFPlus::UI::Tooltip z => 900; 4540$TOOLTIP = new dc::UI::Tooltip z => 900;
6691 4541
66921 45421
6693 4543

Diff Legend

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