| … | |
… | |
| 148 | sub configure { |
148 | sub configure { |
| 149 | my ($self, $x, $y, $w, $h) = @_; |
149 | my ($self, $x, $y, $w, $h) = @_; |
| 150 | |
150 | |
| 151 | $self->{x} = $x; |
151 | $self->{x} = $x; |
| 152 | $self->{y} = $y; |
152 | $self->{y} = $y; |
|
|
153 | |
|
|
154 | if ($self->{aspect}) { |
|
|
155 | $w = List::Util::min $w, int $h * $self->{aspect}; |
|
|
156 | $h = List::Util::min $h, int $w / $self->{aspect}; |
|
|
157 | } |
| 153 | |
158 | |
| 154 | return unless $self->{w} != $w || $self->{h} != $h; |
159 | return unless $self->{w} != $w || $self->{h} != $h; |
| 155 | |
160 | |
| 156 | $self->{w} = $w; |
161 | $self->{w} = $w; |
| 157 | $self->{h} = $h; |
162 | $self->{h} = $h; |
| … | |
… | |
| 660 | my $border = $self->border; |
665 | my $border = $self->border; |
| 661 | |
666 | |
| 662 | if ($x < $self->{w} && $x >= $self->{w} - $border |
667 | if ($x < $self->{w} && $x >= $self->{w} - $border |
| 663 | && $y < $self->{h} && $y >= $self->{h} - $border) { |
668 | && $y < $self->{h} && $y >= $self->{h} - $border) { |
| 664 | |
669 | |
| 665 | my ($ox, $oy) = ($ev->button_x, $ev->button_y); |
670 | my ($ox, $oy) = ($ev->{x}, $ev->{y}); |
| 666 | my ($bw, $bh) = ($self->{w}, $self->{h}); |
671 | my ($bw, $bh) = ($self->{w}, $self->{h}); |
| 667 | |
672 | |
| 668 | $self->{motion} = sub { |
673 | $self->{motion} = sub { |
| 669 | my ($ev, $x, $y) = @_; |
674 | my ($ev, $x, $y) = @_; |
| 670 | |
675 | |
| 671 | ($x, $y) = ($ev->motion_x, $ev->motion_y); |
676 | ($x, $y) = ($ev->{x}, $ev->{y}); |
| 672 | |
677 | |
| 673 | $self->{user_w} = $bw + $x - $ox; |
678 | $self->{user_w} = $bw + $x - $ox; |
| 674 | $self->{user_h} = $bh + $y - $oy; |
679 | $self->{user_h} = $bh + $y - $oy; |
| 675 | $self->check_size; |
680 | $self->check_size; |
| 676 | }; |
681 | }; |
| 677 | |
682 | |
| 678 | } elsif ($x >= 0 && $x < $self->{w} |
683 | } elsif ($x >= 0 && $x < $self->{w} |
| 679 | && $y >= 0 && $y < $border) { |
684 | && $y >= 0 && $y < $border) { |
| 680 | |
685 | |
| 681 | my ($ox, $oy) = ($ev->button_x, $ev->button_y); |
686 | my ($ox, $oy) = ($ev->{x}, $ev->{y}); |
| 682 | my ($bx, $by) = ($self->{x}, $self->{y}); |
687 | my ($bx, $by) = ($self->{x}, $self->{y}); |
| 683 | |
688 | |
| 684 | $self->{motion} = sub { |
689 | $self->{motion} = sub { |
| 685 | my ($ev, $x, $y) = @_; |
690 | my ($ev, $x, $y) = @_; |
| 686 | |
691 | |
| 687 | ($x, $y) = ($ev->motion_x, $ev->motion_y); |
692 | ($x, $y) = ($ev->{x}, $ev->{y}); |
| 688 | |
693 | |
| 689 | $self->move ($bx + $x - $ox, $by + $y - $oy); |
694 | $self->move ($bx + $x - $ox, $by + $y - $oy); |
| 690 | $self->update; |
695 | $self->update; |
| 691 | }; |
696 | }; |
| 692 | } |
697 | } |
| … | |
… | |
| 1449 | |
1454 | |
| 1450 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
1455 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
| 1451 | sub new { |
1456 | sub new { |
| 1452 | my $class = shift; |
1457 | my $class = shift; |
| 1453 | |
1458 | |
| 1454 | my $self = $class->SUPER::new (gauge => 'food', @_); |
1459 | my $self = $class->SUPER::new ( |
|
|
1460 | gauge => 'food', |
|
|
1461 | @_ |
|
|
1462 | ); |
|
|
1463 | |
|
|
1464 | $self->{aspect} = $tex{$self->{gauge}}[0]{w} / $tex{$self->{gauge}}[0]{h}; |
| 1455 | |
1465 | |
| 1456 | $self |
1466 | $self |
| 1457 | } |
1467 | } |
| 1458 | |
1468 | |
| 1459 | sub size_request { |
1469 | sub size_request { |
