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.477 by root, Sun Jan 11 23:50:27 2009 UTC vs.
Revision 1.486 by root, Wed Nov 21 13:23:10 2012 UTC

1package DC::UI; 1package DC::UI;
2 2
3use utf8; 3use common::sense;
4use strict;
5 4
6use List::Util (); 5use List::Util ();
7 6
7use AnyEvent ();
8use Guard (); 8use Guard ();
9 9
10use DC; 10use DC;
11use DC::Pod; 11use DC::Pod;
12use DC::Texture; 12use DC::Texture;
… …
223 223
224############################################################################# 224#############################################################################
225 225
226package DC::UI::Base; 226package DC::UI::Base;
227 227
228use strict; 228use common::sense;
229 229
230use DC::OpenGL; 230use DC::OpenGL;
231 231
232sub new { 232sub new {
233 my $class = shift; 233 my $class = shift;
… …
363} 363}
364 364
365sub set_size { 365sub set_size {
366 my ($self, $w, $h) = @_; 366 my ($self, $w, $h) = @_;
367 367
368 $self->{force_w} = $w; 368 $self->{force_w} = List::Util::min $w, ($self->{max_w} || $::WIDTH );
369 $self->{force_h} = $h; 369 $self->{force_h} = List::Util::min $h, ($self->{max_h} || $::HEIGHT);
370 370
371 $self->realloc; 371 $self->realloc;
372} 372}
373 373
374# traverse the widget chain up to find the maximum "physical" size constraints 374# traverse the widget chain up to find the maximum "physical" size constraints
… …
643 643
644package DC::UI::DrawBG; 644package DC::UI::DrawBG;
645 645
646our @ISA = DC::UI::Base::; 646our @ISA = DC::UI::Base::;
647 647
648use strict; 648use common::sense;
649
649use DC::OpenGL; 650use DC::OpenGL;
650 651
651sub new { 652sub new {
652 my $class = shift; 653 my $class = shift;
653 654
… …
666} 667}
667 668
668sub _draw { 669sub _draw {
669 my ($self) = @_; 670 my ($self) = @_;
670 671
671 my $color = $FOCUS == $self && $self->{active_bg} 672 my $color = $FOCUS == $self
672 ? $self->{active_bg} 673 ? $self->{active_bg} || $self->{bg}
673 : $self->{bg}; 674 : $self->{bg};
674 675
675 if ($color && (@$color < 4 || $color->[3])) { 676 if ($color && (@$color < 4 || $color->[3])) {
676 my ($w, $h) = @$self{qw(w h)}; 677 my ($w, $h) = @$self{qw(w h)};
677 678
… …
1473 my ($self, $ev, $x, $y) = @_; 1474 my ($self, $ev, $x, $y) = @_;
1474 1475
1475 my ($w, $h) = @$self{qw(w h)}; 1476 my ($w, $h) = @$self{qw(w h)};
1476 my $border = $self->border; 1477 my $border = $self->border;
1477 1478
1478 my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w); 1479 my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w); # left-right
1479 my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h); 1480 my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h); # top-down
1480 1481
1481 if ($lr & $td) { 1482 if ($lr & $td) { # corners
1482 my ($wx, $wy) = ($self->{x}, $self->{y}); 1483 my ($wx, $wy) = ($self->{x}, $self->{y});
1483 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1484 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1484 my ($bw, $bh) = ($self->{w}, $self->{h}); 1485 my ($bw, $bh) = ($self->{w}, $self->{h});
1485 1486
1486 my $mx = $x < $border; 1487 my $mx = $x < $border;
… …
1490 my ($ev, $x, $y) = @_; 1491 my ($ev, $x, $y) = @_;
1491 1492
1492 my $dx = $ev->{x} - $ox; 1493 my $dx = $ev->{x} - $ox;
1493 my $dy = $ev->{y} - $oy; 1494 my $dy = $ev->{y} - $oy;
1494 1495
1496 $self->set_size (
1495 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1); 1497 $bw + $dx * ($mx ? -1 : 1),
1496 $self->{force_h} = $bh + $dy * ($my ? -1 : 1); 1498 $bh + $dy * ($my ? -1 : 1),
1499 );
1497 1500
1498 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my); 1501 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1499 $self->realloc; 1502 $self->realloc;
1500 }; 1503 };
1501 1504
1502 } elsif ($lr ^ $td) { 1505 } elsif ($lr ^ $td) { # edges
1503 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1506 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1504 my ($bx, $by) = ($self->{x}, $self->{y}); 1507 my ($bx, $by) = ($self->{x}, $self->{y});
1505 1508
1506 $self->{motion} = sub { 1509 $self->{motion} = sub {
1507 my ($ev, $x, $y) = @_; 1510 my ($ev, $x, $y) = @_;
… …
2594 2597
2595############################################################################# 2598#############################################################################
2596 2599
2597package DC::UI::Image; 2600package DC::UI::Image;
2598 2601
2599our @ISA = DC::UI::Base::; 2602our @ISA = DC::UI::DrawBG::;
2600 2603
2601use DC::OpenGL; 2604use DC::OpenGL;
2602 2605
2603our %texture_cache; 2606our %texture_cache;
2604 2607
… …
2637 my ($self, $cloning, $path) = @_; 2640 my ($self, $cloning, $path) = @_;
2638 2641
2639 $self->new (path => $path) 2642 $self->new (path => $path)
2640} 2643}
2641 2644
2645sub set_texture {
2646 my ($self, $tex) = @_;
2647
2648 $self->{tex} = $tex;
2649 $self->update;
2650}
2651
2642sub size_request { 2652sub size_request {
2643 my ($self) = @_; 2653 my ($self) = @_;
2644 2654
2645 (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale}) 2655 (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
2646} 2656}
2647 2657
2648sub _draw { 2658sub _draw {
2649 my ($self) = @_; 2659 my ($self) = @_;
2660
2661 $self->SUPER::_draw;
2650 2662
2651 my $tex = $self->{tex}; 2663 my $tex = $self->{tex};
2652 2664
2653 my ($w, $h) = ($self->{w}, $self->{h}); 2665 my ($w, $h) = ($self->{w}, $self->{h});
2654 2666
… …
2672package DC::UI::ImageButton; 2684package DC::UI::ImageButton;
2673 2685
2674our @ISA = DC::UI::Image::; 2686our @ISA = DC::UI::Image::;
2675 2687
2676use DC::OpenGL; 2688use DC::OpenGL;
2677
2678my %textures;
2679 2689
2680sub new { 2690sub new {
2681 my $class = shift; 2691 my $class = shift;
2682 2692
2683 my $self = $class->SUPER::new ( 2693 my $self = $class->SUPER::new (
… …
3047 3057
3048############################################################################# 3058#############################################################################
3049 3059
3050package DC::UI::Slider; 3060package DC::UI::Slider;
3051 3061
3052use strict; 3062use common::sense;
3053 3063
3054use DC::OpenGL; 3064use DC::OpenGL;
3055 3065
3056our @ISA = DC::UI::DrawBG::; 3066our @ISA = DC::UI::DrawBG::;
3057 3067
… …
3143 if ($GRAB == $self) { 3153 if ($GRAB == $self) {
3144 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 3154 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
3145 3155
3146 my (undef, $lo, $hi, $page) = @{$self->{range}}; 3156 my (undef, $lo, $hi, $page) = @{$self->{range}};
3147 3157
3148 $x = ($x - $self->{click}[1]) / ($w * $self->{scale}); 3158 $x = ($x - $self->{click}[1]) / ($w * $self->{scale} || 1e999);
3149 3159
3150 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); 3160 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
3151 } else { 3161 } else {
3152 return 0; 3162 return 0;
3153 } 3163 }
… …
3279 indent => 0, 3289 indent => 0,
3280 #font => default_font 3290 #font => default_font
3281 @_, 3291 @_,
3282 3292
3283 layout => (new DC::Layout), 3293 layout => (new DC::Layout),
3284 par => [],
3285 max_par => 0, 3294 max_par => 0,
3286 height => 0, 3295 height => 0,
3287 children => [ 3296 children => [
3288 (new DC::UI::Empty expand => 1), 3297 (new DC::UI::Empty expand => 1),
3289 (new DC::UI::Slider vertical => 1), 3298 (new DC::UI::Slider vertical => 1),
3290 ], 3299 ],
3291 ); 3300 );
3292 3301
3293 $self->{children}[1]->connect (changed => sub { $self->update }); 3302 $self->{children}[1]->connect (changed => sub { $self->update });
3303
3304 $self->add_paragraph (@{ delete $self->{par} }) if @{ $self->{par} };
3294 3305
3295 $self 3306 $self
3296} 3307}
3297 3308
3298sub set_fontsize { 3309sub set_fontsize {
… …
3631 @_, 3642 @_,
3632 can_events => 0, 3643 can_events => 0,
3633 ) 3644 )
3634} 3645}
3635 3646
3647# expand, as good as possible
3648sub _expand_doclets {
3649 my ($tip) = @_;
3650
3651 $tip =~ s{#\(([^)]+)\)}{
3652 if ($::CONN) {
3653 exists $::CONN->{doclet}{$1}
3654 ? $::CONN->{doclet}{$1}
3655 : "(waiting for server to show full text)"
3656 } else {
3657 "(unable to show full text without server connection)"
3658 }
3659 }ge;
3660
3661 $tip =~ s/^\n+//;
3662 $tip =~ s/\n+$//;
3663
3664 $tip
3665}
3666
3667# expands a tooltip, potentially multiple times remotely
3668# and returns a guard. clals the clalback each time the text changes.
3669sub expand_tooltip {
3670 my ($tip, $cb) = @_;
3671
3672 # first expand #name tooltips from local pod
3673 $tip = DC::Pod::section_label tooltip => $1
3674 if $tip =~ /^#([^(].*)$/;
3675
3676 my $active; # true if any remote requests outstanding
3677
3678 if ($::CONN && $::CONN->{addme_success}) {
3679 # now find all doclet references
3680 for my $doclet ($tip =~ /#\(([^)]+)\)/g) {
3681 unless (exists $::CONN->{doclet}{$doclet}) {
3682 # need to ask the server
3683 # we don't try to avoid duplicate requests
3684
3685 $active = 1;
3686 $::CONN->send_exti_req (doclet => (split /\//, $doclet, 2), sub {
3687 $::CONN->{doclet}{$doclet} = DC::sanitise_cfxml $_[0];
3688 $cb->(_expand_doclets $tip) if $active;
3689 });
3690 }
3691 }
3692 }
3693
3694 $cb->(_expand_doclets $tip);
3695
3696 $active and Guard::guard { undef $active }
3697}
3698
3636sub set_tooltip_from { 3699sub set_tooltip_from {
3637 my ($self, $widget) = @_; 3700 my ($self, $widget) = @_;
3638 3701
3639 my $tip = $widget->{tooltip}; 3702 my $tip = $widget->{tooltip};
3640 $tip = $tip->($widget) if "CODE" eq ref $tip; 3703 $tip = $tip->($widget) if "CODE" eq ref $tip;
3641
3642 $tip = DC::Pod::section_label tooltip => $1
3643 if $tip =~ /^#(.*)$/;
3644
3645 if ($ENV{CFPLUS_DEBUG} & 2) {
3646 $tip .= "\n\n" . (ref $widget) . "\n"
3647 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
3648 . "req $widget->{req_w} $widget->{req_h}\n"
3649 . "visible $widget->{visible}";
3650 }
3651
3652 $tip =~ s/^\n+//;
3653 $tip =~ s/\n+$//;
3654 3704
3655 $self->add (new DC::UI::Label 3705 $self->add (new DC::UI::Label
3656 fg => $DC::THEME{tooltip_fg}, 3706 fg => $DC::THEME{tooltip_fg},
3657 markup => $tip,
3658 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3707 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
3659 align => 0, 3708 align => 0,
3660 fontsize => 0.8, 3709 fontsize => 0.8,
3661 style => $DC::THEME{tooltip_style}, # FLAG_INVERSE 3710 style => $DC::THEME{tooltip_style}, # FLAG_INVERSE
3662 ellipsise => 0, 3711 ellipsise => 0,
3663 font => ($widget->{tooltip_font} || $::FONT_PROP), 3712 font => ($widget->{tooltip_font} || $::FONT_PROP),
3664 ); 3713 );
3714
3715 $self->{tooltip_expand} = expand_tooltip $tip, sub {
3716 my ($tip) = @_;
3717
3718 if ($ENV{CFPLUS_DEBUG} & 2) {
3719 $tip .= "\n\n" . (ref $widget) . "\n"
3720 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
3721 . "req $widget->{req_w} $widget->{req_h}\n"
3722 . "visible $widget->{visible}";
3723 }
3724
3725 $self->{children}[0]->set_markup ($tip);
3726 };
3665} 3727}
3666 3728
3667sub size_request { 3729sub size_request {
3668 my ($self) = @_; 3730 my ($self) = @_;
3669 3731
… …
4285 $self 4347 $self
4286} 4348}
4287 4349
4288sub reorder { 4350sub reorder {
4289 my ($self) = @_; 4351 my ($self) = @_;
4290 my $NOW = EV::time; 4352 my $NOW = AE::time;
4291 4353
4292 # freeze display when hovering over any label 4354 # freeze display when hovering over any label
4293 return if $DC::UI::TOOLTIP->{owner} 4355 return if $DC::UI::TOOLTIP->{owner}
4294 && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, 4356 && grep $DC::UI::TOOLTIP->{owner} == $_->{label},
4295 values %{ $self->{item} }; 4357 values %{ $self->{item} };
… …
4394 $ROOT->on_refresh (reorder => sub { 4456 $ROOT->on_refresh (reorder => sub {
4395 $self->reorder; 4457 $self->reorder;
4396 }); 4458 });
4397} 4459}
4398 4460
4461sub clr_group {
4462 my ($self, $group) = @_;
4463
4464 if (delete $self->{item}{$group}) {
4465 $ROOT->on_refresh (reorder => sub {
4466 $self->reorder;
4467 });
4468 }
4469}
4470
4399sub reconfigure { 4471sub reconfigure {
4400 my ($self) = @_; 4472 my ($self) = @_;
4401 4473
4402 delete $_->{label} 4474 delete $_->{label}
4403 for values %{ $self->{item} || {} }; 4475 for values %{ $self->{item} || {} };

Diff Legend

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