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.462 by root, Thu Mar 20 22:28:33 2008 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 my ($w, $h) = @$self{qw(max_w max_h)};
374
375 if ($w <= 0 || $h <= 0) {
376 my ($mw, $mh) = $self->{parent}
377 ? $self->{parent}->get_max_wh
378 : ($::WIDTH, $::HEIGHT);
379
380 $w = $mw if $w <= 0;
381 $h = $mh if $h <= 0;
382 }
383
384 ($w, $h)
385}
386
365sub size_request { 387sub size_request {
366 require Carp; 388 require Carp;
367 Carp::confess "size_request is abstract"; 389 Carp::confess "size_request is abstract";
368} 390}
369 391
… …
375 my ($self, $x, $y, $w, $h) = @_; 397 my ($self, $x, $y, $w, $h) = @_;
376 398
377 if ($self->{aspect}) { 399 if ($self->{aspect}) {
378 my ($ow, $oh) = ($w, $h); 400 my ($ow, $oh) = ($w, $h);
379 401
380 $w = List::Util::min $w, CFPlus::ceil $h * $self->{aspect}; 402 $w = List::Util::min $w, DC::ceil $h * $self->{aspect};
381 $h = List::Util::min $h, CFPlus::ceil $w / $self->{aspect}; 403 $h = List::Util::min $h, DC::ceil $w / $self->{aspect};
382 404
383 # use alignment to adjust x, y 405 # use alignment to adjust x, y
384 406
385 $x += int 0.5 * ($ow - $w); 407 $x += int 0.5 * ($ow - $w);
386 $y += int 0.5 * ($oh - $h); 408 $y += int 0.5 * ($oh - $h);
… …
427 449
428 return if $self->{tooltip} eq $tooltip; 450 return if $self->{tooltip} eq $tooltip;
429 451
430 $self->{tooltip} = $tooltip; 452 $self->{tooltip} = $tooltip;
431 453
432 if ($CFPlus::UI::TOOLTIP->{owner} == $self) { 454 if ($DC::UI::TOOLTIP->{owner} == $self) {
433 delete $CFPlus::UI::TOOLTIP->{owner}; 455 delete $DC::UI::TOOLTIP->{owner};
434 $CFPlus::UI::TOOLTIP_WATCHER->cb->(); 456 $DC::UI::TOOLTIP_WATCHER->invoke;
435 } 457 }
436} 458}
437 459
438# translate global coordinates to local coordinate system 460# translate global coordinates to local coordinate system
439sub coord2local { 461sub coord2local {
440 my ($self, $x, $y) = @_; 462 my ($self, $x, $y) = @_;
441 463
442 Carp::confess unless $self->{parent};#d# 464 return (undef, undef) unless $self->{parent};
443 465
444 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) 466 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
445} 467}
446 468
447# translate local coordinates to global coordinate system 469# translate local coordinates to global coordinate system
448sub coord2global { 470sub coord2global {
449 my ($self, $x, $y) = @_; 471 my ($self, $x, $y) = @_;
450 472
451 Carp::confess unless $self->{parent};#d# 473 return (undef, undef) unless $self->{parent};
452 474
453 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 475 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
454} 476}
455 477
456sub invoke_focus_in { 478sub invoke_focus_in {
… …
505sub connect { 527sub connect {
506 my ($self, $signal, $cb) = @_; 528 my ($self, $signal, $cb) = @_;
507 529
508 push @{ $self->{signal_cb}{$signal} }, $cb; 530 push @{ $self->{signal_cb}{$signal} }, $cb;
509 531
510 defined wantarray and CFPlus::guard { 532 defined wantarray and DC::guard {
511 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb, 533 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
512 @{ $self->{signal_cb}{$signal} }; 534 @{ $self->{signal_cb}{$signal} };
513 } 535 }
514} 536}
515 537
… …
547 569
548 # parent 570 # parent
549 $self->{parent} && $self->{parent}->emit ($signal, @args) 571 $self->{parent} && $self->{parent}->emit ($signal, @args)
550} 572}
551 573
552sub find_widget { 574#sub find_widget {
553 my ($self, $x, $y) = @_; 575# 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 576
564sub set_parent { 577sub set_parent {
565 my ($self, $parent) = @_; 578 my ($self, $parent) = @_;
566 579
567 CFPlus::weaken ($self->{parent} = $parent); 580 DC::weaken ($self->{parent} = $parent);
568 $self->set_visible if $parent->{visible}; 581 $self->set_visible if $parent->{visible};
569} 582}
570 583
571sub realloc { 584sub realloc {
572 my ($self) = @_; 585 my ($self) = @_;
… …
598 611
599# using global variables seems a bit hacky, but passing through all drawing 612# using global variables seems a bit hacky, but passing through all drawing
600# functions seems pointless. 613# functions seems pointless.
601our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn 614our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
602 615
603sub draw { 616#sub draw {
604 my ($self) = @_; 617#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 618
650sub _draw { 619sub _draw {
651 my ($self) = @_; 620 my ($self) = @_;
652 621
653 warn "no draw defined for $self\n"; 622 warn "no draw defined for $self\n";
654} 623}
655 624
656my $cntx;#d#
657sub DESTROY { 625sub DESTROY {
658 my ($self) = @_; 626 my ($self) = @_;
659 627
660 return if CFPlus::in_destruct; 628 return if DC::in_destruct;
661 629
630 local $@;
662 eval { $self->destroy }; 631 eval { $self->destroy };
663 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/; 632 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
664 633
665 delete $WIDGET{$self+0}; 634 delete $WIDGET{$self+0};
666} 635}
667 636
668############################################################################# 637#############################################################################
669 638
670package CFPlus::UI::DrawBG; 639package DC::UI::DrawBG;
671 640
672our @ISA = CFPlus::UI::Base::; 641our @ISA = DC::UI::Base::;
673 642
674use strict; 643use strict;
675use CFPlus::OpenGL; 644use DC::OpenGL;
676 645
677sub new { 646sub new {
678 my $class = shift; 647 my $class = shift;
679
680 # range [value, low, high, page]
681 648
682 $class->SUPER::new ( 649 $class->SUPER::new (
683 #bg => [0, 0, 0, 0.2], 650 #bg => [0, 0, 0, 0.2],
684 #active_bg => [1, 1, 1, 0.5], 651 #active_bg => [1, 1, 1, 0.5],
685 @_ 652 @_
… …
697 my ($w, $h) = @$self{qw(w h)}; 664 my ($w, $h) = @$self{qw(w h)};
698 665
699 glEnable GL_BLEND; 666 glEnable GL_BLEND;
700 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 667 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
701 glColor_premultiply @$color; 668 glColor_premultiply @$color;
702
703 glBegin GL_QUADS;
704 glVertex 0 , 0;
705 glVertex 0 , $h;
706 glVertex $w, $h; 669 glRect 0, 0, $w, $h;
707 glVertex $w, 0;
708 glEnd;
709
710 glDisable GL_BLEND; 670 glDisable GL_BLEND;
711 } 671 }
712} 672}
713 673
714############################################################################# 674#############################################################################
715 675
716package CFPlus::UI::Empty; 676package DC::UI::Empty;
717 677
718our @ISA = CFPlus::UI::Base::; 678our @ISA = DC::UI::Base::;
719 679
720sub new { 680sub new {
721 my ($class, %arg) = @_; 681 my ($class, %arg) = @_;
722 $class->SUPER::new (can_events => 0, %arg); 682 $class->SUPER::new (can_events => 0, %arg);
723} 683}
… …
730 690
731sub draw { } 691sub draw { }
732 692
733############################################################################# 693#############################################################################
734 694
735package CFPlus::UI::Container; 695package DC::UI::Container;
736 696
737our @ISA = CFPlus::UI::Base::; 697our @ISA = DC::UI::Base::;
738 698
739sub new { 699sub new {
740 my ($class, %arg) = @_; 700 my ($class, %arg) = @_;
741 701
742 my $children = delete $arg{children}; 702 my $children = delete $arg{children};
… …
746 can_events => 0, 706 can_events => 0,
747 %arg, 707 %arg,
748 ); 708 );
749 709
750 $self->add (@$children) 710 $self->add (@$children)
751 if $children; 711 if $children && @$children;
752 712
753 $self 713 $self
754} 714}
755 715
756sub realloc { 716sub realloc {
… …
765 my ($self, @widgets) = @_; 725 my ($self, @widgets) = @_;
766 726
767 $_->set_parent ($self) 727 $_->set_parent ($self)
768 for @widgets; 728 for @widgets;
769 729
730 # TODO: only do this in widgets that need it, e.g. root, fixed
770 use sort 'stable'; 731 use sort 'stable';
771 732
772 $self->{children} = [ 733 $self->{children} = [
773 sort { $a->{z} <=> $b->{z} } 734 sort { $a->{z} <=> $b->{z} }
774 @{$self->{children}}, @widgets 735 @{$self->{children}}, @widgets
775 ]; 736 ];
776 737
777 $self->realloc; 738 $self->realloc;
739
740 $self->emit (c_add => \@widgets);
741
742 map $_+0, @widgets
778} 743}
779 744
780sub children { 745sub children {
781 @{ $_[0]{children} } 746 @{ $_[0]{children} }
782} 747}
783 748
784sub remove { 749sub remove {
785 my ($self, $child) = @_; 750 my ($self, @widgets) = @_;
786 751
752 $self->emit (c_remove => \@widgets);
753
754 for my $child (@widgets) {
787 delete $child->{parent}; 755 delete $child->{parent};
788 $child->hide; 756 $child->hide;
789
790 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 757 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
758 }
791 759
792 $self->realloc; 760 $self->realloc;
793} 761}
794 762
795sub clear { 763sub clear {
796 my ($self) = @_; 764 my ($self) = @_;
797 765
798 my $children = delete $self->{children}; 766 my $children = $self->{children};
799 $self->{children} = []; 767 $self->{children} = [];
800 768
801 for (@$children) { 769 for (@$children) {
802 delete $_->{parent}; 770 delete $_->{parent};
803 $_->hide; 771 $_->hide;
… …
823} 791}
824 792
825sub _draw { 793sub _draw {
826 my ($self) = @_; 794 my ($self) = @_;
827 795
828 $_->draw for @{$self->{children}}; 796 $_->draw for $self->visible_children;
829} 797}
830 798
831############################################################################# 799#############################################################################
832 800
833package CFPlus::UI::Bin; 801package DC::UI::Bin;
834 802
835our @ISA = CFPlus::UI::Container::; 803our @ISA = DC::UI::Container::;
836 804
837sub new { 805sub new {
838 my ($class, %arg) = @_; 806 my ($class, %arg) = @_;
839 807
840 my $child = (delete $arg{child}) || new CFPlus::UI::Empty::; 808 my $child = (delete $arg{child}) || new DC::UI::Empty::;
841 809
842 $class->SUPER::new (children => [$child], %arg) 810 $class->SUPER::new (children => [$child], %arg)
843} 811}
844 812
845sub add { 813sub add {
846 my ($self, $child) = @_; 814 my ($self, $child) = @_;
847 815
848 $self->SUPER::remove ($_) for @{ $self->{children} }; 816 $self->clear;
849 $self->SUPER::add ($child); 817 $self->SUPER::add ($child);
850} 818}
851 819
852sub remove { 820sub remove {
853 my ($self, $widget) = @_; 821 my ($self, $widget) = @_;
854 822
855 $self->SUPER::remove ($widget); 823 $self->SUPER::remove ($widget);
856 824
857 $self->{children} = [new CFPlus::UI::Empty] 825 $self->{children} = [new DC::UI::Empty]
858 unless @{$self->{children}}; 826 unless @{$self->{children}};
859} 827}
860 828
861sub child { $_[0]->{children}[0] } 829sub child { $_[0]->{children}[0] }
862 830
… …
871 839
872 1 840 1
873} 841}
874 842
875############################################################################# 843#############################################################################
876
877# back-buffered drawing area 844# back-buffered drawing area
878 845
879package CFPlus::UI::Window; 846package DC::UI::Window;
880 847
881our @ISA = CFPlus::UI::Bin::; 848our @ISA = DC::UI::Bin::;
882 849
883use CFPlus::OpenGL; 850use DC::OpenGL;
884 851
885sub new { 852sub new {
886 my ($class, %arg) = @_; 853 my ($class, %arg) = @_;
887 854
888 my $self = $class->SUPER::new (%arg); 855 my $self = $class->SUPER::new (%arg);
… …
910} 877}
911 878
912sub render_child { 879sub render_child {
913 my ($self) = @_; 880 my ($self) = @_;
914 881
915 $self->{texture} = new_from_opengl CFPlus::Texture $self->{w}, $self->{h}, sub { 882 $self->{texture} = new_from_opengl DC::Texture $self->{w}, $self->{h}, sub {
916 glClearColor 0, 0, 0, 0; 883 glClearColor 0, 0, 0, 0;
917 glClear GL_COLOR_BUFFER_BIT; 884 glClear GL_COLOR_BUFFER_BIT;
918 885
919 { 886 {
920 package CFPlus::UI::Base; 887 package DC::UI::Base;
921 888
922 local ($draw_x, $draw_y, $draw_w, $draw_h) = 889 local ($draw_x, $draw_y, $draw_w, $draw_h) =
923 (0, 0, $self->{w}, $self->{h}); 890 (0, 0, $self->{w}, $self->{h});
924 891
925 $self->_render; 892 $self->_render;
… …
942 glDisable GL_TEXTURE_2D; 909 glDisable GL_TEXTURE_2D;
943} 910}
944 911
945############################################################################# 912#############################################################################
946 913
947package CFPlus::UI::ViewPort; 914package DC::UI::ViewPort;
948 915
949use List::Util qw(min max); 916use List::Util qw(min max);
950 917
951our @ISA = CFPlus::UI::Window::; 918our @ISA = DC::UI::Window::;
952 919
953sub new { 920sub new {
954 my $class = shift; 921 my $class = shift;
955 922
956 $class->SUPER::new ( 923 $class->SUPER::new (
… …
963sub size_request { 930sub size_request {
964 my ($self) = @_; 931 my ($self) = @_;
965 932
966 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 933 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
967 934
968 $w = 10 if $self->{scroll_x}; 935 $w = 1 if $self->{scroll_x};
969 $h = 10 if $self->{scroll_y}; 936 $h = 1 if $self->{scroll_y};
970 937
971 ($w, $h) 938 ($w, $h)
972} 939}
973 940
974sub invoke_size_allocate { 941sub invoke_size_allocate {
… …
998 $self->emit (changed => $x, $y); 965 $self->emit (changed => $x, $y);
999 $self->update; 966 $self->update;
1000 } 967 }
1001} 968}
1002 969
970sub set_center {
971 my ($self, $x, $y) = @_;
972
973 $self->set_offset ($x - $self->{w} * .5, $y - $self->{h} * .5);
974}
975
976sub make_visible {
977 my ($self, $x, $y, $border) = @_;
978
979 if ( $x < $self->{view_x} + $self->{w} * $border
980 || $x > $self->{view_x} + $self->{w} * (1 - $border)
981 || $y < $self->{view_y} + $self->{h} * $border
982 || $y > $self->{view_y} + $self->{h} * (1 - $border)
983 ) {
984 $self->set_center ($x, $y);
985 }
986}
987
1003# hmm, this does not work for topleft of $self... but we should not ask for that 988# hmm, this does not work for topleft of $self... but we should not ask for that
1004sub coord2local { 989sub coord2local {
1005 my ($self, $x, $y) = @_; 990 my ($self, $x, $y) = @_;
1006 991
1007 $self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y}) 992 $self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
… …
1020 my ($self, $x, $y) = @_; 1005 my ($self, $x, $y) = @_;
1021 1006
1022 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w} 1007 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
1023 && $y >= $self->{y} && $y < $self->{y} + $self->{h} 1008 && $y >= $self->{y} && $y < $self->{y} + $self->{h}
1024 ) { 1009 ) {
1025 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y}) 1010 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
1026 } else { 1011 } else {
1027 $self->CFPlus::UI::Base::find_widget ($x, $y) 1012 $self->DC::UI::Base::find_widget ($x, $y)
1028 } 1013 }
1029} 1014}
1030 1015
1031sub _render { 1016sub _render {
1032 my ($self) = @_; 1017 my ($self) = @_;
1033 1018
1034 local $CFPlus::UI::Base::draw_x = $CFPlus::UI::Base::draw_x - $self->{view_x}; 1019 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}; 1020 local $DC::UI::Base::draw_y = $DC::UI::Base::draw_y - $self->{view_y};
1036 1021
1037 CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 1022 DC::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
1038 1023
1039 $self->SUPER::_render; 1024 $self->SUPER::_render;
1040} 1025}
1041 1026
1042############################################################################# 1027#############################################################################
1043 1028
1044package CFPlus::UI::ScrolledWindow; 1029package DC::UI::ScrolledWindow;
1045 1030
1046our @ISA = CFPlus::UI::Table::; 1031our @ISA = DC::UI::Table::;
1047 1032
1048sub new { 1033sub new {
1049 my ($class, %arg) = @_; 1034 my ($class, %arg) = @_;
1050 1035
1051 my $child = delete $arg{child}; 1036 my $child = delete $arg{child};
1052 1037
1053 my $self; 1038 my $self;
1054 1039
1055 my $hslider = new CFPlus::UI::Slider 1040 my $hslider = new DC::UI::Slider
1041 c_col => 0,
1042 c_row => 1,
1056 vertical => 0, 1043 vertical => 0,
1057 range => [0, 0, 1, 0.01], # HACK fix 1044 range => [0, 0, 1, 0.01], # HACK fix
1058 on_changed => sub { 1045 on_changed => sub {
1059 $self->{hpos} = $_[1]; 1046 $self->{hpos} = $_[1];
1060 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos}); 1047 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
1061 }, 1048 },
1062 ; 1049 ;
1063 1050
1064 my $vslider = new CFPlus::UI::Slider 1051 my $vslider = new DC::UI::Slider
1052 c_col => 1,
1053 c_row => 0,
1065 vertical => 1, 1054 vertical => 1,
1066 range => [0, 0, 1, 0.01], # HACK fix 1055 range => [0, 0, 1, 0.01], # HACK fix
1067 on_changed => sub { 1056 on_changed => sub {
1068 $self->{vpos} = $_[1]; 1057 $self->{vpos} = $_[1];
1069 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos}); 1058 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
… …
1079 col_expand => [1, 0], 1068 col_expand => [1, 0],
1080 row_expand => [1, 0], 1069 row_expand => [1, 0],
1081 %arg, 1070 %arg,
1082 ); 1071 );
1083 1072
1084 $self->{vp} = new CFPlus::UI::ViewPort 1073 $self->{vp} = new DC::UI::ViewPort
1074 c_col => 0,
1075 c_row => 0,
1085 expand => 1, 1076 expand => 1,
1086 scroll_x => $self->{scroll_x}, 1077 scroll_x => $self->{scroll_x},
1087 scroll_y => $self->{scroll_y}, 1078 scroll_y => $self->{scroll_y},
1088 on_changed => sub { 1079 on_changed => sub {
1089 my ($vp, $x, $y) = @_; 1080 my ($vp, $x, $y) = @_;
… …
1091 $vp->{parent}{hslider}->set_value ($x); 1082 $vp->{parent}{hslider}->set_value ($x);
1092 $vp->{parent}{vslider}->set_value ($y); 1083 $vp->{parent}{vslider}->set_value ($y);
1093 1084
1094 0 1085 0
1095 }, 1086 },
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 { 1087 on_size_allocate => sub {
1710 video_shutdown (); 1088 my ($vp, $w, $h) = @_;
1711 video_init (); 1089 $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 1090 0
2168 }, 1091 },
2169 ; 1092 ;
2170 1093
2171 $dialog 1094 $self->SUPER::add ($self->{vp});
2172}
2173 1095
2174sub server_setup { 1096 $self->add ($child) if $child;
2175 my $vbox = new CFPlus::UI::VBox;
2176 1097
2177 $vbox->add (new CFPlus::UI::FancyFrame 1098 $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} 1099}
2288 1100
2289sub client_setup { 1101sub 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) = @_; 1102 my ($self, $widget) = @_;
2302 $CFG->{say_command} = $value; 1103
2303 0 1104 $self->{vp}->add ($self->{child} = $widget);
1105}
1106
1107sub set_offset { shift->{vp}->set_offset (@_) }
1108sub set_center { shift->{vp}->set_center (@_) }
1109sub make_visible { shift->{vp}->make_visible (@_) }
1110
1111sub update_slider {
1112 my ($self) = @_;
1113
1114 my $child = ($self->{vp} or return)->child;
1115
1116 if ($self->{scroll_x}) {
1117 my ($w1, $w2) = ($child->{req_w}, $self->{vp}{w});
1118 $self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);
1119
1120 my $visible = $w1 > $w2;
1121 if ($visible != $self->{hslider_visible}) {
1122 $self->{hslider_visible} = $visible;
1123 $visible ? $self->SUPER::add ($self->{hslider})
1124 : $self->SUPER::remove ($self->{hslider});
2304 } 1125 }
2305 ); 1126 }
2306 1127
2307 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day"); 1128 if ($self->{scroll_y}) {
2308 $table->add_at (1, $row++, new CFPlus::UI::CheckBox 1129 my ($h1, $h2) = ($child->{req_h}, $self->{vp}{h});
2309 state => $CFG->{show_tips}, 1130 $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?", 1131
2311 on_changed => sub { 1132 my $visible = $h1 > $h2;
2312 my ($self, $value) = @_; 1133 if ($visible != $self->{vslider_visible}) {
2313 $CFG->{show_tips} = $value; 1134 $self->{vslider_visible} = $visible;
2314 0 1135 $visible ? $self->SUPER::add ($self->{vslider})
1136 : $self->SUPER::remove ($self->{vslider});
2315 } 1137 }
2316 ); 1138 }
1139}
2317 1140
2318 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Messages Window Size"); 1141sub 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) = @_; 1142 my ($self, $ev) = @_;
2326 $LOGVIEW->{max_par} = $CFG->{logview_max_par} = $value*1; 1143
2327 0 1144 $self->grab_focus;
2328 }, 1145
1146 my $ox = $self->{vp}{view_x};
1147 my $oy = $self->{vp}{view_y};
2329 ); 1148
1149 $self->{motion} = sub {
1150 my ($ev, $x, $y) = @_;
2330 1151
2331 $table 1152 $ox -= $ev->{xrel};
2332} 1153 $oy -= $ev->{yrel};
2333 1154
2334sub message_window { 1155 $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 }; 1156 };
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} 1157}
3519 1158
3520sub invoke_mouse_wheel { 1159sub invoke_mouse_wheel {
3521 my ($self, $ev) = @_; 1160 my ($self, $ev) = @_;
3522 1161
3523 return 0 unless $ev->{dy}; # only vertical movements for now
3524
3525 $self->{vslider}->emit (mouse_wheel => $ev); 1162 $self->{vslider}->emit (mouse_wheel => $ev) if $self->{vslider_visible};
1163 $self->{hslider}->emit (mouse_wheel => $ev) if $self->{hslider_visible};
3526 1164
3527 1 1165 1
3528} 1166}
3529 1167
3530sub invoke_button_down { 1168sub invoke_button_down {
3531 my ($self, $ev, $x, $y) = @_; 1169 my ($self, $ev, $x, $y) = @_;
3532 1170
3533 if ($ev->{button} == 2) { 1171 if ($ev->{button} == 2) {
3534 $self->grab_focus; 1172 $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; 1173 return 1;
3547 } 1174 }
3548 1175
3549 0 1176 0
3550} 1177}
… …
3577 $self->SUPER::invoke_size_allocate ($w, $h) 1204 $self->SUPER::invoke_size_allocate ($w, $h)
3578} 1205}
3579 1206
3580############################################################################# 1207#############################################################################
3581 1208
3582package CFPlus::UI::Frame; 1209package DC::UI::Frame;
3583 1210
3584our @ISA = CFPlus::UI::Bin::; 1211our @ISA = DC::UI::Bin::;
3585 1212
3586use CFPlus::OpenGL; 1213use DC::OpenGL;
3587 1214
3588sub new { 1215sub new {
3589 my $class = shift; 1216 my $class = shift;
3590 1217
3591 $class->SUPER::new ( 1218 $class->SUPER::new (
… …
3601 my ($w, $h) = @$self{qw(w h)}; 1228 my ($w, $h) = @$self{qw(w h)};
3602 1229
3603 glEnable GL_BLEND; 1230 glEnable GL_BLEND;
3604 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 1231 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
3605 glColor_premultiply @{ $self->{bg} }; 1232 glColor_premultiply @{ $self->{bg} };
3606
3607 glBegin GL_QUADS;
3608 glVertex 0 , 0;
3609 glVertex 0 , $h;
3610 glVertex $w, $h; 1233 glRect 0, 0, $w, $h;
3611 glVertex $w, 0;
3612 glEnd;
3613
3614 glDisable GL_BLEND; 1234 glDisable GL_BLEND;
3615 } 1235 }
3616 1236
3617 $self->SUPER::_draw; 1237 $self->SUPER::_draw;
3618} 1238}
3619 1239
3620############################################################################# 1240#############################################################################
3621 1241
3622package CFPlus::UI::FancyFrame; 1242package DC::UI::FancyFrame;
3623 1243
3624our @ISA = CFPlus::UI::Bin::; 1244our @ISA = DC::UI::Bin::;
3625 1245
3626use CFPlus::OpenGL; 1246use DC::OpenGL;
3627 1247
3628sub new { 1248sub new {
3629 my ($class, %arg) = @_; 1249 my ($class, %arg) = @_;
3630 1250
3631 if ((exists $arg{label}) && !ref $arg{label}) { 1251 if ((exists $arg{label}) && !ref $arg{label}) {
3632 $arg{label} = new CFPlus::UI::Label 1252 $arg{label} = new DC::UI::Label
3633 align => 1, 1253 align => 1,
3634 valign => 0, 1254 valign => 0.5,
3635 text => $arg{label}, 1255 text => $arg{label},
3636 fontsize => ($arg{border} || 0.8) * 0.75; 1256 fontsize => ($arg{border} || 0.8) * 0.75;
3637 } 1257 }
3638 1258
3639 my $self = $class->SUPER::new ( 1259 my $self = $class->SUPER::new (
… …
3649 1269
3650sub add { 1270sub add {
3651 my ($self, @widgets) = @_; 1271 my ($self, @widgets) = @_;
3652 1272
3653 $self->SUPER::add (@widgets); 1273 $self->SUPER::add (@widgets);
3654 $self->CFPlus::UI::Container::add ($self->{label}) if $self->{label}; 1274 $self->DC::UI::Container::add ($self->{label}) if $self->{label};
3655} 1275}
3656 1276
3657sub border { 1277sub border {
3658 int $_[0]{border} * $::FONTSIZE 1278 int $_[0]{border} * $::FONTSIZE
3659} 1279}
… …
3717 } 1337 }
3718} 1338}
3719 1339
3720############################################################################# 1340#############################################################################
3721 1341
3722package CFPlus::UI::Toplevel; 1342package DC::UI::Toplevel;
3723 1343
3724our @ISA = CFPlus::UI::Bin::; 1344our @ISA = DC::UI::Bin::;
3725 1345
3726use CFPlus::OpenGL; 1346use DC::OpenGL;
3727 1347
3728my $bg = 1348my $bg =
3729 new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png", 1349 new_from_file DC::Texture DC::find_rcfile "d1_bg.png",
3730 mipmap => 1, wrap => 1; 1350 mipmap => 1, wrap => 1;
3731 1351
3732my @border = 1352my @border =
3733 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 1353 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); 1354 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
3735 1355
3736my @icon = 1356my @icon =
3737 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 1357 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
3738 qw(x1_move.png x1_resize.png); 1358 qw(x1_move.png x1_resize.png);
3739 1359
3740sub new { 1360sub new {
3741 my ($class, %arg) = @_; 1361 my ($class, %arg) = @_;
3742 1362
… …
3748 min_w => 64, 1368 min_w => 64,
3749 min_h => 32, 1369 min_h => 32,
3750 %arg, 1370 %arg,
3751 ); 1371 );
3752 1372
3753 $self->{title_widget} = new CFPlus::UI::Label 1373 $self->{title_widget} = new DC::UI::Label
3754 align => 0, 1374 align => 0.5,
3755 valign => 1, 1375 valign => 1,
3756 text => $self->{title}, 1376 text => $self->{title},
3757 fontsize => $self->{border}, 1377 fontsize => $self->{border},
3758 if exists $self->{title}; 1378 if exists $self->{title};
3759 1379
3760 if ($self->{has_close_button}) { 1380 if ($self->{has_close_button}) {
3761 $self->{close_button} = 1381 $self->{close_button} =
3762 new CFPlus::UI::ImageButton 1382 new DC::UI::ImageButton
3763 path => 'x1_close.png', 1383 path => 'x1_close.png',
3764 on_activate => sub { $self->emit ("delete") }; 1384 on_activate => sub { $self->emit ("delete") };
3765 1385
3766 $self->CFPlus::UI::Container::add ($self->{close_button}); 1386 $self->DC::UI::Container::add ($self->{close_button});
3767 } 1387 }
3768 1388
3769 $self 1389 $self
3770} 1390}
3771 1391
3772sub add { 1392sub add {
3773 my ($self, @widgets) = @_; 1393 my ($self, @widgets) = @_;
3774 1394
3775 $self->SUPER::add (@widgets); 1395 $self->SUPER::add (@widgets);
3776 $self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button}; 1396 $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}; 1397 $self->DC::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
3778} 1398}
3779 1399
3780sub border { 1400sub border {
3781 int $_[0]{border} * $::FONTSIZE 1401 int $_[0]{border} * $::FONTSIZE
1402}
1403
1404sub get_max_wh {
1405 my ($self) = @_;
1406
1407 return ($self->{w}, $self->{h})
1408 if $self->{visible} && $self->{w};
1409
1410 $self->SUPER::get_max_wh
3782} 1411}
3783 1412
3784sub size_request { 1413sub size_request {
3785 my ($self) = @_; 1414 my ($self) = @_;
3786 1415
… …
3958 if $self->{close_button}; 1587 if $self->{close_button};
3959} 1588}
3960 1589
3961############################################################################# 1590#############################################################################
3962 1591
3963package CFPlus::UI::Table; 1592package DC::UI::Table;
3964 1593
3965our @ISA = CFPlus::UI::Base::; 1594our @ISA = DC::UI::Container::;
3966 1595
3967use List::Util qw(max sum); 1596use List::Util qw(max sum);
3968 1597
3969use CFPlus::OpenGL; 1598use DC::OpenGL;
3970 1599
3971sub new { 1600sub new {
3972 my $class = shift; 1601 my $class = shift;
3973 1602
3974 $class->SUPER::new ( 1603 $class->SUPER::new (
3975 children => [],
3976 col_expand => [], 1604 col_expand => [],
3977 row_expand => [], 1605 row_expand => [],
3978 @_, 1606 @_,
3979 ) 1607 )
3980} 1608}
3981 1609
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 { 1610sub add {
3988 my $self = shift; 1611 my ($self, @widgets) = @_;
3989 1612
3990 Carp::cluck "please use the add_at method instead of calling add, thank you.\n";#d# 1613 for my $child (@widgets) {
3991 $self->add_at (@_); 1614 $child->{c_rowspan} ||= 1;
1615 $child->{c_colspan} ||= 1;
1616 }
1617
1618 $self->SUPER::add (@widgets);
3992} 1619}
3993 1620
3994sub add_at { 1621sub add_at {
3995 my $self = shift; 1622 my $self = shift;
3996 1623
1624 my @widgets;
1625
3997 while (@_) { 1626 while (@_) {
3998 my ($col, $row, $child) = splice @_, 0, 3, (); 1627 my ($col, $row, $child) = splice @_, 0, 3, ();
3999 1628
4000 $child->set_parent ($self); 1629 $child->{c_row} = $row;
4001 $self->{children}[$row][$col] = $child; 1630 $child->{c_col} = $col;
4002 }
4003 1631
4004 $self->{force_realloc} = 1; 1632 push @widgets, $child;
4005 $self->{force_size_alloc} = 1; 1633 }
4006 $self->realloc;
4007}
4008 1634
4009sub remove { 1635 $self->add (@widgets);
1636}
1637
1638sub get_wh {
4010 my ($self, $child) = @_; 1639 my ($self) = @_;
4011 1640
4012 for (@{ $self->{children} }) { 1641 my (@w, @h);
4013 for (@{ $_ || [] }) { 1642
4014 $_ = undef if $_ == $child; 1643 my @children = $self->children;
1644
1645 # first pass, columns
1646 for my $widget (sort { $a->{c_colspan} <=> $b->{c_colspan} } @children) {
1647 my ($c, $w, $cs) = @$widget{qw(c_col req_w c_colspan)};
1648
1649 my $sw = sum @w[$c .. $c + $cs - 1];
1650
1651 if ($w > $sw) {
1652 $_ += ($w - $sw) / ($_ ? $sw / $_ : $cs) for @w[$c .. $c + $cs - 1];
4015 } 1653 }
4016 } 1654 }
4017}
4018 1655
4019# TODO: move to container class maybe? send children a signal on removal? 1656 # second pass, rows
4020sub clear { 1657 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)}; 1658 my ($r, $h, $rs) = @$widget{qw(c_row req_h c_rowspan)};
4047 1659
4048 $w[$x] = max $w[$x], $w; 1660 my $sh = sum @h[$r .. $r + $rs - 1];
4049 $h[$y] = max $h[$y], $h; 1661
1662 if ($h > $sh) {
1663 $_ += ($h - $sh) / ($_ ? $sh / $_ : $rs) for @h[$r .. $r + $rs - 1];
4050 } 1664 }
4051 } 1665 }
4052 1666
4053 (\@w, \@h) 1667 (\@w, \@h)
4054} 1668}
… …
4070 my ($ws, $hs) = $self->get_wh; 1684 my ($ws, $hs) = $self->get_wh;
4071 1685
4072 my $req_w = (sum @$ws) || 1; 1686 my $req_w = (sum @$ws) || 1;
4073 my $req_h = (sum @$hs) || 1; 1687 my $req_h = (sum @$hs) || 1;
4074 1688
4075 # TODO: nicer code 1689 # now linearly scale the rows/columns to the allocated size
4076 my @col_expand = @{$self->{col_expand}}; 1690 my @col_expand = @{$self->{col_expand}};
4077 @col_expand = (1) x @$ws unless @col_expand; 1691 @col_expand = (1) x @$ws unless @col_expand;
4078 my $col_expand = (sum @col_expand) || 1; 1692 my $col_expand = (sum @col_expand) || 1;
4079 1693
4080 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws; 1694 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
4081 1695
4082 CFPlus::UI::harmonize $ws; 1696 DC::UI::harmonize $ws;
4083 1697
4084 my @row_expand = @{$self->{row_expand}}; 1698 my @row_expand = @{$self->{row_expand}};
4085 @row_expand = (1) x @$ws unless @row_expand; 1699 @row_expand = (1) x @$ws unless @row_expand;
4086 my $row_expand = (sum @row_expand) || 1; 1700 my $row_expand = (sum @row_expand) || 1;
4087 1701
4088 $hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs; 1702 $hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs;
4089 1703
4090 CFPlus::UI::harmonize $hs; 1704 DC::UI::harmonize $hs;
4091 1705
4092 my $y; 1706 my @x; for (0 .. $#$ws) { $x[$_ + 1] = $x[$_] + $ws->[$_] }
1707 my @y; for (0 .. $#$hs) { $y[$_ + 1] = $y[$_] + $hs->[$_] }
4093 1708
4094 for my $r (0 .. $#{$self->{children}}) { 1709 for my $widget ($self->children) {
4095 my $row = $self->{children}[$r] 1710 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 1711
4098 my $x = 0; 1712 $widget->configure (
4099 my $row_h = $hs->[$r]; 1713 $x[$c], $y[$r],
1714 $x[$c + $cs] - $x[$c], $y[$r + $rs] - $y[$r],
4100 1715 );
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 } 1716 }
4113 1717
4114 1 1718 1
4115} 1719}
4116 1720
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############################################################################# 1721#############################################################################
4142 1722
4143package CFPlus::UI::Fixed; 1723package DC::UI::Fixed;
4144 1724
4145use List::Util qw(min max); 1725use List::Util qw(min max);
4146 1726
4147our @ISA = CFPlus::UI::Container::; 1727our @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 1728
4156sub _scale($$$) { 1729sub _scale($$$) {
4157 my ($mode, $val, $max) = @_; 1730 my ($rel, $val, $max) = @_;
4158 1731
4159 $mode eq "abs" ? $val 1732 $rel ? $val * $max : $val
4160 : $mode eq "rel" ? $val * $max
4161 : 0
4162} 1733}
4163 1734
4164sub size_request { 1735sub size_request {
4165 my ($self) = @_; 1736 my ($self) = @_;
4166 1737
4167 my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0); 1738 my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0);
4168 1739
4169 # determine overall size by querying abs widgets 1740 # determine overall size by querying abs widgets
4170 for my $child ($self->visible_children) { 1741 for my $child ($self->visible_children) {
4171 my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} }; 1742 unless ($child->{c_rel}) {
1743 my $x = $child->{c_x};
1744 my $y = $child->{c_y};
4172 1745
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; 1746 $x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
4178 $y1 = min $y1, $y; $y2 = max $y2, $y + $h; 1747 $y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
4179 } 1748 }
4180 } 1749 }
4181 1750
4182 my $W = $x2 - $x1; 1751 my $W = $x2 - $x1;
4183 my $H = $y2 - $y1; 1752 my $H = $y2 - $y1;
4184 1753
4185 # now layout remaining widgets 1754 # now layout remaining widgets
4186 for my $child ($self->visible_children) { 1755 for my $child ($self->visible_children) {
4187 my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} }; 1756 if ($child->{c_rel}) {
1757 my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
1758 my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
4188 1759
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; 1760 $x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
4196 $y1 = min $y1, $y; $y2 = max $y2, $y + $h; 1761 $y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
4197 } 1762 }
4198 } 1763 }
4199 1764
4200 my $W = $x2 - $x1; 1765 my $W = $x2 - $x1;
4201 my $H = $y2 - $y1; 1766 my $H = $y2 - $y1;
… …
4205 1770
4206sub invoke_size_allocate { 1771sub invoke_size_allocate {
4207 my ($self, $W, $H) = @_; 1772 my ($self, $W, $H) = @_;
4208 1773
4209 for my $child ($self->visible_children) { 1774 for my $child ($self->visible_children) {
4210 my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} }; 1775 my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
1776 my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
4211 1777
4212 $x = _scale $pos, $x, $W; 1778 $x += $child->{c_halign} * $child->{req_w};
4213 $y = _scale $pos, $x, $H; 1779 $y += $child->{c_valign} * $child->{req_h};
4214 $w = _scale $size, $w, $child->{req_w};
4215 $h = _scale $size, $h, $child->{req_h};
4216 1780
4217 $child->configure ($x, $y, $w, $h); 1781 $child->configure (int $x, int $y, $child->{req_w}, $child->{req_h});
4218 } 1782 }
4219 1783
4220 1 1784 1
4221} 1785}
4222 1786
4223############################################################################# 1787#############################################################################
4224 1788
4225package CFPlus::UI::Box; 1789package DC::UI::Box;
4226 1790
4227our @ISA = CFPlus::UI::Container::; 1791our @ISA = DC::UI::Container::;
4228 1792
4229sub size_request { 1793sub size_request {
4230 my ($self) = @_; 1794 my ($self) = @_;
1795
1796 my @children = $self->visible_children;
4231 1797
4232 $self->{vertical} 1798 $self->{vertical}
4233 ? ( 1799 ? (
4234 (List::Util::max map $_->{req_w}, @{$self->{children}}), 1800 (List::Util::max map $_->{req_w}, @children),
4235 (List::Util::sum map $_->{req_h}, @{$self->{children}}), 1801 (List::Util::sum map $_->{req_h}, @children),
4236 ) 1802 )
4237 : ( 1803 : (
4238 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1804 (List::Util::sum map $_->{req_w}, @children),
4239 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1805 (List::Util::max map $_->{req_h}, @children),
4240 ) 1806 )
4241} 1807}
4242 1808
4243sub invoke_size_allocate { 1809sub invoke_size_allocate {
4244 my ($self, $w, $h) = @_; 1810 my ($self, $w, $h) = @_;
… …
4265 $req[$_] += $space * $children[$_]{expand} 1831 $req[$_] += $space * $children[$_]{expand}
4266 for 0 .. $#children; 1832 for 0 .. $#children;
4267 } 1833 }
4268 } 1834 }
4269 1835
4270 CFPlus::UI::harmonize \@req; 1836 DC::UI::harmonize \@req;
4271 1837
4272 my $pos = 0; 1838 my $pos = 0;
4273 for (0 .. $#children) { 1839 for (0 .. $#children) {
4274 my $alloc = $req[$_]; 1840 my $alloc = $req[$_];
4275 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1841 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
… …
4280 1 1846 1
4281} 1847}
4282 1848
4283############################################################################# 1849#############################################################################
4284 1850
4285package CFPlus::UI::HBox; 1851package DC::UI::HBox;
4286 1852
4287our @ISA = CFPlus::UI::Box::; 1853our @ISA = DC::UI::Box::;
4288 1854
4289sub new { 1855sub new {
4290 my $class = shift; 1856 my $class = shift;
4291 1857
4292 $class->SUPER::new ( 1858 $class->SUPER::new (
… …
4295 ) 1861 )
4296} 1862}
4297 1863
4298############################################################################# 1864#############################################################################
4299 1865
4300package CFPlus::UI::VBox; 1866package DC::UI::VBox;
4301 1867
4302our @ISA = CFPlus::UI::Box::; 1868our @ISA = DC::UI::Box::;
4303 1869
4304sub new { 1870sub new {
4305 my $class = shift; 1871 my $class = shift;
4306 1872
4307 $class->SUPER::new ( 1873 $class->SUPER::new (
… …
4310 ) 1876 )
4311} 1877}
4312 1878
4313############################################################################# 1879#############################################################################
4314 1880
4315package CFPlus::UI::Label; 1881package DC::UI::Label;
4316 1882
4317our @ISA = CFPlus::UI::DrawBG::; 1883our @ISA = DC::UI::DrawBG::;
4318 1884
4319use CFPlus::OpenGL; 1885use DC::OpenGL;
4320 1886
4321sub new { 1887sub new {
4322 my ($class, %arg) = @_; 1888 my ($class, %arg) = @_;
4323 1889
4324 my $self = $class->SUPER::new ( 1890 my $self = $class->SUPER::new (
… …
4329 #text => initial text 1895 #text => initial text
4330 #markup => initial narkup 1896 #markup => initial narkup
4331 #max_w => maximum pixel width 1897 #max_w => maximum pixel width
4332 #style => 0, # render flags 1898 #style => 0, # render flags
4333 ellipsise => 3, # end 1899 ellipsise => 3, # end
4334 layout => (new CFPlus::Layout), 1900 layout => (new DC::Layout),
4335 fontsize => 1, 1901 fontsize => 1,
4336 align => -1, 1902 align => 0.5,
4337 valign => -1, 1903 valign => 0.5,
4338 padding_x => 2, 1904 padding_x => 4,
4339 padding_y => 2, 1905 padding_y => 2,
4340 can_events => 0, 1906 can_events => 0,
4341 %arg 1907 %arg
4342 ); 1908 );
4343 1909
4344 if (exists $self->{template}) { 1910 if (exists $self->{template}) {
4345 my $layout = new CFPlus::Layout; 1911 my $layout = new DC::Layout;
4346 $layout->set_text (delete $self->{template}); 1912 $layout->set_text (delete $self->{template});
4347 $self->{template} = $layout; 1913 $self->{template} = $layout;
4348 } 1914 }
4349 1915
4350 if (exists $self->{markup}) { 1916 if (exists $self->{markup}) {
… …
4368 1934
4369 delete $self->{ox}; 1935 delete $self->{ox};
4370 $self->SUPER::realloc; 1936 $self->SUPER::realloc;
4371} 1937}
4372 1938
1939sub clear {
1940 my ($self) = @_;
1941
1942 $self->set_text ("");
1943}
1944
4373sub set_text { 1945sub set_text {
4374 my ($self, $text) = @_; 1946 my ($self, $text) = @_;
4375 1947
4376 return if $self->{text} eq "T$text"; 1948 return if $self->{text} eq "T$text";
4377 $self->{text} = "T$text"; 1949 $self->{text} = "T$text";
… …
4400 1972
4401sub size_request { 1973sub size_request {
4402 my ($self) = @_; 1974 my ($self) = @_;
4403 1975
4404 $self->{size_req} ||= do { 1976 $self->{size_req} ||= do {
1977 my ($max_w, $max_h) = $self->get_max_wh;
1978
4405 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1979 $self->{layout}->set_font ($self->{font}) if $self->{font};
4406 $self->{layout}->set_width ($self->{max_w} || -1); 1980 $self->{layout}->set_width ($max_w);
4407 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1981 $self->{layout}->set_ellipsise ($self->{ellipsise});
4408 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1982 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
4409 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1983 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
4410 1984
4411 my ($w, $h) = $self->{layout}->size; 1985 my ($w, $h) = $self->{layout}->size;
4412 1986
4413 if (exists $self->{template}) { 1987 if (exists $self->{template}) {
4414 $self->{template}->set_font ($self->{font}) if $self->{font}; 1988 $self->{template}->set_font ($self->{font}) if $self->{font};
4415 $self->{template}->set_width ($self->{max_w} || -1); 1989 $self->{template}->set_width ($max_w);
4416 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 1990 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
4417 1991
4418 my ($w2, $h2) = $self->{template}->size; 1992 my ($w2, $h2) = $self->{template}->size;
4419 1993
4420 $w = List::Util::max $w, $w2; 1994 $w = List::Util::max $w, $w2;
… …
4476 2050
4477 [$self->{layout}->size] 2051 [$self->{layout}->size]
4478 }; 2052 };
4479 2053
4480 unless (exists $self->{ox}) { 2054 unless (exists $self->{ox}) {
4481 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} 2055 $self->{ox} = $self->{padding_x} + int $self->{align} * ($self->{w} - $size->[0] - $self->{padding_x} * 2);
4482 : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x} 2056 $self->{oy} = $self->{padding_y} + int $self->{valign} * ($self->{h} - $size->[1] - $self->{padding_y} * 2);
4483 : ($self->{w} - $size->[0]) * 0.5);
4484 2057
4485 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 2058 $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
4486 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
4487 : ($self->{h} - $size->[1]) * 0.5);
4488 }; 2059 };
4489 2060
4490 my $w = List::Util::min $self->{w} + 4, $size->[0]; 2061# unless ($self->{list}) {
4491 my $h = List::Util::min $self->{h} + 2, $size->[1]; 2062# $self->{list} = DC::OpenGL::glGenList;
4492 2063# DC::OpenGL::glNewList $self->{list};
4493 $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style}); 2064# $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
2065# DC::OpenGL::glEndList;
2066# }
2067#
2068# DC::OpenGL::glCallList $self->{list};
2069
2070 $self->{layout}->draw;
4494} 2071}
2072
2073#sub destroy {
2074# my ($self) = @_;
2075#
2076# DC::OpenGL::glDeleteList delete $self->{list} if $self->{list};
2077#
2078# $self->SUPER::destroy;
2079#}
4495 2080
4496############################################################################# 2081#############################################################################
4497 2082
4498package CFPlus::UI::EntryBase; 2083package DC::UI::EntryBase;
4499 2084
4500our @ISA = CFPlus::UI::Label::; 2085our @ISA = DC::UI::Label::;
4501 2086
4502use CFPlus::OpenGL; 2087use DC::OpenGL;
4503 2088
4504sub new { 2089sub new {
4505 my $class = shift; 2090 my $class = shift;
4506 2091
4507 $class->SUPER::new ( 2092 $class->SUPER::new (
4508 fg => [1, 1, 1], 2093 fg => [1, 1, 1],
4509 bg => [0, 0, 0, 0.2], 2094 bg => [0, 0, 0, 0.2],
2095 outline => [0.6, 0.3, 0.1],
4510 active_bg => [1, 1, 1, 0.5], 2096 active_bg => [0, 0, 1, .2],
4511 active_fg => [0, 0, 0], 2097 active_fg => [1, 1, 1],
2098 active_outline => [1, 1, 0],
4512 can_hover => 1, 2099 can_hover => 1,
4513 can_focus => 1, 2100 can_focus => 1,
2101 align => 0,
4514 valign => 0, 2102 valign => 0.5,
4515 can_events => 1, 2103 can_events => 1,
4516 ellipsise => 0, 2104 ellipsise => 0,
2105 padding_x => 4,
2106 padding_y => 2,
4517 #text => ... 2107 #text => ...
4518 #hidden => "*", 2108 #hidden => "*",
4519 @_ 2109 @_
4520 ) 2110 )
4521} 2111}
… …
4572 2162
4573 if ($uni == 8) { 2163 if ($uni == 8) {
4574 substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; 2164 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
4575 } elsif ($uni == 127) { 2165 } elsif ($uni == 127) {
4576 substr $text, $self->{cursor}, 1, ""; 2166 substr $text, $self->{cursor}, 1, "";
4577 } elsif ($sym == CFPlus::SDLK_LEFT) { 2167 } elsif ($sym == DC::SDLK_LEFT) {
4578 --$self->{cursor} if $self->{cursor}; 2168 --$self->{cursor} if $self->{cursor};
4579 } elsif ($sym == CFPlus::SDLK_RIGHT) { 2169 } elsif ($sym == DC::SDLK_RIGHT) {
4580 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 2170 ++$self->{cursor} if $self->{cursor} < length $self->{text};
4581 } elsif ($sym == CFPlus::SDLK_HOME) { 2171 } elsif ($sym == DC::SDLK_HOME) {
4582 # what a hack 2172 # what a hack
4583 $self->{cursor} = 2173 $self->{cursor} =
4584 (substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/ 2174 (substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
4585 ? length $1 2175 ? length $1
4586 : 0; 2176 : 0;
4587 } elsif ($sym == CFPlus::SDLK_END) { 2177 } elsif ($sym == DC::SDLK_END) {
4588 # uh, again 2178 # uh, again
4589 $self->{cursor} = 2179 $self->{cursor} =
4590 (substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/ 2180 (substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
4591 ? $self->{cursor} + length $1 2181 ? $self->{cursor} + length $1
4592 : length $self->{text}; 2182 : length $self->{text};
… …
4656 glColor_premultiply @{$self->{bg}}; 2246 glColor_premultiply @{$self->{bg}};
4657 } 2247 }
4658 2248
4659 glEnable GL_BLEND; 2249 glEnable GL_BLEND;
4660 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2250 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}; 2251 glRect 0, 0, $self->{w}, $self->{h};
4665 glVertex $self->{w}, 0;
4666 glEnd;
4667 glDisable GL_BLEND; 2252 glDisable GL_BLEND;
4668 2253
4669 $self->SUPER::_draw; 2254 $self->SUPER::_draw;
4670 2255
4671 #TODO: force update every cursor change :( 2256 #TODO: force update every cursor change :(
… …
4673 2258
4674 unless (exists $self->{cur_h}) { 2259 unless (exists $self->{cur_h}) {
4675 my $text = substr $self->{text}, 0, $self->{cursor}; 2260 my $text = substr $self->{text}, 0, $self->{cursor};
4676 utf8::encode $text; 2261 utf8::encode $text;
4677 2262
4678 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text) 2263 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
4679 } 2264 }
4680 2265
2266 glColor_premultiply @{$self->{active_fg}};
4681 glBegin GL_LINES; 2267 glBegin GL_LINES;
4682 glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy}; 2268 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}; 2269 glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy} + $self->{cur_h};
4684 glEnd; 2270 glEnd;
2271
2272 glLineWidth 3;
2273 glColor @{$self->{active_outline}};
2274 glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
2275 glLineWidth 1;
2276
2277 } else {
2278 glColor @{$self->{outline}};
2279 glBegin GL_LINE_STRIP;
2280 glVertex .5, $self->{h} * .5;
2281 glVertex .5, $self->{h} - 2.5;
2282 glVertex $self->{w} - .5, $self->{h} - 2.5;
2283 glVertex $self->{w} - .5, $self->{h} * .5;
2284 glEnd;
4685 } 2285 }
4686} 2286}
4687 2287
4688############################################################################# 2288#############################################################################
4689 2289
4690package CFPlus::UI::Entry; 2290package DC::UI::Entry;
4691 2291
4692our @ISA = CFPlus::UI::EntryBase::; 2292our @ISA = DC::UI::EntryBase::;
4693 2293
4694use CFPlus::OpenGL; 2294use DC::OpenGL;
2295
2296sub new {
2297 my $class = shift;
2298
2299 $class->SUPER::new (
2300 history_pointer => -1,
2301 @_
2302 )
2303}
2304
4695 2305
4696sub invoke_key_down { 2306sub invoke_key_down {
4697 my ($self, $ev) = @_; 2307 my ($self, $ev) = @_;
4698 2308
4699 my $sym = $ev->{sym}; 2309 my $sym = $ev->{sym};
… …
4705 $self->{history_pointer} = -1; 2315 $self->{history_pointer} = -1;
4706 $self->{history_saveback} = ''; 2316 $self->{history_saveback} = '';
4707 $self->emit (activate => $txt); 2317 $self->emit (activate => $txt);
4708 $self->update; 2318 $self->update;
4709 2319
4710 } elsif ($sym == CFPlus::SDLK_UP) { 2320 } elsif ($sym == DC::SDLK_UP) {
4711 if ($self->{history_pointer} < 0) { 2321 if ($self->{history_pointer} < 0) {
4712 $self->{history_saveback} = $self->get_text; 2322 $self->{history_saveback} = $self->get_text;
4713 } 2323 }
4714 if (@{$self->{history} || []} > 0) { 2324 if (@{$self->{history} || []} > 0) {
4715 $self->{history_pointer}++; 2325 $self->{history_pointer}++;
… …
4717 $self->{history_pointer} = @{$self->{history} || []} - 1; 2327 $self->{history_pointer} = @{$self->{history} || []} - 1;
4718 } 2328 }
4719 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2329 $self->set_text ($self->{history}->[$self->{history_pointer}]);
4720 } 2330 }
4721 2331
4722 } elsif ($sym == CFPlus::SDLK_DOWN) { 2332 } elsif ($sym == DC::SDLK_DOWN) {
4723 $self->{history_pointer}--; 2333 $self->{history_pointer}--;
4724 $self->{history_pointer} = -1 if $self->{history_pointer} < 0; 2334 $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
4725 2335
4726 if ($self->{history_pointer} >= 0) { 2336 if ($self->{history_pointer} >= 0) {
4727 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2337 $self->set_text ($self->{history}->[$self->{history_pointer}]);
4728 } else { 2338 } else {
2339 if (defined $self->{history_saveback}) {
4729 $self->set_text ($self->{history_saveback}); 2340 $self->set_text ($self->{history_saveback});
2341 $self->{history_saveback} = undef;
2342 }
4730 } 2343 }
4731 2344
4732 } else { 2345 } else {
4733 return $self->SUPER::invoke_key_down ($ev) 2346 return $self->SUPER::invoke_key_down ($ev)
4734 } 2347 }
… …
4736 1 2349 1
4737} 2350}
4738 2351
4739############################################################################# 2352#############################################################################
4740 2353
4741package CFPlus::UI::TextEdit; 2354package DC::UI::TextEdit;
4742 2355
4743our @ISA = CFPlus::UI::EntryBase::; 2356our @ISA = DC::UI::EntryBase::;
4744 2357
4745use CFPlus::OpenGL; 2358use DC::OpenGL;
2359
2360sub new {
2361 my $class = shift;
2362
2363 $class->SUPER::new (
2364 padding_y => 4,
2365
2366 @_
2367 )
2368}
4746 2369
4747sub move_cursor_ver { 2370sub move_cursor_ver {
4748 my ($self, $dy) = @_; 2371 my ($self, $dy) = @_;
4749 2372
4750 my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor}); 2373 my ($line, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
4751 2374
4752 $y += $dy; 2375 $line += $dy;
4753 2376
4754 if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) { 2377 if (defined (my $index = $self->{layout}->line_x_to_index ($line, $x))) {
4755 $self->{cursor} = $index; 2378 $self->{cursor} = $index;
4756 delete $self->{cur_h}; 2379 delete $self->{cur_h};
4757 $self->update; 2380 $self->update;
4758 return; 2381 return;
4759 } 2382 }
… …
4762sub invoke_key_down { 2385sub invoke_key_down {
4763 my ($self, $ev) = @_; 2386 my ($self, $ev) = @_;
4764 2387
4765 my $sym = $ev->{sym}; 2388 my $sym = $ev->{sym};
4766 2389
4767 if ($sym == CFPlus::SDLK_UP) { 2390 if ($sym == DC::SDLK_UP) {
4768 $self->move_cursor_ver (-1); 2391 $self->move_cursor_ver (-1);
4769 } elsif ($sym == CFPlus::SDLK_DOWN) { 2392 } elsif ($sym == DC::SDLK_DOWN) {
4770 $self->move_cursor_ver (+1); 2393 $self->move_cursor_ver (+1);
4771 } else { 2394 } else {
4772 return $self->SUPER::invoke_key_down ($ev) 2395 return $self->SUPER::invoke_key_down ($ev)
4773 } 2396 }
4774 2397
4775 1 2398 1
4776} 2399}
4777 2400
4778############################################################################# 2401#############################################################################
4779 2402
4780package CFPlus::UI::Button; 2403package DC::UI::ButtonBin;
4781 2404
4782our @ISA = CFPlus::UI::Label::; 2405our @ISA = DC::UI::Bin::;
4783 2406
4784use CFPlus::OpenGL; 2407use DC::OpenGL;
4785 2408
4786my @tex = 2409my @tex =
4787 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2410 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
4788 qw(b1_button_inactive.png b1_button_active.png); 2411 qw(b1_button_inactive.png b1_button_active.png);
4789 2412
4790sub new { 2413sub new {
4791 my $class = shift; 2414 my $class = shift;
4792 2415
4793 $class->SUPER::new ( 2416 $class->SUPER::new (
2417 can_hover => 1,
2418 align => 0.5,
2419 valign => 0.5,
2420 can_events => 1,
2421 @_
2422 )
2423}
2424
2425sub invoke_button_up {
2426 my ($self, $ev, $x, $y) = @_;
2427
2428 $self->emit ("activate")
2429 if $x >= 0 && $x < $self->{w}
2430 && $y >= 0 && $y < $self->{h};
2431
2432 1
2433}
2434
2435sub _draw {
2436 my ($self) = @_;
2437
2438 glEnable GL_TEXTURE_2D;
2439 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2440 glColor 0, 0, 0, 1;
2441
2442 my $tex = $tex[$GRAB == $self];
2443 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2444
2445 glDisable GL_TEXTURE_2D;
2446
2447 $self->SUPER::_draw;
2448}
2449
2450#############################################################################
2451
2452package DC::UI::Button;
2453
2454our @ISA = DC::UI::Label::;
2455
2456use DC::OpenGL;
2457
2458my @tex =
2459 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
2460 qw(b1_button_inactive.png b1_button_active.png);
2461
2462sub new {
2463 my $class = shift;
2464
2465 $class->SUPER::new (
4794 padding_x => 4, 2466 padding_x => 8,
4795 padding_y => 4, 2467 padding_y => 4,
4796 fg => [1.0, 1.0, 1.0], 2468 fg => [1.0, 1.0, 1.0],
4797 active_fg => [0.8, 0.8, 0.8], 2469 active_fg => [0.8, 0.8, 0.8],
4798 can_hover => 1, 2470 can_hover => 1,
4799 align => 0, 2471 align => 0.5,
4800 valign => 0, 2472 valign => 0.5,
4801 can_events => 1, 2473 can_events => 1,
4802 @_ 2474 @_
4803 ) 2475 )
4804} 2476}
4805 2477
… …
4830 $self->SUPER::_draw; 2502 $self->SUPER::_draw;
4831} 2503}
4832 2504
4833############################################################################# 2505#############################################################################
4834 2506
4835package CFPlus::UI::CheckBox; 2507package DC::UI::CheckBox;
4836 2508
4837our @ISA = CFPlus::UI::DrawBG::; 2509our @ISA = DC::UI::DrawBG::;
4838 2510
4839my @tex = 2511my @tex =
4840 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2512 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
4841 qw(c1_checkbox_bg.png c1_checkbox_active.png); 2513 qw(c1_checkbox_bg.png c1_checkbox_active.png);
4842 2514
4843use CFPlus::OpenGL; 2515use DC::OpenGL;
4844 2516
4845sub new { 2517sub new {
4846 my $class = shift; 2518 my $class = shift;
4847 2519
4848 $class->SUPER::new ( 2520 $class->SUPER::new (
… …
4888sub _draw { 2560sub _draw {
4889 my ($self) = @_; 2561 my ($self) = @_;
4890 2562
4891 $self->SUPER::_draw; 2563 $self->SUPER::_draw;
4892 2564
4893 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0; 2565 glTranslate $self->{padding_x}, $self->{padding_y}, 0;
4894 2566
4895 my ($w, $h) = @$self{qw(w h)}; 2567 my ($w, $h) = @$self{qw(w h)};
4896 2568
4897 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2; 2569 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
4898 2570
… …
4905 glDisable GL_TEXTURE_2D; 2577 glDisable GL_TEXTURE_2D;
4906} 2578}
4907 2579
4908############################################################################# 2580#############################################################################
4909 2581
4910package CFPlus::UI::Image; 2582package DC::UI::Image;
4911 2583
4912our @ISA = CFPlus::UI::Base::; 2584our @ISA = DC::UI::Base::;
4913 2585
4914use CFPlus::OpenGL; 2586use DC::OpenGL;
4915 2587
4916our %texture_cache; 2588our %texture_cache;
4917 2589
4918sub new { 2590sub new {
4919 my $class = shift; 2591 my $class = shift;
4920 2592
4921 my $self = $class->SUPER::new ( 2593 my $self = $class->SUPER::new (
4922 can_events => 0, 2594 can_events => 0,
2595 scale => 1,
4923 @_, 2596 @_,
4924 ); 2597 );
4925 2598
4926 $self->{path} || $self->{tex} 2599 $self->{path} || $self->{tex}
4927 or Carp::croak "'path' or 'tex' attributes required"; 2600 or Carp::croak "'path' or 'tex' attributes required";
4928 2601
4929 $self->{tex} ||= $texture_cache{$self->{path}} ||= 2602 $self->{tex} ||= $texture_cache{$self->{path}} ||=
4930 new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1; 2603 new_from_file DC::Texture DC::find_rcfile $self->{path}, mipmap => 1;
4931 2604
4932 CFPlus::weaken $texture_cache{$self->{path}}; 2605 DC::weaken $texture_cache{$self->{path}};
4933 2606
4934 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; 2607 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
4935 2608
4936 $self 2609 $self
4937} 2610}
4938 2611
4939sub STORABLE_freeze { 2612sub STORABLE_freeze {
4940 my ($self, $cloning) = @_; 2613 my ($self, $cloning) = @_;
4941 2614
4942 $self->{path} 2615 $self->{path}
4943 or die "cannot serialise CFPlus::UI::Image on non-loadable images\n"; 2616 or die "cannot serialise DC::UI::Image on non-loadable images\n";
4944 2617
4945 $self->{path} 2618 $self->{path}
4946} 2619}
4947 2620
4948sub STORABLE_attach { 2621sub STORABLE_attach {
… …
4952} 2625}
4953 2626
4954sub size_request { 2627sub size_request {
4955 my ($self) = @_; 2628 my ($self) = @_;
4956 2629
4957 ($self->{tex}{w}, $self->{tex}{h}) 2630 (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
4958} 2631}
4959 2632
4960sub _draw { 2633sub _draw {
4961 my ($self) = @_; 2634 my ($self) = @_;
4962 2635
… …
4972 } 2645 }
4973 2646
4974 glEnable GL_TEXTURE_2D; 2647 glEnable GL_TEXTURE_2D;
4975 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2648 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
4976 2649
4977 $tex->draw_quad (0, 0, $w, $h); 2650 $tex->draw_quad_alpha (0, 0, $w, $h);
4978 2651
4979 glDisable GL_TEXTURE_2D; 2652 glDisable GL_TEXTURE_2D;
4980} 2653}
4981 2654
4982############################################################################# 2655#############################################################################
4983 2656
4984package CFPlus::UI::ImageButton; 2657package DC::UI::ImageButton;
4985 2658
4986our @ISA = CFPlus::UI::Image::; 2659our @ISA = DC::UI::Image::;
4987 2660
4988use CFPlus::OpenGL; 2661use DC::OpenGL;
4989 2662
4990my %textures; 2663my %textures;
4991 2664
4992sub new { 2665sub new {
4993 my $class = shift; 2666 my $class = shift;
… …
4996 padding_x => 4, 2669 padding_x => 4,
4997 padding_y => 4, 2670 padding_y => 4,
4998 fg => [1, 1, 1], 2671 fg => [1, 1, 1],
4999 active_fg => [0, 0, 1], 2672 active_fg => [0, 0, 1],
5000 can_hover => 1, 2673 can_hover => 1,
5001 align => 0, 2674 align => 0.5,
5002 valign => 0, 2675 valign => 0.5,
5003 can_events => 1, 2676 can_events => 1,
5004 @_ 2677 @_
5005 ); 2678 );
5006} 2679}
5007 2680
2681sub invoke_button_down {
2682 my ($self, $ev, $x, $y) = @_;
2683
2684 1
2685}
2686
5008sub invoke_button_up { 2687sub invoke_button_up {
5009 my ($self, $ev, $x, $y) = @_; 2688 my ($self, $ev, $x, $y) = @_;
5010 2689
5011 $self->emit ("activate") 2690 $self->emit ("activate")
5012 if $x >= 0 && $x < $self->{w} 2691 if $x >= 0 && $x < $self->{w}
… …
5015 1 2694 1
5016} 2695}
5017 2696
5018############################################################################# 2697#############################################################################
5019 2698
5020package CFPlus::UI::VGauge; 2699package DC::UI::VGauge;
5021 2700
5022our @ISA = CFPlus::UI::Base::; 2701our @ISA = DC::UI::Base::;
5023 2702
5024use List::Util qw(min max); 2703use List::Util qw(min max);
5025 2704
5026use CFPlus::OpenGL; 2705use DC::OpenGL;
5027 2706
5028my %tex = ( 2707my %tex = (
5029 food => [ 2708 food => [
5030 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2709 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
5031 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ 2710 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
5032 ], 2711 ],
5033 grace => [ 2712 grace => [
5034 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2713 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/ 2714 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
5036 ], 2715 ],
5037 hp => [ 2716 hp => [
5038 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2717 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
5039 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ 2718 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
5040 ], 2719 ],
5041 mana => [ 2720 mana => [
5042 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2721 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/ 2722 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
5044 ], 2723 ],
5045); 2724);
5046 2725
5047# eg. VGauge->new (gauge => 'food'), default gauge: food 2726# eg. VGauge->new (gauge => 'food'), default gauge: food
… …
5150 glDisable GL_TEXTURE_2D; 2829 glDisable GL_TEXTURE_2D;
5151} 2830}
5152 2831
5153############################################################################# 2832#############################################################################
5154 2833
2834package DC::UI::Progress;
2835
2836our @ISA = DC::UI::Label::;
2837
2838use DC::OpenGL;
2839
2840sub new {
2841 my ($class, %arg) = @_;
2842
2843 my $self = $class->SUPER::new (
2844 fg => [1, 1, 1],
2845 bg => [0, 0, 1, 0.2],
2846 bar => [0.7, 0.5, 0.1, 0.8],
2847 outline => [0.4, 0.3, 0],
2848 fontsize => 0.9,
2849 valign => 0.5,
2850 align => 0.5,
2851 can_events => 1,
2852 ellipsise => 1,
2853 label => "%d%%",
2854 %arg,
2855 );
2856
2857 $self->set_value ($arg{value} || -1);
2858
2859 $self
2860}
2861
2862sub set_label {
2863 my ($self, $label) = @_;
2864
2865 return if $self->{label} eq $label;
2866 $self->{label} = $label;
2867
2868 $self->DC::UI::Progress::set_value (0 + delete $self->{value});
2869}
2870
2871sub set_value {
2872 my ($self, $value) = @_;
2873
2874 if ($self->{value} ne $value) {
2875 $self->{value} = $value;
2876
2877 if ($value < 0) {
2878 $self->set_text ("-");
2879 } else {
2880 $self->set_text (sprintf $self->{label}, $value * 100);
2881 }
2882
2883 $self->update;
2884 }
2885}
2886
2887sub _draw {
2888 my ($self) = @_;
2889
2890 glEnable GL_BLEND;
2891 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2892
2893 if ($self->{value} >= 0) {
2894 my $s = int 2 + ($self->{w} - 4) * $self->{value};
2895
2896 glColor_premultiply @{$self->{bar}};
2897 glRect 2, 2, $s, $self->{h} - 2;
2898 glColor_premultiply @{$self->{bg}};
2899 glRect $s, 2, $self->{w} - 2, $self->{h} - 2;
2900 }
2901
2902 glColor_premultiply @{$self->{outline}};
2903 glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
2904
2905 glDisable GL_BLEND;
2906
2907 {
2908 local $self->{bg}; # do not draw background
2909 $self->SUPER::_draw;
2910 }
2911}
2912
2913#############################################################################
2914
2915package DC::UI::ExperienceProgress;
2916
2917our @ISA = DC::UI::Progress::;
2918
2919sub new {
2920 my ($class, %arg) = @_;
2921
2922 my $self = $class->SUPER::new (
2923 tooltip => sub {
2924 my ($self) = @_;
2925
2926 sprintf "level %d\n%s points\n%s next level\n%s to go",
2927 $self->{lvl},
2928 ::formsep ($self->{exp}),
2929 ::formsep ($self->{nxt}),
2930 ::formsep ($self->{nxt} - $self->{exp}),
2931 },
2932 %arg
2933 );
2934
2935 $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) }
2936 if $::CONN;
2937
2938 $self
2939}
2940
2941sub DESTROY {
2942 my ($self) = @_;
2943
2944 delete $::CONN->{on_exp_update}{$self+0}
2945 if $::CONN;
2946
2947 $self->SUPER::DESTROY;
2948}
2949
2950sub set_value {
2951 my ($self, $lvl, $exp) = @_;
2952
2953 $self->{lvl} = $lvl;
2954 $self->{exp} = $exp;
2955
2956 my $v = -1;
2957
2958 if ($::CONN && (my $table = $::CONN->{exp_table})) {
2959 my $l0 = $table->[$lvl - 1];
2960 my $l1 = $table->[$lvl];
2961
2962 $self->{nxt} = $l1;
2963
2964 $v = ($exp - $l0) / ($l1 - $l0);
2965 }
2966
2967 $self->SUPER::set_value ($v);
2968}
2969
2970#############################################################################
2971
5155package CFPlus::UI::Gauge; 2972package DC::UI::Gauge;
5156 2973
5157our @ISA = CFPlus::UI::VBox::; 2974our @ISA = DC::UI::VBox::;
5158 2975
5159sub new { 2976sub new {
5160 my ($class, %arg) = @_; 2977 my ($class, %arg) = @_;
5161 2978
5162 my $self = $class->SUPER::new ( 2979 my $self = $class->SUPER::new (
… …
5164 can_hover => 1, 2981 can_hover => 1,
5165 can_events => 1, 2982 can_events => 1,
5166 %arg, 2983 %arg,
5167 ); 2984 );
5168 2985
5169 $self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999"); 2986 $self->add ($self->{value} = new DC::UI::Label valign => 1, align => 0.5, template => "999");
5170 $self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1); 2987 $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"); 2988 $self->add ($self->{max} = new DC::UI::Label valign => 0, align => 0.5, template => "999");
5172 2989
5173 $self 2990 $self
5174} 2991}
5175 2992
5176sub set_fontsize { 2993sub set_fontsize {
… …
5197 $self->{value}->set_text ($val); 3014 $self->{value}->set_text ($val);
5198} 3015}
5199 3016
5200############################################################################# 3017#############################################################################
5201 3018
5202package CFPlus::UI::Slider; 3019package DC::UI::Slider;
5203 3020
5204use strict; 3021use strict;
5205 3022
5206use CFPlus::OpenGL; 3023use DC::OpenGL;
5207 3024
5208our @ISA = CFPlus::UI::DrawBG::; 3025our @ISA = DC::UI::DrawBG::;
5209 3026
5210my @tex = 3027my @tex =
5211 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ } 3028 map { new_from_file DC::Texture DC::find_rcfile $_ }
5212 qw(s1_slider.png s1_slider_bg.png); 3029 qw(s1_slider.png s1_slider_bg.png);
5213 3030
5214sub new { 3031sub new {
5215 my $class = shift; 3032 my $class = shift;
5216 3033
… …
5284 3101
5285 $self->SUPER::invoke_button_down ($ev, $x, $y); 3102 $self->SUPER::invoke_button_down ($ev, $x, $y);
5286 3103
5287 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 3104 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
5288 3105
5289 $self->invoke_mouse_motion ($ev, $x, $y) 3106 $self->invoke_mouse_motion ($ev, $x, $y);
3107
3108 1
5290} 3109}
5291 3110
5292sub invoke_mouse_motion { 3111sub invoke_mouse_motion {
5293 my ($self, $ev, $x, $y) = @_; 3112 my ($self, $ev, $x, $y) = @_;
5294 3113
… …
5310sub invoke_mouse_wheel { 3129sub invoke_mouse_wheel {
5311 my ($self, $ev) = @_; 3130 my ($self, $ev) = @_;
5312 3131
5313 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx}; 3132 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
5314 3133
5315 my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2; 3134 my $pagepart = $ev->{mod} & DC::KMOD_SHIFT ? 1 : 0.2;
5316 3135
5317 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart); 3136 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
5318 3137
5319 ! ! $delta 3138 1
5320} 3139}
5321 3140
5322sub update { 3141sub update {
5323 my ($self) = @_; 3142 my ($self) = @_;
5324 3143
… …
5373 glDisable GL_TEXTURE_2D; 3192 glDisable GL_TEXTURE_2D;
5374} 3193}
5375 3194
5376############################################################################# 3195#############################################################################
5377 3196
5378package CFPlus::UI::ValSlider; 3197package DC::UI::ValSlider;
5379 3198
5380our @ISA = CFPlus::UI::HBox::; 3199our @ISA = DC::UI::HBox::;
5381 3200
5382sub new { 3201sub new {
5383 my ($class, %arg) = @_; 3202 my ($class, %arg) = @_;
5384 3203
5385 my $range = delete $arg{range}; 3204 my $range = delete $arg{range};
5386 3205
5387 my $self = $class->SUPER::new ( 3206 my $self = $class->SUPER::new (
5388 slider => (new CFPlus::UI::Slider expand => 1, range => $range), 3207 slider => (new DC::UI::Slider expand => 1, range => $range),
5389 entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}), 3208 entry => (new DC::UI::Label text => "", template => delete $arg{template}),
5390 to_value => sub { shift }, 3209 to_value => sub { shift },
5391 from_value => sub { shift }, 3210 from_value => sub { shift },
5392 %arg, 3211 %arg,
5393 ); 3212 );
5394 3213
… …
5414sub set_range { shift->{slider}->set_range (@_) } 3233sub set_range { shift->{slider}->set_range (@_) }
5415sub set_value { shift->{slider}->set_value (@_) } 3234sub set_value { shift->{slider}->set_value (@_) }
5416 3235
5417############################################################################# 3236#############################################################################
5418 3237
5419package CFPlus::UI::TextScroller; 3238package DC::UI::TextScroller;
5420 3239
5421our @ISA = CFPlus::UI::HBox::; 3240our @ISA = DC::UI::HBox::;
5422 3241
5423use CFPlus::OpenGL; 3242use DC::OpenGL;
5424 3243
5425sub new { 3244sub new {
5426 my $class = shift; 3245 my $class = shift;
5427 3246
5428 my $self = $class->SUPER::new ( 3247 my $self = $class->SUPER::new (
… …
5430 can_events => 1, 3249 can_events => 1,
5431 indent => 0, 3250 indent => 0,
5432 #font => default_font 3251 #font => default_font
5433 @_, 3252 @_,
5434 3253
5435 layout => (new CFPlus::Layout), 3254 layout => (new DC::Layout),
5436 par => [], 3255 par => [],
5437 max_par => 0, 3256 max_par => 0,
5438 height => 0, 3257 height => 0,
5439 children => [ 3258 children => [
5440 (new CFPlus::UI::Empty expand => 1), 3259 (new DC::UI::Empty expand => 1),
5441 (new CFPlus::UI::Slider vertical => 1), 3260 (new DC::UI::Slider vertical => 1),
5442 ], 3261 ],
5443 ); 3262 );
5444 3263
5445 $self->{children}[1]->connect (changed => sub { $self->update }); 3264 $self->{children}[1]->connect (changed => sub { $self->update });
5446 3265
… …
5455} 3274}
5456 3275
5457sub size_request { 3276sub size_request {
5458 my ($self) = @_; 3277 my ($self) = @_;
5459 3278
5460 my ($empty, $slider) = @{ $self->{children} }; 3279 my ($empty, $slider) = $self->visible_children;
5461 3280
5462 local $self->{children} = [$empty, $slider]; 3281 local $self->{children} = [$empty, $slider];
5463 $self->SUPER::size_request 3282 $self->SUPER::size_request
5464} 3283}
5465 3284
… …
5502 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 3321 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
5503 $layout->set_markup ($para->{markup}); 3322 $layout->set_markup ($para->{markup});
5504 3323
5505 $layout->set_shapes ( 3324 $layout->set_shapes (
5506 map 3325 map
5507 +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}), 3326 +(0, $_->baseline_shift + $_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
5508 @{$para->{widget}} 3327 @{$para->{widget}}
5509 ); 3328 );
5510 3329
5511 $layout 3330 $layout
5512} 3331}
… …
5629 $ROOT->on_post_alloc ($self => sub { 3448 $ROOT->on_post_alloc ($self => sub {
5630 $self->force_uptodate; 3449 $self->force_uptodate;
5631 3450
5632 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 3451 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
5633 3452
5634 $self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub { 3453 $self->{texture} ||= new_from_opengl DC::Texture $W, $H, sub {
5635 glClearColor 0, 0, 0, 0; 3454 glClearColor 0, 0, 0, 0;
5636 glClear GL_COLOR_BUFFER_BIT; 3455 glClear GL_COLOR_BUFFER_BIT;
5637 3456
5638 package CFPlus::UI::Base; 3457 package DC::UI::Base;
5639 local ($draw_x, $draw_y, $draw_w, $draw_h) = 3458 local ($draw_x, $draw_y, $draw_w, $draw_h) =
5640 (0, 0, $self->{w}, $self->{h}); 3459 (0, 0, $self->{w}, $self->{h});
5641 3460
5642 my $top = int $self->{children}[1]{range}[0]; 3461 my $top = int $self->{children}[1]{range}[0];
5643 3462
… …
5654 3473
5655 if ($y0 < $y + $h && $y < $y1) { 3474 if ($y0 < $y + $h && $y < $y1) {
5656 my $layout = $self->get_layout ($para); 3475 my $layout = $self->get_layout ($para);
5657 3476
5658 $layout->render ($para->{indent}, $y - $y0); 3477 $layout->render ($para->{indent}, $y - $y0);
3478 $layout->draw;
5659 3479
5660 if (my @w = @{ $para->{widget} }) { 3480 if (my @w = @{ $para->{widget} }) {
5661 my @s = $layout->get_shapes; 3481 my @s = $layout->get_shapes;
5662 3482
5663 for (@w) { 3483 for (@w) {
… …
5701 $self->{children}[1]->draw; 3521 $self->{children}[1]->draw;
5702} 3522}
5703 3523
5704############################################################################# 3524#############################################################################
5705 3525
5706package CFPlus::UI::Animator; 3526package DC::UI::Animator;
5707 3527
5708use CFPlus::OpenGL; 3528use DC::OpenGL;
5709 3529
5710our @ISA = CFPlus::UI::Bin::; 3530our @ISA = DC::UI::Bin::;
5711 3531
5712sub moveto { 3532sub moveto {
5713 my ($self, $x, $y) = @_; 3533 my ($self, $x, $y) = @_;
5714 3534
5715 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 3535 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
… …
5743 glPopMatrix; 3563 glPopMatrix;
5744} 3564}
5745 3565
5746############################################################################# 3566#############################################################################
5747 3567
5748package CFPlus::UI::Flopper; 3568package DC::UI::Flopper;
5749 3569
5750our @ISA = CFPlus::UI::Button::; 3570our @ISA = DC::UI::Button::;
5751 3571
5752sub new { 3572sub new {
5753 my $class = shift; 3573 my $class = shift;
5754 3574
5755 my $self = $class->SUPER::new ( 3575 my $self = $class->SUPER::new (
… …
5767 $self->{other}->toggle_visibility; 3587 $self->{other}->toggle_visibility;
5768} 3588}
5769 3589
5770############################################################################# 3590#############################################################################
5771 3591
5772package CFPlus::UI::Tooltip; 3592package DC::UI::Tooltip;
5773 3593
5774our @ISA = CFPlus::UI::Bin::; 3594our @ISA = DC::UI::Bin::;
5775 3595
5776use CFPlus::OpenGL; 3596use DC::OpenGL;
5777 3597
5778sub new { 3598sub new {
5779 my $class = shift; 3599 my $class = shift;
5780 3600
5781 $class->SUPER::new ( 3601 $class->SUPER::new (
… …
5785} 3605}
5786 3606
5787sub set_tooltip_from { 3607sub set_tooltip_from {
5788 my ($self, $widget) = @_; 3608 my ($self, $widget) = @_;
5789 3609
5790 $widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
5791 if $widget->{tooltip} =~ /^#(.*)$/;
5792
5793 my $tooltip = $widget->{tooltip}; 3610 my $tip = $widget->{tooltip};
3611 $tip = $tip->($widget) if "CODE" eq ref $tip;
3612
3613 $tip = DC::Pod::section_label tooltip => $1
3614 if $tip =~ /^#(.*)$/;
5794 3615
5795 if ($ENV{CFPLUS_DEBUG} & 2) { 3616 if ($ENV{CFPLUS_DEBUG} & 2) {
5796 $tooltip .= "\n\n" . (ref $widget) . "\n" 3617 $tip .= "\n\n" . (ref $widget) . "\n"
5797 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" 3618 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
5798 . "req $widget->{req_w} $widget->{req_h}\n" 3619 . "req $widget->{req_w} $widget->{req_h}\n"
5799 . "visible $widget->{visible}"; 3620 . "visible $widget->{visible}";
5800 } 3621 }
5801 3622
5802 $tooltip =~ s/^\n+//; 3623 $tip =~ s/^\n+//;
5803 $tooltip =~ s/\n+$//; 3624 $tip =~ s/\n+$//;
5804 3625
5805 $self->add (new CFPlus::UI::Label 3626 $self->add (new DC::UI::Label
5806 markup => $tooltip, 3627 markup => $tip,
5807 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3628 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
3629 align => 0,
5808 fontsize => 0.8, 3630 fontsize => 0.8,
5809 style => 1, # FLAG_INVERSE 3631 style => 1, # FLAG_INVERSE
5810 ellipsise => 0, 3632 ellipsise => 0,
5811 font => ($widget->{tooltip_font} || $::FONT_PROP), 3633 font => ($widget->{tooltip_font} || $::FONT_PROP),
5812 ); 3634 );
… …
5849} 3671}
5850 3672
5851sub _draw { 3673sub _draw {
5852 my ($self) = @_; 3674 my ($self) = @_;
5853 3675
5854 glTranslate 0.375, 0.375;
5855
5856 my ($w, $h) = @$self{qw(w h)}; 3676 my ($w, $h) = @$self{qw(w h)};
5857 3677
5858 glColor 1, 0.8, 0.4; 3678 glColor 1, 0.8, 0.4;
5859 glBegin GL_QUADS; 3679 glRect 0, 0, $w, $h;
5860 glVertex 0 , 0;
5861 glVertex 0 , $h;
5862 glVertex $w, $h;
5863 glVertex $w, 0;
5864 glEnd;
5865 3680
5866 glColor 0, 0, 0; 3681 glColor 0, 0, 0;
5867 glBegin GL_LINE_LOOP; 3682 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 3683
5874 glTranslate 2 - 0.375, 2 - 0.375; 3684 glTranslate 2, 2;
5875 3685
5876 $self->SUPER::_draw; 3686 $self->SUPER::_draw;
5877} 3687}
5878 3688
5879############################################################################# 3689#############################################################################
5880 3690
5881package CFPlus::UI::Face; 3691package DC::UI::Face;
5882 3692
5883our @ISA = CFPlus::UI::DrawBG::; 3693our @ISA = DC::UI::DrawBG::;
5884 3694
5885use CFPlus::OpenGL; 3695use DC::OpenGL;
5886 3696
5887sub new { 3697sub new {
5888 my $class = shift; 3698 my $class = shift;
5889 3699
5890 my $self = $class->SUPER::new ( 3700 my $self = $class->SUPER::new (
… …
5894 can_events => 0, 3704 can_events => 0,
5895 @_, 3705 @_,
5896 ); 3706 );
5897 3707
5898 if ($self->{anim} && $self->{animspeed}) { 3708 if ($self->{anim} && $self->{animspeed}) {
5899 CFPlus::weaken (my $widget = $self); 3709 DC::weaken (my $widget = $self);
5900 3710
5901 $widget->{animspeed} = List::Util::max 0.05, $widget->{animspeed}; 3711 $self->{animspeed} = List::Util::max 0.05, $self->{animspeed};
5902 $widget->{anim_start} = $self->{animspeed} * Event::time / $self->{animspeed}; 3712 $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; 3713 return unless $::CONN;
5907 3714
3715 my $w = $widget
3716 or return;
3717
5908 ++$widget->{frame}; 3718 ++$w->{frame};
5909 $widget->update_face; 3719 $w->update_face;
3720
3721 # somehow, $widget can go away
5910 $widget->update; 3722 $w->update;
5911
5912 $widget->update_timer; 3723 $w->update_timer;
5913 },
5914 ); 3724 };
5915 3725
5916 $self->update_face; 3726 $self->update_face;
5917 $self->update_timer; 3727 $self->update_timer;
5918 } 3728 }
5919 3729
… …
5924 my ($self) = @_; 3734 my ($self) = @_;
5925 3735
5926 return unless $self->{timer}; 3736 return unless $self->{timer};
5927 3737
5928 if ($self->{visible}) { 3738 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; 3739 $self->{timer}->start;
5935 } else { 3740 } else {
5936 $self->{timer}->stop; 3741 $self->{timer}->stop;
5937 } 3742 }
5938} 3743}
5939 3744
5940sub update_face { 3745sub update_face {
5941 my ($self) = @_; 3746 my ($self) = @_;
5942 3747
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) { 3748 if ($::CONN) {
5957 if (my $faceid = $::CONN->{faceid}[$self->{face}]) { 3749 if (my $anim = $::CONN->{anim}[$self->{anim}]) {
5958 if (my $tex = $::CONN->{texture}[$faceid]) { 3750 if ($anim && @$anim) {
5959 return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h}); 3751 $self->{face} = $anim->[ $self->{frame} % @$anim ];
5960 } else { 3752 delete $self->{face_change_cb};
5961 $self->{wait_face} ||= $::CONN->connect_face_update ($faceid, sub { 3753
5962 $self->realloc; 3754 if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{face}[$self->{face}]{id} ]) {
3755 unless ($tex->{name} || $tex->{loading}) {
3756 $tex->upload (sub { $self->reconfigure });
3757 }
5963 }); 3758 }
5964 } 3759 }
5965 } 3760 }
5966 } 3761 }
3762}
3763
3764sub size_request {
3765 my ($self) = @_;
3766
3767 if ($::CONN) {
3768 if (my $faceid = $::CONN->{face}[$self->{face}]{id}) {
3769 if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
3770 if ($tex->{name}) {
3771 return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
3772 } elsif (!$tex->{loading}) {
3773 $tex->upload (sub { $self->reconfigure });
3774 }
3775 }
3776
3777 $self->{face_change_cb} ||= $::CONN->on_face_change ($self->{face}, sub { $self->reconfigure });
3778 }
3779 }
5967 3780
5968 ($self->{size_w} || 8, $self->{size_h} || 8) 3781 ($self->{size_w} || 8, $self->{size_h} || 8)
5969} 3782}
5970 3783
5971sub update { 3784sub update {
… …
5985} 3798}
5986 3799
5987sub _draw { 3800sub _draw {
5988 my ($self) = @_; 3801 my ($self) = @_;
5989 3802
5990 return unless $::CONN;
5991
5992 $self->SUPER::_draw; 3803 $self->SUPER::_draw;
5993 3804
5994 my $faceid = $::CONN->{faceid}[$self->{face}] 3805 if (my $tex = $self->{tex}) {
5995 or return;
5996
5997 my $tex = $::CONN->{texture}[$faceid];
5998
5999 if ($tex) {
6000 glEnable GL_TEXTURE_2D; 3806 glEnable GL_TEXTURE_2D;
6001 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 3807 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
6002 glColor 0, 0, 0, 1; 3808 glColor 0, 0, 0, 1;
6003 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3809 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
6004 glDisable GL_TEXTURE_2D; 3810 glDisable GL_TEXTURE_2D;
… …
6014 $self->SUPER::destroy; 3820 $self->SUPER::destroy;
6015} 3821}
6016 3822
6017############################################################################# 3823#############################################################################
6018 3824
6019package CFPlus::UI::Buttonbar; 3825package DC::UI::Buttonbar;
6020 3826
6021our @ISA = CFPlus::UI::HBox::; 3827our @ISA = DC::UI::HBox::;
6022 3828
6023# TODO: should actually wrap buttons and other goodies. 3829# TODO: should actually wrap buttons and other goodies.
6024 3830
6025############################################################################# 3831#############################################################################
6026 3832
6027package CFPlus::UI::Menu; 3833package DC::UI::Menu;
6028 3834
6029our @ISA = CFPlus::UI::Toplevel::; 3835our @ISA = DC::UI::Toplevel::;
6030 3836
6031use CFPlus::OpenGL; 3837use DC::OpenGL;
6032 3838
6033sub new { 3839sub new {
6034 my $class = shift; 3840 my $class = shift;
6035 3841
6036 my $self = $class->SUPER::new ( 3842 my $self = $class->SUPER::new (
6037 items => [], 3843 items => [],
6038 z => 100, 3844 z => 100,
6039 @_, 3845 @_,
6040 ); 3846 );
6041 3847
6042 $self->add ($self->{vbox} = new CFPlus::UI::VBox); 3848 $self->add ($self->{vbox} = new DC::UI::VBox);
6043 3849
6044 for my $item (@{ $self->{items} }) { 3850 for my $item (@{ $self->{items} }) {
6045 my ($widget, $cb, $tooltip) = @$item; 3851 my ($widget, $cb, $tooltip) = @$item;
6046 3852
6047 # handle various types of items, only text for now 3853 # handle various types of items, only text for now
6048 if (!ref $widget) { 3854 if (!ref $widget) {
6049 if ($widget =~ /\t/) { 3855 if ($widget =~ /\t/) {
6050 my ($left, $right) = split /\t/, $widget, 2; 3856 my ($left, $right) = split /\t/, $widget, 2;
6051 3857
6052 $widget = new CFPlus::UI::HBox 3858 $widget = new DC::UI::HBox
6053 can_hover => 1, 3859 can_hover => 1,
6054 can_events => 1, 3860 can_events => 1,
6055 tooltip => $tooltip, 3861 tooltip => $tooltip,
6056 children => [ 3862 children => [
6057 (new CFPlus::UI::Label markup => $left, expand => 1), 3863 (new DC::UI::Label markup => $left, expand => 1),
6058 (new CFPlus::UI::Label markup => $right, align => +1), 3864 (new DC::UI::Label markup => $right, align => 1),
6059 ], 3865 ],
6060 ; 3866 ;
6061 3867
6062 } else { 3868 } else {
6063 $widget = new CFPlus::UI::Label 3869 $widget = new DC::UI::Label
6064 can_hover => 1, 3870 can_hover => 1,
6065 can_events => 1, 3871 can_events => 1,
3872 align => 0,
6066 markup => $widget, 3873 markup => $widget,
6067 tooltip => $tooltip; 3874 tooltip => $tooltip;
6068 } 3875 }
6069 } 3876 }
6070 3877
… …
6116 1 3923 1
6117} 3924}
6118 3925
6119############################################################################# 3926#############################################################################
6120 3927
6121package CFPlus::UI::Multiplexer; 3928package DC::UI::Multiplexer;
6122 3929
6123our @ISA = CFPlus::UI::Container::; 3930our @ISA = DC::UI::Container::;
6124 3931
6125sub new { 3932sub new {
6126 my $class = shift; 3933 my $class = shift;
6127 3934
6128 my $self = $class->SUPER::new ( 3935 my $self = $class->SUPER::new (
… …
6189 $self->{current}->draw; 3996 $self->{current}->draw;
6190} 3997}
6191 3998
6192############################################################################# 3999#############################################################################
6193 4000
6194package CFPlus::UI::Notebook; 4001package DC::UI::Notebook;
6195 4002
4003use DC::OpenGL;
4004
6196our @ISA = CFPlus::UI::VBox::; 4005our @ISA = DC::UI::VBox::;
6197 4006
6198sub new { 4007sub new {
6199 my $class = shift; 4008 my $class = shift;
6200 4009
6201 my $self = $class->SUPER::new ( 4010 my $self = $class->SUPER::new (
6202 buttonbar => (new CFPlus::UI::Buttonbar), 4011 buttonbar => (new DC::UI::Buttonbar),
6203 multiplexer => (new CFPlus::UI::Multiplexer expand => 1), 4012 multiplexer => (new DC::UI::Multiplexer expand => 1),
4013 active_outline => [.7, .7, 0.2],
6204 # filter => # will be put between multiplexer and $self 4014 # filter => # will be put between multiplexer and $self
6205 @_, 4015 @_,
6206 ); 4016 );
6207 4017
6208 $self->{filter}->add ($self->{multiplexer}) if $self->{filter}; 4018 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
6209 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer}); 4019 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
6210 4020
4021 {
4022 Scalar::Util::weaken (my $wself = $self);
4023
4024 $self->{multiplexer}->connect (c_add => sub {
4025 my ($mplex, $widgets) = @_;
4026
4027 for my $child (@$widgets) {
4028 Scalar::Util::weaken $child;
4029 $child->{c_tab_} ||= do {
4030 my $tab =
4031 (UNIVERSAL::isa $child->{c_tab}, "DC::UI::Base")
4032 ? $child->{c_tab}
4033 : new DC::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
4034
4035 $tab->connect (activate => sub {
4036 $wself->set_current_page ($child);
4037 });
4038
4039 $tab
4040 };
4041
4042 $self->{buttonbar}->add ($child->{c_tab_});
4043 }
4044 });
4045
4046 $self->{multiplexer}->connect (c_remove => sub {
4047 my ($mplex, $widgets) = @_;
4048
4049 for my $child (@$widgets) {
4050 $wself->{buttonbar}->remove ($child->{c_tab_});
4051 }
4052 });
4053 }
4054
6211 $self 4055 $self
6212} 4056}
6213 4057
6214sub add { 4058sub add {
4059 my ($self, @widgets) = @_;
4060
4061 $self->{multiplexer}->add (@widgets)
4062}
4063
4064sub remove {
4065 my ($self, @widgets) = @_;
4066
4067 $self->{multiplexer}->remove (@widgets)
4068}
4069
4070sub pages {
4071 my ($self) = @_;
4072 $self->{multiplexer}->children
4073}
4074
4075sub page_index {
4076 my ($self, $widget) = @_;
4077
4078 my $i = 0;
4079 for ($self->pages) {
4080 if ($_ eq $widget) { return $i };
4081 $i++;
4082 }
4083
4084 undef
4085}
4086
4087sub add_tab {
6215 my ($self, $title, $widget, $tooltip) = @_; 4088 my ($self, $title, $widget, $tooltip) = @_;
6216 4089
6217 CFPlus::weaken $self; 4090 $title = [$title, $tooltip] unless ref $title;
4091 $widget->{c_tab} = $title;
6218 4092
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); 4093 $self->add ($widget);
6226} 4094}
6227 4095
6228sub get_current_page { 4096sub get_current_page {
6229 my ($self) = @_; 4097 my ($self) = @_;
6230 4098
… …
6236 4104
6237 $self->{multiplexer}->set_current_page ($page); 4105 $self->{multiplexer}->set_current_page ($page);
6238 $self->emit (page_changed => $self->{multiplexer}{current}); 4106 $self->emit (page_changed => $self->{multiplexer}{current});
6239} 4107}
6240 4108
4109sub _draw {
4110 my ($self) = @_;
4111
4112 $self->SUPER::_draw ();
4113
4114 if (my $cur = $self->{multiplexer}{current}) {
4115 if ($cur = $cur->{c_tab_}) {
4116 glTranslate $self->{buttonbar}{x} + $cur->{x},
4117 $self->{buttonbar}{y} + $cur->{y};
4118 glLineWidth 3;
4119 #glEnable GL_BLEND;
4120 #glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
4121 glColor @{$self->{active_outline}};
4122 glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
4123 glLineWidth 1;
4124 #glDisable GL_BLEND;
4125 }
4126 }
4127}
4128
6241############################################################################# 4129#############################################################################
6242 4130
6243package CFPlus::UI::Selector; 4131package DC::UI::Selector;
6244 4132
6245use utf8; 4133use utf8;
6246 4134
6247our @ISA = CFPlus::UI::Button::; 4135our @ISA = DC::UI::Button::;
6248 4136
6249sub new { 4137sub new {
6250 my $class = shift; 4138 my $class = shift;
6251 4139
6252 my $self = $class->SUPER::new ( 4140 my $self = $class->SUPER::new (
… …
6269 my ($value, $title, $tooltip) = @$_; 4157 my ($value, $title, $tooltip) = @$_;
6270 4158
6271 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }]; 4159 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
6272 } 4160 }
6273 4161
6274 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev); 4162 DC::UI::Menu->new (items => \@menu_items)->popup ($ev);
6275} 4163}
6276 4164
6277sub _set_value { 4165sub _set_value {
6278 my ($self, $value) = @_; 4166 my ($self, $value) = @_;
6279 4167
6280 my ($item) = grep $_->[0] eq $value, @{ $self->{options} } 4168 my ($item) = grep $_->[0] eq $value, @{ $self->{options} };
4169 $item ||= $self->{options}[0]
6281 or return; 4170 or return;
6282 4171
6283 $self->{value} = $item->[0]; 4172 $self->{value} = $item->[0];
6284 $self->set_markup ("$item->[1] ⇓"); 4173 $self->set_markup ("$item->[1] ⇓");
6285 $self->set_tooltip ($item->[2]); 4174# $self->set_tooltip ($item->[2]);
6286} 4175}
6287 4176
6288sub set_value { 4177sub set_value {
6289 my ($self, $value) = @_; 4178 my ($self, $value) = @_;
6290 4179
… …
6292 4181
6293 $self->_set_value ($value); 4182 $self->_set_value ($value);
6294 $self->emit (changed => $value); 4183 $self->emit (changed => $value);
6295} 4184}
6296 4185
4186sub set_options {
4187 my ($self, $options) = @_;
4188
4189 $self->{options} = $options;
4190 $self->_set_value ($self->{value});
4191}
4192
6297############################################################################# 4193#############################################################################
6298 4194
6299package CFPlus::UI::Statusbox; 4195package DC::UI::Statusbox;
6300 4196
6301our @ISA = CFPlus::UI::VBox::; 4197our @ISA = DC::UI::VBox::;
6302 4198
6303sub new { 4199sub new {
6304 my $class = shift; 4200 my $class = shift;
6305 4201
6306 my $self = $class->SUPER::new ( 4202 my $self = $class->SUPER::new (
6307 fontsize => 0.8, 4203 fontsize => 0.8,
6308 @_, 4204 @_,
6309 ); 4205 );
6310 4206
6311 CFPlus::weaken (my $this = $self); 4207 DC::weaken (my $this = $self);
6312 4208
6313 $self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder }); 4209 $self->{timer} = EV::timer 1, 1, sub { $this->reorder };
6314 4210
6315 $self 4211 $self
6316} 4212}
6317 4213
6318sub reorder { 4214sub reorder {
6319 my ($self) = @_; 4215 my ($self) = @_;
6320 my $NOW = Time::HiRes::time; 4216 my $NOW = Time::HiRes::time;
6321 4217
6322 # freeze display when hovering over any label 4218 # freeze display when hovering over any label
6323 return if $CFPlus::UI::TOOLTIP->{owner} 4219 return if $DC::UI::TOOLTIP->{owner}
6324 && grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label}, 4220 && grep $DC::UI::TOOLTIP->{owner} == $_->{label},
6325 values %{ $self->{item} }; 4221 values %{ $self->{item} };
6326 4222
6327 while (my ($k, $v) = each %{ $self->{item} }) { 4223 while (my ($k, $v) = each %{ $self->{item} }) {
6328 delete $self->{item}{$k} if $v->{timeout} < $NOW; 4224 delete $self->{item}{$k} if $v->{timeout} < $NOW;
6329 } 4225 }
4226
4227 $self->{timer}->set (1, 1);
6330 4228
6331 my @widgets; 4229 my @widgets;
6332 4230
6333 my @items = sort { 4231 my @items = sort {
6334 $a->{pri} <=> $b->{pri} 4232 $a->{pri} <=> $b->{pri}
6335 or $b->{id} <=> $a->{id} 4233 or $b->{id} <=> $a->{id}
6336 } values %{ $self->{item} }; 4234 } values %{ $self->{item} };
6337
6338 $self->{timer}->interval (1);
6339 4235
6340 my $count = 10 + 1; 4236 my $count = 10 + 1;
6341 for my $item (@items) { 4237 for my $item (@items) {
6342 last unless --$count; 4238 last unless --$count;
6343 4239
… …
6350 for ($short) { 4246 for ($short) {
6351 s/^\s+//; 4247 s/^\s+//;
6352 s/\s+/ /g; 4248 s/\s+/ /g;
6353 } 4249 }
6354 4250
6355 new CFPlus::UI::Label 4251 new DC::UI::Label
6356 markup => $short, 4252 markup => $short,
6357 tooltip => $item->{tooltip}, 4253 tooltip => $item->{tooltip},
6358 tooltip_font => $::FONT_PROP, 4254 tooltip_font => $::FONT_PROP,
6359 tooltip_width => 0.67, 4255 tooltip_width => 0.67,
6360 fontsize => $item->{fontsize} || $self->{fontsize}, 4256 fontsize => $item->{fontsize} || $self->{fontsize},
6361 max_w => $::WIDTH * 0.44, 4257 max_w => $::WIDTH * 0.44,
4258 align => 0,
6362 fg => [@{ $item->{fg} }], 4259 fg => [@{ $item->{fg} }],
6363 can_events => 1, 4260 can_events => 1,
6364 can_hover => 1 4261 can_hover => 1
6365 }; 4262 };
6366 4263
6367 if ((my $diff = $item->{timeout} - $NOW) < 2) { 4264 if ((my $diff = $item->{timeout} - $NOW) < 2) {
6368 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2; 4265 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
6369 $label->update; 4266 $label->update;
6370 $label->set_max_size (undef, $label->{req_h} * $diff) 4267 $label->set_max_size (undef, $label->{req_h} * $diff)
6371 if $diff < 1; 4268 if $diff < 1;
6372 $self->{timer}->interval (1/30); 4269 $self->{timer}->set (1/30, 1/30);
6373 } else { 4270 } else {
6374 $label->{fg}[3] = $item->{fg}[3] || 1; 4271 $label->{fg}[3] = $item->{fg}[3] || 1;
6375 } 4272 }
6376 4273
6377 push @widgets, $label; 4274 push @widgets, $label;
… …
6439 $self->SUPER::destroy; 4336 $self->SUPER::destroy;
6440} 4337}
6441 4338
6442############################################################################# 4339#############################################################################
6443 4340
6444package CFPlus::UI::Root; 4341package DC::UI::Root;
6445 4342
6446our @ISA = CFPlus::UI::Container::; 4343our @ISA = DC::UI::Container::;
6447 4344
6448use List::Util qw(min max); 4345use List::Util qw(min max);
6449 4346
6450use CFPlus::OpenGL; 4347use DC::OpenGL;
6451 4348
6452sub new { 4349sub new {
6453 my $class = shift; 4350 my $class = shift;
6454 4351
6455 my $self = $class->SUPER::new ( 4352 my $self = $class->SUPER::new (
6456 visible => 1, 4353 visible => 1,
6457 @_, 4354 @_,
6458 ); 4355 );
6459 4356
6460 CFPlus::weaken ($self->{root} = $self); 4357 DC::weaken ($self->{root} = $self);
6461 4358
6462 $self 4359 $self
6463} 4360}
6464 4361
6465sub size_request { 4362sub size_request {
… …
6513} 4410}
6514 4411
6515sub update { 4412sub update {
6516 my ($self) = @_; 4413 my ($self) = @_;
6517 4414
6518 $::WANT_REFRESH++; 4415 $::WANT_REFRESH = 1;
6519} 4416}
6520 4417
6521sub add { 4418sub add {
6522 my ($self, @children) = @_; 4419 my ($self, @children) = @_;
6523 4420
… …
6560 while ($self->{refresh_hook}) { 4457 while ($self->{refresh_hook}) {
6561 $_->() 4458 $_->()
6562 for values %{delete $self->{refresh_hook}}; 4459 for values %{delete $self->{refresh_hook}};
6563 } 4460 }
6564 4461
6565 if ($self->{realloc}) { 4462 while ($self->{realloc}) {
6566 my %queue; 4463 my %queue;
6567 my @queue; 4464 my @queue;
6568 my $widget; 4465 my $widget;
6569 4466
6570 outer: 4467 outer:
… …
6590 4487
6591 delete $queue{$widget+0}; 4488 delete $queue{$widget+0};
6592 4489
6593 my ($w, $h) = $widget->size_request; 4490 my ($w, $h) = $widget->size_request;
6594 4491
6595 $w = max $widget->{min_w}, $w + $widget->{padding_x} * 2; 4492 $w += $widget->{padding_x} * 2;
6596 $h = max $widget->{min_h}, $h + $widget->{padding_y} * 2; 4493 $h += $widget->{padding_y} * 2;
4494
4495 $w = max $widget->{min_w}, $w;
4496 $h = max $widget->{min_h}, $h;
6597 4497
6598 $w = min $widget->{max_w}, $w if exists $widget->{max_w}; 4498 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
6599 $h = min $widget->{max_h}, $h if exists $widget->{max_h}; 4499 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
6600 4500
6601 $w = $widget->{force_w} if exists $widget->{force_w}; 4501 $w = $widget->{force_w} if exists $widget->{force_w};
… …
6617 } 4517 }
6618 } 4518 }
6619 4519
6620 delete $self->{realloc}{$widget+0}; 4520 delete $self->{realloc}{$widget+0};
6621 } 4521 }
6622 }
6623 4522
6624 while (my $size_alloc = delete $self->{size_alloc}) { 4523 while (my $size_alloc = delete $self->{size_alloc}) {
6625 my @queue = sort { $b->{visible} <=> $a->{visible} } 4524 my @queue = sort { $a->{visible} <=> $b->{visible} }
6626 values %$size_alloc; 4525 values %$size_alloc;
6627 4526
6628 while () { 4527 while () {
6629 my $widget = pop @queue || last; 4528 my $widget = pop @queue || last;
6630 4529
6631 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 4530 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
6632 4531
6633 $w = 0 if $w < 0;
6634 $h = 0 if $h < 0;
6635
6636 $w = max $widget->{min_w}, $w; 4532 $w = max $widget->{min_w}, $w;
6637 $h = max $widget->{min_h}, $h; 4533 $h = max $widget->{min_h}, $h;
6638 4534
6639# $w = min $self->{w} - $widget->{x}, $w if $self->{w}; 4535# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
6640# $h = min $self->{h} - $widget->{y}, $h if $self->{h}; 4536# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
6641 4537
6642 $w = min $widget->{max_w}, $w if exists $widget->{max_w}; 4538 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
6643 $h = min $widget->{max_h}, $h if exists $widget->{max_h}; 4539 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
6644 4540
6645 $w = int $w + 0.5; 4541 $w = int $w + 0.5;
6646 $h = int $h + 0.5; 4542 $h = int $h + 0.5;
6647 4543
6648 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 4544 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
6649 $widget->{old_w} = $widget->{w}; 4545 $widget->{old_w} = $widget->{w};
6650 $widget->{old_h} = $widget->{h}; 4546 $widget->{old_h} = $widget->{h};
6651 4547
6652 $widget->{w} = $w; 4548 $widget->{w} = $w;
6653 $widget->{h} = $h; 4549 $widget->{h} = $h;
6654 4550
6655 $widget->emit (size_allocate => $w, $h); 4551 $widget->emit (size_allocate => $w, $h);
4552 }
6656 } 4553 }
6657 } 4554 }
6658 } 4555 }
6659 4556
6660 while ($self->{post_alloc_hook}) { 4557 while ($self->{post_alloc_hook}) {
… …
6671 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 4568 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
6672 glMatrixMode GL_MODELVIEW; 4569 glMatrixMode GL_MODELVIEW;
6673 glLoadIdentity; 4570 glLoadIdentity;
6674 4571
6675 { 4572 {
6676 package CFPlus::UI::Base; 4573 package DC::UI::Base;
6677 4574
6678 local ($draw_x, $draw_y, $draw_w, $draw_h) = 4575 local ($draw_x, $draw_y, $draw_w, $draw_h) =
6679 (0, 0, $self->{w}, $self->{h}); 4576 (0, 0, $self->{w}, $self->{h});
6680 4577
6681 $self->_draw; 4578 $self->_draw;
6682 } 4579 }
6683} 4580}
6684 4581
6685############################################################################# 4582#############################################################################
6686 4583
6687package CFPlus::UI; 4584package DC::UI;
6688 4585
6689$ROOT = new CFPlus::UI::Root; 4586$ROOT = new DC::UI::Root;
6690$TOOLTIP = new CFPlus::UI::Tooltip z => 900; 4587$TOOLTIP = new DC::UI::Tooltip z => 900;
6691 4588
66921 45891
6693 4590

Diff Legend

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