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.484 by root, Sun Jan 8 07:58:39 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 {
… …
4285 $self 4296 $self
4286} 4297}
4287 4298
4288sub reorder { 4299sub reorder {
4289 my ($self) = @_; 4300 my ($self) = @_;
4290 my $NOW = EV::time; 4301 my $NOW = AE::time;
4291 4302
4292 # freeze display when hovering over any label 4303 # freeze display when hovering over any label
4293 return if $DC::UI::TOOLTIP->{owner} 4304 return if $DC::UI::TOOLTIP->{owner}
4294 && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, 4305 && grep $DC::UI::TOOLTIP->{owner} == $_->{label},
4295 values %{ $self->{item} }; 4306 values %{ $self->{item} };
… …
4394 $ROOT->on_refresh (reorder => sub { 4405 $ROOT->on_refresh (reorder => sub {
4395 $self->reorder; 4406 $self->reorder;
4396 }); 4407 });
4397} 4408}
4398 4409
4410sub clr_group {
4411 my ($self, $group) = @_;
4412
4413 if (delete $self->{item}{$group}) {
4414 $ROOT->on_refresh (reorder => sub {
4415 $self->reorder;
4416 });
4417 }
4418}
4419
4399sub reconfigure { 4420sub reconfigure {
4400 my ($self) = @_; 4421 my ($self) = @_;
4401 4422
4402 delete $_->{label} 4423 delete $_->{label}
4403 for values %{ $self->{item} || {} }; 4424 for values %{ $self->{item} || {} };

Diff Legend

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