| … | |
… | |
| 2 | |
2 | |
| 3 | use common::sense; |
3 | use common::sense; |
| 4 | |
4 | |
| 5 | use List::Util (); |
5 | use List::Util (); |
| 6 | |
6 | |
|
|
7 | use AnyEvent (); |
| 7 | use Guard (); |
8 | use Guard (); |
| 8 | |
9 | |
| 9 | use DC; |
10 | use DC; |
| 10 | use DC::Pod; |
11 | use DC::Pod; |
| 11 | use DC::Texture; |
12 | use DC::Texture; |
| … | |
… | |
| 362 | } |
363 | } |
| 363 | |
364 | |
| 364 | sub set_size { |
365 | sub 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 | |
| 3305 | sub set_fontsize { |
3309 | sub set_fontsize { |
| … | |
… | |
| 4292 | $self |
4296 | $self |
| 4293 | } |
4297 | } |
| 4294 | |
4298 | |
| 4295 | sub reorder { |
4299 | sub reorder { |
| 4296 | my ($self) = @_; |
4300 | my ($self) = @_; |
| 4297 | my $NOW = EV::time; |
4301 | my $NOW = AE::time; |
| 4298 | |
4302 | |
| 4299 | # freeze display when hovering over any label |
4303 | # freeze display when hovering over any label |
| 4300 | return if $DC::UI::TOOLTIP->{owner} |
4304 | return if $DC::UI::TOOLTIP->{owner} |
| 4301 | && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, |
4305 | && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, |
| 4302 | values %{ $self->{item} }; |
4306 | values %{ $self->{item} }; |
| … | |
… | |
| 4401 | $ROOT->on_refresh (reorder => sub { |
4405 | $ROOT->on_refresh (reorder => sub { |
| 4402 | $self->reorder; |
4406 | $self->reorder; |
| 4403 | }); |
4407 | }); |
| 4404 | } |
4408 | } |
| 4405 | |
4409 | |
|
|
4410 | sub 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 | |
| 4406 | sub reconfigure { |
4420 | sub reconfigure { |
| 4407 | my ($self) = @_; |
4421 | my ($self) = @_; |
| 4408 | |
4422 | |
| 4409 | delete $_->{label} |
4423 | delete $_->{label} |
| 4410 | for values %{ $self->{item} || {} }; |
4424 | for values %{ $self->{item} || {} }; |
