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.459 by root, Sat Dec 29 13:44:30 2007 UTC

1package CFPlus::UI; 1package DC::UI;
2 2
3use utf8; 3use utf8;
4use strict; 4use strict;
5 5
6use List::Util (); 6use List::Util ();
7use Event;
8 7
9use CFPlus; 8use DC;
10use CFPlus::Pod; 9use DC::Pod;
11use CFPlus::Texture; 10use DC::Texture;
12 11
13our ($FOCUS, $HOVER, $GRAB); # various widgets 12our ($FOCUS, $HOVER, $GRAB); # various widgets
14 13
15our $LAYOUT; 14our $LAYOUT;
16our $ROOT; 15our $ROOT;
17our $TOOLTIP; 16our $TOOLTIP;
18our $BUTTON_STATE; 17our $BUTTON_STATE;
19 18
20our %WIDGET; # all widgets, weak-referenced 19our %WIDGET; # all widgets, weak-referenced
21 20
22our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub { 21our $TOOLTIP_WATCHER = EV::timer_ns 0, 0.03, sub {
22 $_[0]->stop;
23
23 if (!$GRAB) { 24 if (!$GRAB) {
24 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 25 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
25 if (length $widget->{tooltip}) { 26 if (length $widget->{tooltip}) {
26 if ($TOOLTIP->{owner} != $widget) { 27 if ($TOOLTIP->{owner} != $widget) {
27 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner}; 28 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
… …
30 $TOOLTIP->{owner} = $widget; 31 $TOOLTIP->{owner} = $widget;
31 $TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner}; 32 $TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner};
32 33
33 return if $ENV{CFPLUS_DEBUG} & 8; 34 return if $ENV{CFPLUS_DEBUG} & 8;
34 35
35 my $tip = $widget->{tooltip};
36
37 $tip = $tip->($widget) if CODE:: eq ref $tip;
38
39 $TOOLTIP->set_tooltip_from ($widget); 36 $TOOLTIP->set_tooltip_from ($widget);
40 $TOOLTIP->show; 37 $TOOLTIP->show;
41 } 38 }
42 39
43 return; 40 return;
… …
46 } 43 }
47 44
48 $TOOLTIP->hide; 45 $TOOLTIP->hide;
49 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner}; 46 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
50 delete $TOOLTIP->{owner}; 47 delete $TOOLTIP->{owner};
51}); 48};
52 49
53sub get_layout { 50sub get_layout {
54 my $layout; 51 my $layout;
55 52
56 for (grep { $_->{name} } values %WIDGET) { 53 for (grep { $_->{name} } values %WIDGET) {
… …
91 my $hover = $HOVER; $HOVER = $widget; 88 my $hover = $HOVER; $HOVER = $widget;
92 89
93 $hover->update if $hover && $hover->{can_hover}; 90 $hover->update if $hover && $hover->{can_hover};
94 $HOVER->update if $HOVER && $HOVER->{can_hover}; 91 $HOVER->update if $HOVER && $HOVER->{can_hover};
95 92
96 $TOOLTIP_WATCHER->start; 93 $TOOLTIP_WATCHER->again;
97 } 94 }
98} 95}
99 96
100sub feed_sdl_button_down_event { 97sub feed_sdl_button_down_event {
101 my ($ev) = @_; 98 my ($ev) = @_;
… …
107 my $widget = $ROOT->find_widget ($x, $y); 104 my $widget = $ROOT->find_widget ($x, $y);
108 105
109 $GRAB = $widget; 106 $GRAB = $widget;
110 $GRAB->update if $GRAB; 107 $GRAB->update if $GRAB;
111 108
112 $TOOLTIP_WATCHER->cb->(); 109 $TOOLTIP_WATCHER->invoke;
113 } 110 }
114 111
115 if ($GRAB) { 112 if ($GRAB) {
116 if ($ev->{button} == 4 || $ev->{button} == 5) { 113 if ($ev->{button} == 4 || $ev->{button} == 5) {
117 # mousewheel 114 # mousewheel
118 $ev->{dx} = 0;
119 $ev->{dy} = $ev->{button} * 2 - 9; 115 my $delta = $ev->{button} * 2 - 9;
116 my $shift = $ev->{mod} & DC::KMOD_SHIFT;
117
118 $ev->{dx} = $shift ? $delta : 0;
119 $ev->{dy} = $shift ? 0 : $delta;
120
120 $GRAB->emit (mouse_wheel => $ev); 121 $GRAB->emit (mouse_wheel => $ev);
121 } else { 122 } else {
122 $GRAB->emit (button_down => $ev) 123 $GRAB->emit (button_down => $ev)
123 } 124 }
124 } 125 }
… …
138 my $grab = $GRAB; undef $GRAB; 139 my $grab = $GRAB; undef $GRAB;
139 $grab->update if $grab; 140 $grab->update if $grab;
140 $GRAB->update if $GRAB; 141 $GRAB->update if $GRAB;
141 142
142 check_hover $widget; 143 check_hover $widget;
143 $TOOLTIP_WATCHER->cb->(); 144 $TOOLTIP_WATCHER->invoke;
144 } 145 }
145} 146}
146 147
147sub feed_sdl_motion_event { 148sub feed_sdl_motion_event {
148 my ($ev) = @_; 149 my ($ev) = @_;
… …
210 reconfigure_widgets; 211 reconfigure_widgets;
211} 212}
212 213
213############################################################################# 214#############################################################################
214 215
215package CFPlus::UI::Event; 216package DC::UI::Event;
216 217
217sub xy { 218sub xy {
218 $_[1]->coord2local ($_[0]{x}, $_[0]{y}) 219 $_[1]->coord2local ($_[0]{x}, $_[0]{y})
219} 220}
220 221
221############################################################################# 222#############################################################################
222 223
223package CFPlus::UI::Base; 224package DC::UI::Base;
224 225
225use strict; 226use strict;
226 227
227use CFPlus::OpenGL; 228use DC::OpenGL;
228 229
229sub new { 230sub new {
230 my $class = shift; 231 my $class = shift;
231 232
232 my $self = bless { 233 my $self = bless {
… …
237 h => undef, 238 h => undef,
238 can_events => 1, 239 can_events => 1,
239 @_ 240 @_
240 }, $class; 241 }, $class;
241 242
242 CFPlus::weaken ($CFPlus::UI::WIDGET{$self+0} = $self); 243 DC::weaken ($DC::UI::WIDGET{$self+0} = $self);
243 244
244 for (keys %$self) { 245 for (keys %$self) {
245 if (/^on_(.*)$/) { 246 if (/^on_(.*)$/) {
246 $self->connect ($1 => delete $self->{$_}); 247 $self->connect ($1 => delete $self->{$_});
247 } 248 }
248 } 249 }
249 250
250 if (my $layout = $CFPlus::UI::LAYOUT->{$self->{name}}) { 251 if (my $layout = $DC::UI::LAYOUT->{$self->{name}}) {
251 $self->{x} = $layout->{x} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{x}; 252 $self->{x} = $layout->{x} * $DC::UI::ROOT->{alloc_w} if exists $layout->{x};
252 $self->{y} = $layout->{y} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{y}; 253 $self->{y} = $layout->{y} * $DC::UI::ROOT->{alloc_h} if exists $layout->{y};
253 $self->{force_w} = $layout->{w} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{w}; 254 $self->{force_w} = $layout->{w} * $DC::UI::ROOT->{alloc_w} if exists $layout->{w};
254 $self->{force_h} = $layout->{h} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{h}; 255 $self->{force_h} = $layout->{h} * $DC::UI::ROOT->{alloc_h} if exists $layout->{h};
255 256
256 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x}; 257 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
257 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y}; 258 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
258 259
259 $self->show if $layout->{show}; 260 $self->show if $layout->{show};
… …
269 $self->emit ("destroy"); 270 $self->emit ("destroy");
270 %$self = (); 271 %$self = ();
271} 272}
272 273
273sub TO_JSON { 274sub TO_JSON {
274 { __widget_ref__ => $_[0]{s_id} } 275 { "\fw" => $_[0]{s_id} }
275} 276}
276 277
277sub show { 278sub show {
278 my ($self) = @_; 279 my ($self) = @_;
279 280
280 return if $self->{parent}; 281 return if $self->{parent};
281 282
282 $CFPlus::UI::ROOT->add ($self); 283 $DC::UI::ROOT->add ($self);
283} 284}
284 285
285sub set_visible { 286sub set_visible {
286 my ($self) = @_; 287 my ($self) = @_;
287 288
… …
308 delete $self->{root}; 309 delete $self->{root};
309 310
310 undef $GRAB if $GRAB == $self; 311 undef $GRAB if $GRAB == $self;
311 undef $HOVER if $HOVER == $self; 312 undef $HOVER if $HOVER == $self;
312 313
313 $CFPlus::UI::TOOLTIP_WATCHER->cb->() 314 $DC::UI::TOOLTIP_WATCHER->invoke
314 if $TOOLTIP->{owner} == $self; 315 if $TOOLTIP->{owner} == $self;
315 316
316 $self->emit ("focus_out"); 317 $self->emit ("focus_out");
317 $self->emit (visibility_change => 0); 318 $self->emit (visibility_change => 0);
318} 319}
… …
337sub hide { 338sub hide {
338 my ($self) = @_; 339 my ($self) = @_;
339 340
340 $self->set_invisible; 341 $self->set_invisible;
341 342
343 # extra $parent copy for 5.8.8+ bug workaround
344 # (otherwise $_[0] in remove gets freed
345 if (my $parent = $self->{parent}) {
342 $self->{parent}->remove ($self) 346 $parent->remove ($self);
343 if $self->{parent}; 347 }
344} 348}
345 349
346sub move_abs { 350sub move_abs {
347 my ($self, $x, $y, $z) = @_; 351 my ($self, $x, $y, $z) = @_;
348 352
… …
360 $self->{force_h} = $h; 364 $self->{force_h} = $h;
361 365
362 $self->realloc; 366 $self->realloc;
363} 367}
364 368
369# traverse the widget chain up to find the maximum "physical" size constraints
370sub get_max_wh {
371 my ($self) = @_;
372
373 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;
4695 2295
4696sub invoke_key_down { 2296sub invoke_key_down {
4697 my ($self, $ev) = @_; 2297 my ($self, $ev) = @_;
4698 2298
4699 my $sym = $ev->{sym}; 2299 my $sym = $ev->{sym};
… …
4705 $self->{history_pointer} = -1; 2305 $self->{history_pointer} = -1;
4706 $self->{history_saveback} = ''; 2306 $self->{history_saveback} = '';
4707 $self->emit (activate => $txt); 2307 $self->emit (activate => $txt);
4708 $self->update; 2308 $self->update;
4709 2309
4710 } elsif ($sym == CFPlus::SDLK_UP) { 2310 } elsif ($sym == DC::SDLK_UP) {
4711 if ($self->{history_pointer} < 0) { 2311 if ($self->{history_pointer} < 0) {
4712 $self->{history_saveback} = $self->get_text; 2312 $self->{history_saveback} = $self->get_text;
4713 } 2313 }
4714 if (@{$self->{history} || []} > 0) { 2314 if (@{$self->{history} || []} > 0) {
4715 $self->{history_pointer}++; 2315 $self->{history_pointer}++;
… …
4717 $self->{history_pointer} = @{$self->{history} || []} - 1; 2317 $self->{history_pointer} = @{$self->{history} || []} - 1;
4718 } 2318 }
4719 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2319 $self->set_text ($self->{history}->[$self->{history_pointer}]);
4720 } 2320 }
4721 2321
4722 } elsif ($sym == CFPlus::SDLK_DOWN) { 2322 } elsif ($sym == DC::SDLK_DOWN) {
4723 $self->{history_pointer}--; 2323 $self->{history_pointer}--;
4724 $self->{history_pointer} = -1 if $self->{history_pointer} < 0; 2324 $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
4725 2325
4726 if ($self->{history_pointer} >= 0) { 2326 if ($self->{history_pointer} >= 0) {
4727 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2327 $self->set_text ($self->{history}->[$self->{history_pointer}]);
… …
4736 1 2336 1
4737} 2337}
4738 2338
4739############################################################################# 2339#############################################################################
4740 2340
4741package CFPlus::UI::TextEdit; 2341package DC::UI::TextEdit;
4742 2342
4743our @ISA = CFPlus::UI::EntryBase::; 2343our @ISA = DC::UI::EntryBase::;
4744 2344
4745use CFPlus::OpenGL; 2345use DC::OpenGL;
2346
2347sub new {
2348 my $class = shift;
2349
2350 $class->SUPER::new (
2351 padding_y => 4,
2352
2353 @_
2354 )
2355}
4746 2356
4747sub move_cursor_ver { 2357sub move_cursor_ver {
4748 my ($self, $dy) = @_; 2358 my ($self, $dy) = @_;
4749 2359
4750 my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor}); 2360 my ($line, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
4751 2361
4752 $y += $dy; 2362 $line += $dy;
4753 2363
4754 if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) { 2364 if (defined (my $index = $self->{layout}->line_x_to_index ($line, $x))) {
4755 $self->{cursor} = $index; 2365 $self->{cursor} = $index;
4756 delete $self->{cur_h}; 2366 delete $self->{cur_h};
4757 $self->update; 2367 $self->update;
4758 return; 2368 return;
4759 } 2369 }
… …
4762sub invoke_key_down { 2372sub invoke_key_down {
4763 my ($self, $ev) = @_; 2373 my ($self, $ev) = @_;
4764 2374
4765 my $sym = $ev->{sym}; 2375 my $sym = $ev->{sym};
4766 2376
4767 if ($sym == CFPlus::SDLK_UP) { 2377 if ($sym == DC::SDLK_UP) {
4768 $self->move_cursor_ver (-1); 2378 $self->move_cursor_ver (-1);
4769 } elsif ($sym == CFPlus::SDLK_DOWN) { 2379 } elsif ($sym == DC::SDLK_DOWN) {
4770 $self->move_cursor_ver (+1); 2380 $self->move_cursor_ver (+1);
4771 } else { 2381 } else {
4772 return $self->SUPER::invoke_key_down ($ev) 2382 return $self->SUPER::invoke_key_down ($ev)
4773 } 2383 }
4774 2384
4775 1 2385 1
4776} 2386}
4777 2387
4778############################################################################# 2388#############################################################################
4779 2389
4780package CFPlus::UI::Button; 2390package DC::UI::ButtonBin;
4781 2391
4782our @ISA = CFPlus::UI::Label::; 2392our @ISA = DC::UI::Bin::;
4783 2393
4784use CFPlus::OpenGL; 2394use DC::OpenGL;
4785 2395
4786my @tex = 2396my @tex =
4787 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2397 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
4788 qw(b1_button_inactive.png b1_button_active.png); 2398 qw(b1_button_inactive.png b1_button_active.png);
4789 2399
4790sub new { 2400sub new {
4791 my $class = shift; 2401 my $class = shift;
4792 2402
4793 $class->SUPER::new ( 2403 $class->SUPER::new (
2404 can_hover => 1,
2405 align => 0.5,
2406 valign => 0.5,
2407 can_events => 1,
2408 @_
2409 )
2410}
2411
2412sub invoke_button_up {
2413 my ($self, $ev, $x, $y) = @_;
2414
2415 $self->emit ("activate")
2416 if $x >= 0 && $x < $self->{w}
2417 && $y >= 0 && $y < $self->{h};
2418
2419 1
2420}
2421
2422sub _draw {
2423 my ($self) = @_;
2424
2425 glEnable GL_TEXTURE_2D;
2426 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2427 glColor 0, 0, 0, 1;
2428
2429 my $tex = $tex[$GRAB == $self];
2430 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2431
2432 glDisable GL_TEXTURE_2D;
2433
2434 $self->SUPER::_draw;
2435}
2436
2437#############################################################################
2438
2439package DC::UI::Button;
2440
2441our @ISA = DC::UI::Label::;
2442
2443use DC::OpenGL;
2444
2445my @tex =
2446 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
2447 qw(b1_button_inactive.png b1_button_active.png);
2448
2449sub new {
2450 my $class = shift;
2451
2452 $class->SUPER::new (
4794 padding_x => 4, 2453 padding_x => 8,
4795 padding_y => 4, 2454 padding_y => 4,
4796 fg => [1.0, 1.0, 1.0], 2455 fg => [1.0, 1.0, 1.0],
4797 active_fg => [0.8, 0.8, 0.8], 2456 active_fg => [0.8, 0.8, 0.8],
4798 can_hover => 1, 2457 can_hover => 1,
4799 align => 0, 2458 align => 0.5,
4800 valign => 0, 2459 valign => 0.5,
4801 can_events => 1, 2460 can_events => 1,
4802 @_ 2461 @_
4803 ) 2462 )
4804} 2463}
4805 2464
… …
4830 $self->SUPER::_draw; 2489 $self->SUPER::_draw;
4831} 2490}
4832 2491
4833############################################################################# 2492#############################################################################
4834 2493
4835package CFPlus::UI::CheckBox; 2494package DC::UI::CheckBox;
4836 2495
4837our @ISA = CFPlus::UI::DrawBG::; 2496our @ISA = DC::UI::DrawBG::;
4838 2497
4839my @tex = 2498my @tex =
4840 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2499 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
4841 qw(c1_checkbox_bg.png c1_checkbox_active.png); 2500 qw(c1_checkbox_bg.png c1_checkbox_active.png);
4842 2501
4843use CFPlus::OpenGL; 2502use DC::OpenGL;
4844 2503
4845sub new { 2504sub new {
4846 my $class = shift; 2505 my $class = shift;
4847 2506
4848 $class->SUPER::new ( 2507 $class->SUPER::new (
… …
4888sub _draw { 2547sub _draw {
4889 my ($self) = @_; 2548 my ($self) = @_;
4890 2549
4891 $self->SUPER::_draw; 2550 $self->SUPER::_draw;
4892 2551
4893 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0; 2552 glTranslate $self->{padding_x}, $self->{padding_y}, 0;
4894 2553
4895 my ($w, $h) = @$self{qw(w h)}; 2554 my ($w, $h) = @$self{qw(w h)};
4896 2555
4897 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2; 2556 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
4898 2557
… …
4905 glDisable GL_TEXTURE_2D; 2564 glDisable GL_TEXTURE_2D;
4906} 2565}
4907 2566
4908############################################################################# 2567#############################################################################
4909 2568
4910package CFPlus::UI::Image; 2569package DC::UI::Image;
4911 2570
4912our @ISA = CFPlus::UI::Base::; 2571our @ISA = DC::UI::Base::;
4913 2572
4914use CFPlus::OpenGL; 2573use DC::OpenGL;
4915 2574
4916our %texture_cache; 2575our %texture_cache;
4917 2576
4918sub new { 2577sub new {
4919 my $class = shift; 2578 my $class = shift;
4920 2579
4921 my $self = $class->SUPER::new ( 2580 my $self = $class->SUPER::new (
4922 can_events => 0, 2581 can_events => 0,
2582 scale => 1,
4923 @_, 2583 @_,
4924 ); 2584 );
4925 2585
4926 $self->{path} || $self->{tex} 2586 $self->{path} || $self->{tex}
4927 or Carp::croak "'path' or 'tex' attributes required"; 2587 or Carp::croak "'path' or 'tex' attributes required";
4928 2588
4929 $self->{tex} ||= $texture_cache{$self->{path}} ||= 2589 $self->{tex} ||= $texture_cache{$self->{path}} ||=
4930 new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1; 2590 new_from_file DC::Texture DC::find_rcfile $self->{path}, mipmap => 1;
4931 2591
4932 CFPlus::weaken $texture_cache{$self->{path}}; 2592 DC::weaken $texture_cache{$self->{path}};
4933 2593
4934 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; 2594 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
4935 2595
4936 $self 2596 $self
4937} 2597}
4938 2598
4939sub STORABLE_freeze { 2599sub STORABLE_freeze {
4940 my ($self, $cloning) = @_; 2600 my ($self, $cloning) = @_;
4941 2601
4942 $self->{path} 2602 $self->{path}
4943 or die "cannot serialise CFPlus::UI::Image on non-loadable images\n"; 2603 or die "cannot serialise DC::UI::Image on non-loadable images\n";
4944 2604
4945 $self->{path} 2605 $self->{path}
4946} 2606}
4947 2607
4948sub STORABLE_attach { 2608sub STORABLE_attach {
… …
4952} 2612}
4953 2613
4954sub size_request { 2614sub size_request {
4955 my ($self) = @_; 2615 my ($self) = @_;
4956 2616
4957 ($self->{tex}{w}, $self->{tex}{h}) 2617 (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
4958} 2618}
4959 2619
4960sub _draw { 2620sub _draw {
4961 my ($self) = @_; 2621 my ($self) = @_;
4962 2622
… …
4972 } 2632 }
4973 2633
4974 glEnable GL_TEXTURE_2D; 2634 glEnable GL_TEXTURE_2D;
4975 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2635 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
4976 2636
4977 $tex->draw_quad (0, 0, $w, $h); 2637 $tex->draw_quad_alpha (0, 0, $w, $h);
4978 2638
4979 glDisable GL_TEXTURE_2D; 2639 glDisable GL_TEXTURE_2D;
4980} 2640}
4981 2641
4982############################################################################# 2642#############################################################################
4983 2643
4984package CFPlus::UI::ImageButton; 2644package DC::UI::ImageButton;
4985 2645
4986our @ISA = CFPlus::UI::Image::; 2646our @ISA = DC::UI::Image::;
4987 2647
4988use CFPlus::OpenGL; 2648use DC::OpenGL;
4989 2649
4990my %textures; 2650my %textures;
4991 2651
4992sub new { 2652sub new {
4993 my $class = shift; 2653 my $class = shift;
… …
4996 padding_x => 4, 2656 padding_x => 4,
4997 padding_y => 4, 2657 padding_y => 4,
4998 fg => [1, 1, 1], 2658 fg => [1, 1, 1],
4999 active_fg => [0, 0, 1], 2659 active_fg => [0, 0, 1],
5000 can_hover => 1, 2660 can_hover => 1,
5001 align => 0, 2661 align => 0.5,
5002 valign => 0, 2662 valign => 0.5,
5003 can_events => 1, 2663 can_events => 1,
5004 @_ 2664 @_
5005 ); 2665 );
5006} 2666}
5007 2667
2668sub invoke_button_down {
2669 my ($self, $ev, $x, $y) = @_;
2670
2671 1
2672}
2673
5008sub invoke_button_up { 2674sub invoke_button_up {
5009 my ($self, $ev, $x, $y) = @_; 2675 my ($self, $ev, $x, $y) = @_;
5010 2676
5011 $self->emit ("activate") 2677 $self->emit ("activate")
5012 if $x >= 0 && $x < $self->{w} 2678 if $x >= 0 && $x < $self->{w}
… …
5015 1 2681 1
5016} 2682}
5017 2683
5018############################################################################# 2684#############################################################################
5019 2685
5020package CFPlus::UI::VGauge; 2686package DC::UI::VGauge;
5021 2687
5022our @ISA = CFPlus::UI::Base::; 2688our @ISA = DC::UI::Base::;
5023 2689
5024use List::Util qw(min max); 2690use List::Util qw(min max);
5025 2691
5026use CFPlus::OpenGL; 2692use DC::OpenGL;
5027 2693
5028my %tex = ( 2694my %tex = (
5029 food => [ 2695 food => [
5030 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2696 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
5031 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ 2697 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
5032 ], 2698 ],
5033 grace => [ 2699 grace => [
5034 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2700 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/ 2701 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
5036 ], 2702 ],
5037 hp => [ 2703 hp => [
5038 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2704 map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 }
5039 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ 2705 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
5040 ], 2706 ],
5041 mana => [ 2707 mana => [
5042 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 } 2708 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/ 2709 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
5044 ], 2710 ],
5045); 2711);
5046 2712
5047# eg. VGauge->new (gauge => 'food'), default gauge: food 2713# eg. VGauge->new (gauge => 'food'), default gauge: food
… …
5150 glDisable GL_TEXTURE_2D; 2816 glDisable GL_TEXTURE_2D;
5151} 2817}
5152 2818
5153############################################################################# 2819#############################################################################
5154 2820
2821package DC::UI::Progress;
2822
2823our @ISA = DC::UI::Label::;
2824
2825use DC::OpenGL;
2826
2827sub new {
2828 my ($class, %arg) = @_;
2829
2830 my $self = $class->SUPER::new (
2831 fg => [1, 1, 1],
2832 bg => [0, 0, 1, 0.2],
2833 bar => [0.7, 0.5, 0.1, 0.8],
2834 outline => [0.4, 0.3, 0],
2835 fontsize => 0.9,
2836 valign => 0.5,
2837 align => 0.5,
2838 can_events => 1,
2839 ellipsise => 1,
2840 label => "%d%%",
2841 %arg,
2842 );
2843
2844 $self->set_value ($arg{value} || -1);
2845
2846 $self
2847}
2848
2849sub set_label {
2850 my ($self, $label) = @_;
2851
2852 return if $self->{label} eq $label;
2853 $self->{label} = $label;
2854
2855 $self->DC::UI::Progress::set_value (0 + delete $self->{value});
2856}
2857
2858sub set_value {
2859 my ($self, $value) = @_;
2860
2861 if ($self->{value} ne $value) {
2862 $self->{value} = $value;
2863
2864 if ($value < 0) {
2865 $self->set_text ("-");
2866 } else {
2867 $self->set_text (sprintf $self->{label}, $value * 100);
2868 }
2869
2870 $self->update;
2871 }
2872}
2873
2874sub _draw {
2875 my ($self) = @_;
2876
2877 glEnable GL_BLEND;
2878 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2879
2880 if ($self->{value} >= 0) {
2881 my $s = int 2 + ($self->{w} - 4) * $self->{value};
2882
2883 glColor_premultiply @{$self->{bar}};
2884 glRect 2, 2, $s, $self->{h} - 2;
2885 glColor_premultiply @{$self->{bg}};
2886 glRect $s, 2, $self->{w} - 2, $self->{h} - 2;
2887 }
2888
2889 glColor_premultiply @{$self->{outline}};
2890 glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
2891
2892 glDisable GL_BLEND;
2893
2894 {
2895 local $self->{bg}; # do not draw background
2896 $self->SUPER::_draw;
2897 }
2898}
2899
2900#############################################################################
2901
2902package DC::UI::ExperienceProgress;
2903
2904our @ISA = DC::UI::Progress::;
2905
2906sub new {
2907 my ($class, %arg) = @_;
2908
2909 my $self = $class->SUPER::new (
2910 tooltip => sub {
2911 my ($self) = @_;
2912
2913 sprintf "level %d\n%s points\n%s next level\n%s to go",
2914 $self->{lvl},
2915 ::formsep ($self->{exp}),
2916 ::formsep ($self->{nxt}),
2917 ::formsep ($self->{nxt} - $self->{exp}),
2918 },
2919 %arg
2920 );
2921
2922 $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) }
2923 if $::CONN;
2924
2925 $self
2926}
2927
2928sub DESTROY {
2929 my ($self) = @_;
2930
2931 delete $::CONN->{on_exp_update}{$self+0}
2932 if $::CONN;
2933
2934 $self->SUPER::DESTROY;
2935}
2936
2937sub set_value {
2938 my ($self, $lvl, $exp) = @_;
2939
2940 $self->{lvl} = $lvl;
2941 $self->{exp} = $exp;
2942
2943 my $v = -1;
2944
2945 if ($::CONN && (my $table = $::CONN->{exp_table})) {
2946 my $l0 = $table->[$lvl - 1];
2947 my $l1 = $table->[$lvl];
2948
2949 $self->{nxt} = $l1;
2950
2951 $v = ($exp - $l0) / ($l1 - $l0);
2952 }
2953
2954 $self->SUPER::set_value ($v);
2955}
2956
2957#############################################################################
2958
5155package CFPlus::UI::Gauge; 2959package DC::UI::Gauge;
5156 2960
5157our @ISA = CFPlus::UI::VBox::; 2961our @ISA = DC::UI::VBox::;
5158 2962
5159sub new { 2963sub new {
5160 my ($class, %arg) = @_; 2964 my ($class, %arg) = @_;
5161 2965
5162 my $self = $class->SUPER::new ( 2966 my $self = $class->SUPER::new (
… …
5164 can_hover => 1, 2968 can_hover => 1,
5165 can_events => 1, 2969 can_events => 1,
5166 %arg, 2970 %arg,
5167 ); 2971 );
5168 2972
5169 $self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999"); 2973 $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); 2974 $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"); 2975 $self->add ($self->{max} = new DC::UI::Label valign => 0, align => 0.5, template => "999");
5172 2976
5173 $self 2977 $self
5174} 2978}
5175 2979
5176sub set_fontsize { 2980sub set_fontsize {
… …
5197 $self->{value}->set_text ($val); 3001 $self->{value}->set_text ($val);
5198} 3002}
5199 3003
5200############################################################################# 3004#############################################################################
5201 3005
5202package CFPlus::UI::Slider; 3006package DC::UI::Slider;
5203 3007
5204use strict; 3008use strict;
5205 3009
5206use CFPlus::OpenGL; 3010use DC::OpenGL;
5207 3011
5208our @ISA = CFPlus::UI::DrawBG::; 3012our @ISA = DC::UI::DrawBG::;
5209 3013
5210my @tex = 3014my @tex =
5211 map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ } 3015 map { new_from_file DC::Texture DC::find_rcfile $_ }
5212 qw(s1_slider.png s1_slider_bg.png); 3016 qw(s1_slider.png s1_slider_bg.png);
5213 3017
5214sub new { 3018sub new {
5215 my $class = shift; 3019 my $class = shift;
5216 3020
… …
5284 3088
5285 $self->SUPER::invoke_button_down ($ev, $x, $y); 3089 $self->SUPER::invoke_button_down ($ev, $x, $y);
5286 3090
5287 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 3091 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
5288 3092
5289 $self->invoke_mouse_motion ($ev, $x, $y) 3093 $self->invoke_mouse_motion ($ev, $x, $y);
3094
3095 1
5290} 3096}
5291 3097
5292sub invoke_mouse_motion { 3098sub invoke_mouse_motion {
5293 my ($self, $ev, $x, $y) = @_; 3099 my ($self, $ev, $x, $y) = @_;
5294 3100
… …
5310sub invoke_mouse_wheel { 3116sub invoke_mouse_wheel {
5311 my ($self, $ev) = @_; 3117 my ($self, $ev) = @_;
5312 3118
5313 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx}; 3119 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
5314 3120
5315 my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2; 3121 my $pagepart = $ev->{mod} & DC::KMOD_SHIFT ? 1 : 0.2;
5316 3122
5317 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart); 3123 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
5318 3124
5319 ! ! $delta 3125 1
5320} 3126}
5321 3127
5322sub update { 3128sub update {
5323 my ($self) = @_; 3129 my ($self) = @_;
5324 3130
… …
5373 glDisable GL_TEXTURE_2D; 3179 glDisable GL_TEXTURE_2D;
5374} 3180}
5375 3181
5376############################################################################# 3182#############################################################################
5377 3183
5378package CFPlus::UI::ValSlider; 3184package DC::UI::ValSlider;
5379 3185
5380our @ISA = CFPlus::UI::HBox::; 3186our @ISA = DC::UI::HBox::;
5381 3187
5382sub new { 3188sub new {
5383 my ($class, %arg) = @_; 3189 my ($class, %arg) = @_;
5384 3190
5385 my $range = delete $arg{range}; 3191 my $range = delete $arg{range};
5386 3192
5387 my $self = $class->SUPER::new ( 3193 my $self = $class->SUPER::new (
5388 slider => (new CFPlus::UI::Slider expand => 1, range => $range), 3194 slider => (new DC::UI::Slider expand => 1, range => $range),
5389 entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}), 3195 entry => (new DC::UI::Label text => "", template => delete $arg{template}),
5390 to_value => sub { shift }, 3196 to_value => sub { shift },
5391 from_value => sub { shift }, 3197 from_value => sub { shift },
5392 %arg, 3198 %arg,
5393 ); 3199 );
5394 3200
… …
5414sub set_range { shift->{slider}->set_range (@_) } 3220sub set_range { shift->{slider}->set_range (@_) }
5415sub set_value { shift->{slider}->set_value (@_) } 3221sub set_value { shift->{slider}->set_value (@_) }
5416 3222
5417############################################################################# 3223#############################################################################
5418 3224
5419package CFPlus::UI::TextScroller; 3225package DC::UI::TextScroller;
5420 3226
5421our @ISA = CFPlus::UI::HBox::; 3227our @ISA = DC::UI::HBox::;
5422 3228
5423use CFPlus::OpenGL; 3229use DC::OpenGL;
5424 3230
5425sub new { 3231sub new {
5426 my $class = shift; 3232 my $class = shift;
5427 3233
5428 my $self = $class->SUPER::new ( 3234 my $self = $class->SUPER::new (
… …
5430 can_events => 1, 3236 can_events => 1,
5431 indent => 0, 3237 indent => 0,
5432 #font => default_font 3238 #font => default_font
5433 @_, 3239 @_,
5434 3240
5435 layout => (new CFPlus::Layout), 3241 layout => (new DC::Layout),
5436 par => [], 3242 par => [],
5437 max_par => 0, 3243 max_par => 0,
5438 height => 0, 3244 height => 0,
5439 children => [ 3245 children => [
5440 (new CFPlus::UI::Empty expand => 1), 3246 (new DC::UI::Empty expand => 1),
5441 (new CFPlus::UI::Slider vertical => 1), 3247 (new DC::UI::Slider vertical => 1),
5442 ], 3248 ],
5443 ); 3249 );
5444 3250
5445 $self->{children}[1]->connect (changed => sub { $self->update }); 3251 $self->{children}[1]->connect (changed => sub { $self->update });
5446 3252
… …
5455} 3261}
5456 3262
5457sub size_request { 3263sub size_request {
5458 my ($self) = @_; 3264 my ($self) = @_;
5459 3265
5460 my ($empty, $slider) = @{ $self->{children} }; 3266 my ($empty, $slider) = $self->visible_children;
5461 3267
5462 local $self->{children} = [$empty, $slider]; 3268 local $self->{children} = [$empty, $slider];
5463 $self->SUPER::size_request 3269 $self->SUPER::size_request
5464} 3270}
5465 3271
… …
5502 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 3308 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
5503 $layout->set_markup ($para->{markup}); 3309 $layout->set_markup ($para->{markup});
5504 3310
5505 $layout->set_shapes ( 3311 $layout->set_shapes (
5506 map 3312 map
5507 +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}), 3313 +(0, $_->baseline_shift + $_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
5508 @{$para->{widget}} 3314 @{$para->{widget}}
5509 ); 3315 );
5510 3316
5511 $layout 3317 $layout
5512} 3318}
… …
5629 $ROOT->on_post_alloc ($self => sub { 3435 $ROOT->on_post_alloc ($self => sub {
5630 $self->force_uptodate; 3436 $self->force_uptodate;
5631 3437
5632 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 3438 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
5633 3439
5634 $self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub { 3440 $self->{texture} ||= new_from_opengl DC::Texture $W, $H, sub {
5635 glClearColor 0, 0, 0, 0; 3441 glClearColor 0, 0, 0, 0;
5636 glClear GL_COLOR_BUFFER_BIT; 3442 glClear GL_COLOR_BUFFER_BIT;
5637 3443
5638 package CFPlus::UI::Base; 3444 package DC::UI::Base;
5639 local ($draw_x, $draw_y, $draw_w, $draw_h) = 3445 local ($draw_x, $draw_y, $draw_w, $draw_h) =
5640 (0, 0, $self->{w}, $self->{h}); 3446 (0, 0, $self->{w}, $self->{h});
5641 3447
5642 my $top = int $self->{children}[1]{range}[0]; 3448 my $top = int $self->{children}[1]{range}[0];
5643 3449
… …
5654 3460
5655 if ($y0 < $y + $h && $y < $y1) { 3461 if ($y0 < $y + $h && $y < $y1) {
5656 my $layout = $self->get_layout ($para); 3462 my $layout = $self->get_layout ($para);
5657 3463
5658 $layout->render ($para->{indent}, $y - $y0); 3464 $layout->render ($para->{indent}, $y - $y0);
3465 $layout->draw;
5659 3466
5660 if (my @w = @{ $para->{widget} }) { 3467 if (my @w = @{ $para->{widget} }) {
5661 my @s = $layout->get_shapes; 3468 my @s = $layout->get_shapes;
5662 3469
5663 for (@w) { 3470 for (@w) {
… …
5701 $self->{children}[1]->draw; 3508 $self->{children}[1]->draw;
5702} 3509}
5703 3510
5704############################################################################# 3511#############################################################################
5705 3512
5706package CFPlus::UI::Animator; 3513package DC::UI::Animator;
5707 3514
5708use CFPlus::OpenGL; 3515use DC::OpenGL;
5709 3516
5710our @ISA = CFPlus::UI::Bin::; 3517our @ISA = DC::UI::Bin::;
5711 3518
5712sub moveto { 3519sub moveto {
5713 my ($self, $x, $y) = @_; 3520 my ($self, $x, $y) = @_;
5714 3521
5715 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 3522 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
… …
5743 glPopMatrix; 3550 glPopMatrix;
5744} 3551}
5745 3552
5746############################################################################# 3553#############################################################################
5747 3554
5748package CFPlus::UI::Flopper; 3555package DC::UI::Flopper;
5749 3556
5750our @ISA = CFPlus::UI::Button::; 3557our @ISA = DC::UI::Button::;
5751 3558
5752sub new { 3559sub new {
5753 my $class = shift; 3560 my $class = shift;
5754 3561
5755 my $self = $class->SUPER::new ( 3562 my $self = $class->SUPER::new (
… …
5767 $self->{other}->toggle_visibility; 3574 $self->{other}->toggle_visibility;
5768} 3575}
5769 3576
5770############################################################################# 3577#############################################################################
5771 3578
5772package CFPlus::UI::Tooltip; 3579package DC::UI::Tooltip;
5773 3580
5774our @ISA = CFPlus::UI::Bin::; 3581our @ISA = DC::UI::Bin::;
5775 3582
5776use CFPlus::OpenGL; 3583use DC::OpenGL;
5777 3584
5778sub new { 3585sub new {
5779 my $class = shift; 3586 my $class = shift;
5780 3587
5781 $class->SUPER::new ( 3588 $class->SUPER::new (
… …
5785} 3592}
5786 3593
5787sub set_tooltip_from { 3594sub set_tooltip_from {
5788 my ($self, $widget) = @_; 3595 my ($self, $widget) = @_;
5789 3596
5790 $widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
5791 if $widget->{tooltip} =~ /^#(.*)$/;
5792
5793 my $tooltip = $widget->{tooltip}; 3597 my $tip = $widget->{tooltip};
3598 $tip = $tip->($widget) if "CODE" eq ref $tip;
3599
3600 $tip = DC::Pod::section_label tooltip => $1
3601 if $tip =~ /^#(.*)$/;
5794 3602
5795 if ($ENV{CFPLUS_DEBUG} & 2) { 3603 if ($ENV{CFPLUS_DEBUG} & 2) {
5796 $tooltip .= "\n\n" . (ref $widget) . "\n" 3604 $tip .= "\n\n" . (ref $widget) . "\n"
5797 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" 3605 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
5798 . "req $widget->{req_w} $widget->{req_h}\n" 3606 . "req $widget->{req_w} $widget->{req_h}\n"
5799 . "visible $widget->{visible}"; 3607 . "visible $widget->{visible}";
5800 } 3608 }
5801 3609
5802 $tooltip =~ s/^\n+//; 3610 $tip =~ s/^\n+//;
5803 $tooltip =~ s/\n+$//; 3611 $tip =~ s/\n+$//;
5804 3612
5805 $self->add (new CFPlus::UI::Label 3613 $self->add (new DC::UI::Label
5806 markup => $tooltip, 3614 markup => $tip,
5807 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3615 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
3616 align => 0,
5808 fontsize => 0.8, 3617 fontsize => 0.8,
5809 style => 1, # FLAG_INVERSE 3618 style => 1, # FLAG_INVERSE
5810 ellipsise => 0, 3619 ellipsise => 0,
5811 font => ($widget->{tooltip_font} || $::FONT_PROP), 3620 font => ($widget->{tooltip_font} || $::FONT_PROP),
5812 ); 3621 );
… …
5849} 3658}
5850 3659
5851sub _draw { 3660sub _draw {
5852 my ($self) = @_; 3661 my ($self) = @_;
5853 3662
5854 glTranslate 0.375, 0.375;
5855
5856 my ($w, $h) = @$self{qw(w h)}; 3663 my ($w, $h) = @$self{qw(w h)};
5857 3664
5858 glColor 1, 0.8, 0.4; 3665 glColor 1, 0.8, 0.4;
5859 glBegin GL_QUADS; 3666 glRect 0, 0, $w, $h;
5860 glVertex 0 , 0;
5861 glVertex 0 , $h;
5862 glVertex $w, $h;
5863 glVertex $w, 0;
5864 glEnd;
5865 3667
5866 glColor 0, 0, 0; 3668 glColor 0, 0, 0;
5867 glBegin GL_LINE_LOOP; 3669 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 3670
5874 glTranslate 2 - 0.375, 2 - 0.375; 3671 glTranslate 2, 2;
5875 3672
5876 $self->SUPER::_draw; 3673 $self->SUPER::_draw;
5877} 3674}
5878 3675
5879############################################################################# 3676#############################################################################
5880 3677
5881package CFPlus::UI::Face; 3678package DC::UI::Face;
5882 3679
5883our @ISA = CFPlus::UI::DrawBG::; 3680our @ISA = DC::UI::DrawBG::;
5884 3681
5885use CFPlus::OpenGL; 3682use DC::OpenGL;
5886 3683
5887sub new { 3684sub new {
5888 my $class = shift; 3685 my $class = shift;
5889 3686
5890 my $self = $class->SUPER::new ( 3687 my $self = $class->SUPER::new (
… …
5894 can_events => 0, 3691 can_events => 0,
5895 @_, 3692 @_,
5896 ); 3693 );
5897 3694
5898 if ($self->{anim} && $self->{animspeed}) { 3695 if ($self->{anim} && $self->{animspeed}) {
5899 CFPlus::weaken (my $widget = $self); 3696 DC::weaken (my $widget = $self);
5900 3697
5901 $widget->{animspeed} = List::Util::max 0.05, $widget->{animspeed}; 3698 $self->{animspeed} = List::Util::max 0.05, $self->{animspeed};
5902 $widget->{anim_start} = $self->{animspeed} * Event::time / $self->{animspeed}; 3699 $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; 3700 return unless $::CONN;
5907 3701
3702 my $w = $widget
3703 or return;
3704
5908 ++$widget->{frame}; 3705 ++$w->{frame};
5909 $widget->update_face; 3706 $w->update_face;
3707
3708 # somehow, $widget can go away
5910 $widget->update; 3709 $w->update;
5911
5912 $widget->update_timer; 3710 $w->update_timer;
5913 },
5914 ); 3711 };
5915 3712
5916 $self->update_face; 3713 $self->update_face;
5917 $self->update_timer; 3714 $self->update_timer;
5918 } 3715 }
5919 3716
… …
5924 my ($self) = @_; 3721 my ($self) = @_;
5925 3722
5926 return unless $self->{timer}; 3723 return unless $self->{timer};
5927 3724
5928 if ($self->{visible}) { 3725 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; 3726 $self->{timer}->start;
5935 } else { 3727 } else {
5936 $self->{timer}->stop; 3728 $self->{timer}->stop;
5937 } 3729 }
5938} 3730}
5939 3731
5940sub update_face { 3732sub update_face {
5941 my ($self) = @_; 3733 my ($self) = @_;
5942 3734
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) { 3735 if ($::CONN) {
5957 if (my $faceid = $::CONN->{faceid}[$self->{face}]) { 3736 if (my $anim = $::CONN->{anim}[$self->{anim}]) {
5958 if (my $tex = $::CONN->{texture}[$faceid]) { 3737 if ($anim && @$anim) {
5959 return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h}); 3738 $self->{face} = $anim->[ $self->{frame} % @$anim ];
5960 } else { 3739 delete $self->{face_change_cb};
5961 $self->{wait_face} ||= $::CONN->connect_face_update ($faceid, sub { 3740
5962 $self->realloc; 3741 if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{face}[$self->{face}]{id} ]) {
3742 unless ($tex->{name} || $tex->{loading}) {
3743 $tex->upload (sub { $self->reconfigure });
3744 }
5963 }); 3745 }
5964 } 3746 }
5965 } 3747 }
5966 } 3748 }
3749}
3750
3751sub size_request {
3752 my ($self) = @_;
3753
3754 if ($::CONN) {
3755 if (my $faceid = $::CONN->{face}[$self->{face}]{id}) {
3756 if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
3757 if ($tex->{name}) {
3758 return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
3759 } elsif (!$tex->{loading}) {
3760 $tex->upload (sub { $self->reconfigure });
3761 }
3762 }
3763
3764 $self->{face_change_cb} ||= $::CONN->on_face_change ($self->{face}, sub { $self->reconfigure });
3765 }
3766 }
5967 3767
5968 ($self->{size_w} || 8, $self->{size_h} || 8) 3768 ($self->{size_w} || 8, $self->{size_h} || 8)
5969} 3769}
5970 3770
5971sub update { 3771sub update {
… …
5985} 3785}
5986 3786
5987sub _draw { 3787sub _draw {
5988 my ($self) = @_; 3788 my ($self) = @_;
5989 3789
5990 return unless $::CONN;
5991
5992 $self->SUPER::_draw; 3790 $self->SUPER::_draw;
5993 3791
5994 my $faceid = $::CONN->{faceid}[$self->{face}] 3792 if (my $tex = $self->{tex}) {
5995 or return;
5996
5997 my $tex = $::CONN->{texture}[$faceid];
5998
5999 if ($tex) {
6000 glEnable GL_TEXTURE_2D; 3793 glEnable GL_TEXTURE_2D;
6001 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 3794 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
6002 glColor 0, 0, 0, 1; 3795 glColor 0, 0, 0, 1;
6003 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3796 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
6004 glDisable GL_TEXTURE_2D; 3797 glDisable GL_TEXTURE_2D;
… …
6014 $self->SUPER::destroy; 3807 $self->SUPER::destroy;
6015} 3808}
6016 3809
6017############################################################################# 3810#############################################################################
6018 3811
6019package CFPlus::UI::Buttonbar; 3812package DC::UI::Buttonbar;
6020 3813
6021our @ISA = CFPlus::UI::HBox::; 3814our @ISA = DC::UI::HBox::;
6022 3815
6023# TODO: should actually wrap buttons and other goodies. 3816# TODO: should actually wrap buttons and other goodies.
6024 3817
6025############################################################################# 3818#############################################################################
6026 3819
6027package CFPlus::UI::Menu; 3820package DC::UI::Menu;
6028 3821
6029our @ISA = CFPlus::UI::Toplevel::; 3822our @ISA = DC::UI::Toplevel::;
6030 3823
6031use CFPlus::OpenGL; 3824use DC::OpenGL;
6032 3825
6033sub new { 3826sub new {
6034 my $class = shift; 3827 my $class = shift;
6035 3828
6036 my $self = $class->SUPER::new ( 3829 my $self = $class->SUPER::new (
6037 items => [], 3830 items => [],
6038 z => 100, 3831 z => 100,
6039 @_, 3832 @_,
6040 ); 3833 );
6041 3834
6042 $self->add ($self->{vbox} = new CFPlus::UI::VBox); 3835 $self->add ($self->{vbox} = new DC::UI::VBox);
6043 3836
6044 for my $item (@{ $self->{items} }) { 3837 for my $item (@{ $self->{items} }) {
6045 my ($widget, $cb, $tooltip) = @$item; 3838 my ($widget, $cb, $tooltip) = @$item;
6046 3839
6047 # handle various types of items, only text for now 3840 # handle various types of items, only text for now
6048 if (!ref $widget) { 3841 if (!ref $widget) {
6049 if ($widget =~ /\t/) { 3842 if ($widget =~ /\t/) {
6050 my ($left, $right) = split /\t/, $widget, 2; 3843 my ($left, $right) = split /\t/, $widget, 2;
6051 3844
6052 $widget = new CFPlus::UI::HBox 3845 $widget = new DC::UI::HBox
6053 can_hover => 1, 3846 can_hover => 1,
6054 can_events => 1, 3847 can_events => 1,
6055 tooltip => $tooltip, 3848 tooltip => $tooltip,
6056 children => [ 3849 children => [
6057 (new CFPlus::UI::Label markup => $left, expand => 1), 3850 (new DC::UI::Label markup => $left, expand => 1),
6058 (new CFPlus::UI::Label markup => $right, align => +1), 3851 (new DC::UI::Label markup => $right, align => 1),
6059 ], 3852 ],
6060 ; 3853 ;
6061 3854
6062 } else { 3855 } else {
6063 $widget = new CFPlus::UI::Label 3856 $widget = new DC::UI::Label
6064 can_hover => 1, 3857 can_hover => 1,
6065 can_events => 1, 3858 can_events => 1,
3859 align => 0,
6066 markup => $widget, 3860 markup => $widget,
6067 tooltip => $tooltip; 3861 tooltip => $tooltip;
6068 } 3862 }
6069 } 3863 }
6070 3864
… …
6116 1 3910 1
6117} 3911}
6118 3912
6119############################################################################# 3913#############################################################################
6120 3914
6121package CFPlus::UI::Multiplexer; 3915package DC::UI::Multiplexer;
6122 3916
6123our @ISA = CFPlus::UI::Container::; 3917our @ISA = DC::UI::Container::;
6124 3918
6125sub new { 3919sub new {
6126 my $class = shift; 3920 my $class = shift;
6127 3921
6128 my $self = $class->SUPER::new ( 3922 my $self = $class->SUPER::new (
… …
6189 $self->{current}->draw; 3983 $self->{current}->draw;
6190} 3984}
6191 3985
6192############################################################################# 3986#############################################################################
6193 3987
6194package CFPlus::UI::Notebook; 3988package DC::UI::Notebook;
6195 3989
3990use DC::OpenGL;
3991
6196our @ISA = CFPlus::UI::VBox::; 3992our @ISA = DC::UI::VBox::;
6197 3993
6198sub new { 3994sub new {
6199 my $class = shift; 3995 my $class = shift;
6200 3996
6201 my $self = $class->SUPER::new ( 3997 my $self = $class->SUPER::new (
6202 buttonbar => (new CFPlus::UI::Buttonbar), 3998 buttonbar => (new DC::UI::Buttonbar),
6203 multiplexer => (new CFPlus::UI::Multiplexer expand => 1), 3999 multiplexer => (new DC::UI::Multiplexer expand => 1),
4000 active_outline => [.7, .7, 0.2],
6204 # filter => # will be put between multiplexer and $self 4001 # filter => # will be put between multiplexer and $self
6205 @_, 4002 @_,
6206 ); 4003 );
6207 4004
6208 $self->{filter}->add ($self->{multiplexer}) if $self->{filter}; 4005 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
6209 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer}); 4006 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
6210 4007
4008 {
4009 Scalar::Util::weaken (my $wself = $self);
4010
4011 $self->{multiplexer}->connect (c_add => sub {
4012 my ($mplex, $widgets) = @_;
4013
4014 for my $child (@$widgets) {
4015 Scalar::Util::weaken $child;
4016 $child->{c_tab_} ||= do {
4017 my $tab =
4018 (UNIVERSAL::isa $child->{c_tab}, "DC::UI::Base")
4019 ? $child->{c_tab}
4020 : new DC::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
4021
4022 $tab->connect (activate => sub {
4023 $wself->set_current_page ($child);
4024 });
4025
4026 $tab
4027 };
4028
4029 $self->{buttonbar}->add ($child->{c_tab_});
4030 }
4031 });
4032
4033 $self->{multiplexer}->connect (c_remove => sub {
4034 my ($mplex, $widgets) = @_;
4035
4036 for my $child (@$widgets) {
4037 $wself->{buttonbar}->remove ($child->{c_tab_});
4038 }
4039 });
4040 }
4041
6211 $self 4042 $self
6212} 4043}
6213 4044
6214sub add { 4045sub add {
4046 my ($self, @widgets) = @_;
4047
4048 $self->{multiplexer}->add (@widgets)
4049}
4050
4051sub remove {
4052 my ($self, @widgets) = @_;
4053
4054 $self->{multiplexer}->remove (@widgets)
4055}
4056
4057sub pages {
4058 my ($self) = @_;
4059 $self->{multiplexer}->children
4060}
4061
4062sub add_tab {
6215 my ($self, $title, $widget, $tooltip) = @_; 4063 my ($self, $title, $widget, $tooltip) = @_;
6216 4064
6217 CFPlus::weaken $self; 4065 $title = [$title, $tooltip] unless ref $title;
4066 $widget->{c_tab} = $title;
6218 4067
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); 4068 $self->add ($widget);
6226} 4069}
6227 4070
6228sub get_current_page { 4071sub get_current_page {
6229 my ($self) = @_; 4072 my ($self) = @_;
6230 4073
… …
6236 4079
6237 $self->{multiplexer}->set_current_page ($page); 4080 $self->{multiplexer}->set_current_page ($page);
6238 $self->emit (page_changed => $self->{multiplexer}{current}); 4081 $self->emit (page_changed => $self->{multiplexer}{current});
6239} 4082}
6240 4083
4084sub _draw {
4085 my ($self) = @_;
4086
4087 $self->SUPER::_draw ();
4088
4089 if (my $cur = $self->{multiplexer}{current}) {
4090 if ($cur = $cur->{c_tab_}) {
4091 glTranslate $self->{buttonbar}{x} + $cur->{x},
4092 $self->{buttonbar}{y} + $cur->{y};
4093 glLineWidth 3;
4094 #glEnable GL_BLEND;
4095 #glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
4096 glColor @{$self->{active_outline}};
4097 glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
4098 glLineWidth 1;
4099 #glDisable GL_BLEND;
4100 }
4101 }
4102}
4103
6241############################################################################# 4104#############################################################################
6242 4105
6243package CFPlus::UI::Selector; 4106package DC::UI::Selector;
6244 4107
6245use utf8; 4108use utf8;
6246 4109
6247our @ISA = CFPlus::UI::Button::; 4110our @ISA = DC::UI::Button::;
6248 4111
6249sub new { 4112sub new {
6250 my $class = shift; 4113 my $class = shift;
6251 4114
6252 my $self = $class->SUPER::new ( 4115 my $self = $class->SUPER::new (
… …
6269 my ($value, $title, $tooltip) = @$_; 4132 my ($value, $title, $tooltip) = @$_;
6270 4133
6271 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }]; 4134 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
6272 } 4135 }
6273 4136
6274 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev); 4137 DC::UI::Menu->new (items => \@menu_items)->popup ($ev);
6275} 4138}
6276 4139
6277sub _set_value { 4140sub _set_value {
6278 my ($self, $value) = @_; 4141 my ($self, $value) = @_;
6279 4142
6280 my ($item) = grep $_->[0] eq $value, @{ $self->{options} } 4143 my ($item) = grep $_->[0] eq $value, @{ $self->{options} };
4144 $item ||= $self->{options}[0]
6281 or return; 4145 or return;
6282 4146
6283 $self->{value} = $item->[0]; 4147 $self->{value} = $item->[0];
6284 $self->set_markup ("$item->[1] ⇓"); 4148 $self->set_markup ("$item->[1] ⇓");
6285 $self->set_tooltip ($item->[2]); 4149# $self->set_tooltip ($item->[2]);
6286} 4150}
6287 4151
6288sub set_value { 4152sub set_value {
6289 my ($self, $value) = @_; 4153 my ($self, $value) = @_;
6290 4154
… …
6292 4156
6293 $self->_set_value ($value); 4157 $self->_set_value ($value);
6294 $self->emit (changed => $value); 4158 $self->emit (changed => $value);
6295} 4159}
6296 4160
4161sub set_options {
4162 my ($self, $options) = @_;
4163
4164 $self->{options} = $options;
4165 $self->_set_value ($self->{value});
4166}
4167
6297############################################################################# 4168#############################################################################
6298 4169
6299package CFPlus::UI::Statusbox; 4170package DC::UI::Statusbox;
6300 4171
6301our @ISA = CFPlus::UI::VBox::; 4172our @ISA = DC::UI::VBox::;
6302 4173
6303sub new { 4174sub new {
6304 my $class = shift; 4175 my $class = shift;
6305 4176
6306 my $self = $class->SUPER::new ( 4177 my $self = $class->SUPER::new (
6307 fontsize => 0.8, 4178 fontsize => 0.8,
6308 @_, 4179 @_,
6309 ); 4180 );
6310 4181
6311 CFPlus::weaken (my $this = $self); 4182 DC::weaken (my $this = $self);
6312 4183
6313 $self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder }); 4184 $self->{timer} = EV::timer 1, 1, sub { $this->reorder };
6314 4185
6315 $self 4186 $self
6316} 4187}
6317 4188
6318sub reorder { 4189sub reorder {
6319 my ($self) = @_; 4190 my ($self) = @_;
6320 my $NOW = Time::HiRes::time; 4191 my $NOW = Time::HiRes::time;
6321 4192
6322 # freeze display when hovering over any label 4193 # freeze display when hovering over any label
6323 return if $CFPlus::UI::TOOLTIP->{owner} 4194 return if $DC::UI::TOOLTIP->{owner}
6324 && grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label}, 4195 && grep $DC::UI::TOOLTIP->{owner} == $_->{label},
6325 values %{ $self->{item} }; 4196 values %{ $self->{item} };
6326 4197
6327 while (my ($k, $v) = each %{ $self->{item} }) { 4198 while (my ($k, $v) = each %{ $self->{item} }) {
6328 delete $self->{item}{$k} if $v->{timeout} < $NOW; 4199 delete $self->{item}{$k} if $v->{timeout} < $NOW;
6329 } 4200 }
4201
4202 $self->{timer}->set (1, 1);
6330 4203
6331 my @widgets; 4204 my @widgets;
6332 4205
6333 my @items = sort { 4206 my @items = sort {
6334 $a->{pri} <=> $b->{pri} 4207 $a->{pri} <=> $b->{pri}
6335 or $b->{id} <=> $a->{id} 4208 or $b->{id} <=> $a->{id}
6336 } values %{ $self->{item} }; 4209 } values %{ $self->{item} };
6337
6338 $self->{timer}->interval (1);
6339 4210
6340 my $count = 10 + 1; 4211 my $count = 10 + 1;
6341 for my $item (@items) { 4212 for my $item (@items) {
6342 last unless --$count; 4213 last unless --$count;
6343 4214
… …
6350 for ($short) { 4221 for ($short) {
6351 s/^\s+//; 4222 s/^\s+//;
6352 s/\s+/ /g; 4223 s/\s+/ /g;
6353 } 4224 }
6354 4225
6355 new CFPlus::UI::Label 4226 new DC::UI::Label
6356 markup => $short, 4227 markup => $short,
6357 tooltip => $item->{tooltip}, 4228 tooltip => $item->{tooltip},
6358 tooltip_font => $::FONT_PROP, 4229 tooltip_font => $::FONT_PROP,
6359 tooltip_width => 0.67, 4230 tooltip_width => 0.67,
6360 fontsize => $item->{fontsize} || $self->{fontsize}, 4231 fontsize => $item->{fontsize} || $self->{fontsize},
6361 max_w => $::WIDTH * 0.44, 4232 max_w => $::WIDTH * 0.44,
4233 align => 0,
6362 fg => [@{ $item->{fg} }], 4234 fg => [@{ $item->{fg} }],
6363 can_events => 1, 4235 can_events => 1,
6364 can_hover => 1 4236 can_hover => 1
6365 }; 4237 };
6366 4238
6367 if ((my $diff = $item->{timeout} - $NOW) < 2) { 4239 if ((my $diff = $item->{timeout} - $NOW) < 2) {
6368 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2; 4240 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
6369 $label->update; 4241 $label->update;
6370 $label->set_max_size (undef, $label->{req_h} * $diff) 4242 $label->set_max_size (undef, $label->{req_h} * $diff)
6371 if $diff < 1; 4243 if $diff < 1;
6372 $self->{timer}->interval (1/30); 4244 $self->{timer}->set (1/30, 1/30);
6373 } else { 4245 } else {
6374 $label->{fg}[3] = $item->{fg}[3] || 1; 4246 $label->{fg}[3] = $item->{fg}[3] || 1;
6375 } 4247 }
6376 4248
6377 push @widgets, $label; 4249 push @widgets, $label;
… …
6439 $self->SUPER::destroy; 4311 $self->SUPER::destroy;
6440} 4312}
6441 4313
6442############################################################################# 4314#############################################################################
6443 4315
6444package CFPlus::UI::Root; 4316package DC::UI::Root;
6445 4317
6446our @ISA = CFPlus::UI::Container::; 4318our @ISA = DC::UI::Container::;
6447 4319
6448use List::Util qw(min max); 4320use List::Util qw(min max);
6449 4321
6450use CFPlus::OpenGL; 4322use DC::OpenGL;
6451 4323
6452sub new { 4324sub new {
6453 my $class = shift; 4325 my $class = shift;
6454 4326
6455 my $self = $class->SUPER::new ( 4327 my $self = $class->SUPER::new (
6456 visible => 1, 4328 visible => 1,
6457 @_, 4329 @_,
6458 ); 4330 );
6459 4331
6460 CFPlus::weaken ($self->{root} = $self); 4332 DC::weaken ($self->{root} = $self);
6461 4333
6462 $self 4334 $self
6463} 4335}
6464 4336
6465sub size_request { 4337sub size_request {
… …
6513} 4385}
6514 4386
6515sub update { 4387sub update {
6516 my ($self) = @_; 4388 my ($self) = @_;
6517 4389
6518 $::WANT_REFRESH++; 4390 $::WANT_REFRESH = 1;
6519} 4391}
6520 4392
6521sub add { 4393sub add {
6522 my ($self, @children) = @_; 4394 my ($self, @children) = @_;
6523 4395
… …
6560 while ($self->{refresh_hook}) { 4432 while ($self->{refresh_hook}) {
6561 $_->() 4433 $_->()
6562 for values %{delete $self->{refresh_hook}}; 4434 for values %{delete $self->{refresh_hook}};
6563 } 4435 }
6564 4436
6565 if ($self->{realloc}) { 4437 while ($self->{realloc}) {
6566 my %queue; 4438 my %queue;
6567 my @queue; 4439 my @queue;
6568 my $widget; 4440 my $widget;
6569 4441
6570 outer: 4442 outer:
… …
6590 4462
6591 delete $queue{$widget+0}; 4463 delete $queue{$widget+0};
6592 4464
6593 my ($w, $h) = $widget->size_request; 4465 my ($w, $h) = $widget->size_request;
6594 4466
6595 $w = max $widget->{min_w}, $w + $widget->{padding_x} * 2; 4467 $w += $widget->{padding_x} * 2;
6596 $h = max $widget->{min_h}, $h + $widget->{padding_y} * 2; 4468 $h += $widget->{padding_y} * 2;
4469
4470 $w = max $widget->{min_w}, $w;
4471 $h = max $widget->{min_h}, $h;
6597 4472
6598 $w = min $widget->{max_w}, $w if exists $widget->{max_w}; 4473 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
6599 $h = min $widget->{max_h}, $h if exists $widget->{max_h}; 4474 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
6600 4475
6601 $w = $widget->{force_w} if exists $widget->{force_w}; 4476 $w = $widget->{force_w} if exists $widget->{force_w};
… …
6617 } 4492 }
6618 } 4493 }
6619 4494
6620 delete $self->{realloc}{$widget+0}; 4495 delete $self->{realloc}{$widget+0};
6621 } 4496 }
6622 }
6623 4497
6624 while (my $size_alloc = delete $self->{size_alloc}) { 4498 while (my $size_alloc = delete $self->{size_alloc}) {
6625 my @queue = sort { $b->{visible} <=> $a->{visible} } 4499 my @queue = sort { $a->{visible} <=> $b->{visible} }
6626 values %$size_alloc; 4500 values %$size_alloc;
6627 4501
6628 while () { 4502 while () {
6629 my $widget = pop @queue || last; 4503 my $widget = pop @queue || last;
6630 4504
6631 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 4505 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
6632 4506
6633 $w = 0 if $w < 0;
6634 $h = 0 if $h < 0;
6635
6636 $w = max $widget->{min_w}, $w; 4507 $w = max $widget->{min_w}, $w;
6637 $h = max $widget->{min_h}, $h; 4508 $h = max $widget->{min_h}, $h;
6638 4509
6639# $w = min $self->{w} - $widget->{x}, $w if $self->{w}; 4510# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
6640# $h = min $self->{h} - $widget->{y}, $h if $self->{h}; 4511# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
6641 4512
6642 $w = min $widget->{max_w}, $w if exists $widget->{max_w}; 4513 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
6643 $h = min $widget->{max_h}, $h if exists $widget->{max_h}; 4514 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
6644 4515
6645 $w = int $w + 0.5; 4516 $w = int $w + 0.5;
6646 $h = int $h + 0.5; 4517 $h = int $h + 0.5;
6647 4518
6648 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 4519 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
6649 $widget->{old_w} = $widget->{w}; 4520 $widget->{old_w} = $widget->{w};
6650 $widget->{old_h} = $widget->{h}; 4521 $widget->{old_h} = $widget->{h};
6651 4522
6652 $widget->{w} = $w; 4523 $widget->{w} = $w;
6653 $widget->{h} = $h; 4524 $widget->{h} = $h;
6654 4525
6655 $widget->emit (size_allocate => $w, $h); 4526 $widget->emit (size_allocate => $w, $h);
4527 }
6656 } 4528 }
6657 } 4529 }
6658 } 4530 }
6659 4531
6660 while ($self->{post_alloc_hook}) { 4532 while ($self->{post_alloc_hook}) {
… …
6671 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 4543 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
6672 glMatrixMode GL_MODELVIEW; 4544 glMatrixMode GL_MODELVIEW;
6673 glLoadIdentity; 4545 glLoadIdentity;
6674 4546
6675 { 4547 {
6676 package CFPlus::UI::Base; 4548 package DC::UI::Base;
6677 4549
6678 local ($draw_x, $draw_y, $draw_w, $draw_h) = 4550 local ($draw_x, $draw_y, $draw_w, $draw_h) =
6679 (0, 0, $self->{w}, $self->{h}); 4551 (0, 0, $self->{w}, $self->{h});
6680 4552
6681 $self->_draw; 4553 $self->_draw;
6682 } 4554 }
6683} 4555}
6684 4556
6685############################################################################# 4557#############################################################################
6686 4558
6687package CFPlus::UI; 4559package DC::UI;
6688 4560
6689$ROOT = new CFPlus::UI::Root; 4561$ROOT = new DC::UI::Root;
6690$TOOLTIP = new CFPlus::UI::Tooltip z => 900; 4562$TOOLTIP = new DC::UI::Tooltip z => 900;
6691 4563
66921 45641
6693 4565

Diff Legend

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