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.481 by root, Tue Oct 12 05:11:38 2010 UTC vs.
Revision 1.486 by root, Wed Nov 21 13:23:10 2012 UTC

2 2
3use common::sense; 3use common::sense;
4 4
5use List::Util (); 5use List::Util ();
6 6
7use AnyEvent ();
7use Guard (); 8use Guard ();
8 9
9use DC; 10use DC;
10use DC::Pod; 11use DC::Pod;
11use DC::Texture; 12use DC::Texture;
362} 363}
363 364
364sub set_size { 365sub set_size {
365 my ($self, $w, $h) = @_; 366 my ($self, $w, $h) = @_;
366 367
367 $self->{force_w} = $w; 368 $self->{force_w} = List::Util::min $w, ($self->{max_w} || $::WIDTH );
368 $self->{force_h} = $h; 369 $self->{force_h} = List::Util::min $h, ($self->{max_h} || $::HEIGHT);
369 370
370 $self->realloc; 371 $self->realloc;
371} 372}
372 373
373# 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
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) = @_;
3286 indent => 0, 3289 indent => 0,
3287 #font => default_font 3290 #font => default_font
3288 @_, 3291 @_,
3289 3292
3290 layout => (new DC::Layout), 3293 layout => (new DC::Layout),
3291 par => [],
3292 max_par => 0, 3294 max_par => 0,
3293 height => 0, 3295 height => 0,
3294 children => [ 3296 children => [
3295 (new DC::UI::Empty expand => 1), 3297 (new DC::UI::Empty expand => 1),
3296 (new DC::UI::Slider vertical => 1), 3298 (new DC::UI::Slider vertical => 1),
3297 ], 3299 ],
3298 ); 3300 );
3299 3301
3300 $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} };
3301 3305
3302 $self 3306 $self
3303} 3307}
3304 3308
3305sub set_fontsize { 3309sub set_fontsize {
3638 @_, 3642 @_,
3639 can_events => 0, 3643 can_events => 0,
3640 ) 3644 )
3641} 3645}
3642 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
3643sub set_tooltip_from { 3699sub set_tooltip_from {
3644 my ($self, $widget) = @_; 3700 my ($self, $widget) = @_;
3645 3701
3646 my $tip = $widget->{tooltip}; 3702 my $tip = $widget->{tooltip};
3647 $tip = $tip->($widget) if "CODE" eq ref $tip; 3703 $tip = $tip->($widget) if "CODE" eq ref $tip;
3648
3649 $tip = DC::Pod::section_label tooltip => $1
3650 if $tip =~ /^#(.*)$/;
3651
3652 if ($ENV{CFPLUS_DEBUG} & 2) {
3653 $tip .= "\n\n" . (ref $widget) . "\n"
3654 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
3655 . "req $widget->{req_w} $widget->{req_h}\n"
3656 . "visible $widget->{visible}";
3657 }
3658
3659 $tip =~ s/^\n+//;
3660 $tip =~ s/\n+$//;
3661 3704
3662 $self->add (new DC::UI::Label 3705 $self->add (new DC::UI::Label
3663 fg => $DC::THEME{tooltip_fg}, 3706 fg => $DC::THEME{tooltip_fg},
3664 markup => $tip,
3665 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3707 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
3666 align => 0, 3708 align => 0,
3667 fontsize => 0.8, 3709 fontsize => 0.8,
3668 style => $DC::THEME{tooltip_style}, # FLAG_INVERSE 3710 style => $DC::THEME{tooltip_style}, # FLAG_INVERSE
3669 ellipsise => 0, 3711 ellipsise => 0,
3670 font => ($widget->{tooltip_font} || $::FONT_PROP), 3712 font => ($widget->{tooltip_font} || $::FONT_PROP),
3671 ); 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 };
3672} 3727}
3673 3728
3674sub size_request { 3729sub size_request {
3675 my ($self) = @_; 3730 my ($self) = @_;
3676 3731
4292 $self 4347 $self
4293} 4348}
4294 4349
4295sub reorder { 4350sub reorder {
4296 my ($self) = @_; 4351 my ($self) = @_;
4297 my $NOW = EV::time; 4352 my $NOW = AE::time;
4298 4353
4299 # freeze display when hovering over any label 4354 # freeze display when hovering over any label
4300 return if $DC::UI::TOOLTIP->{owner} 4355 return if $DC::UI::TOOLTIP->{owner}
4301 && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, 4356 && grep $DC::UI::TOOLTIP->{owner} == $_->{label},
4302 values %{ $self->{item} }; 4357 values %{ $self->{item} };
4401 $ROOT->on_refresh (reorder => sub { 4456 $ROOT->on_refresh (reorder => sub {
4402 $self->reorder; 4457 $self->reorder;
4403 }); 4458 });
4404} 4459}
4405 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
4406sub reconfigure { 4471sub reconfigure {
4407 my ($self) = @_; 4472 my ($self) = @_;
4408 4473
4409 delete $_->{label} 4474 delete $_->{label}
4410 for values %{ $self->{item} || {} }; 4475 for values %{ $self->{item} || {} };

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines