diff options
Diffstat (limited to 'src/MTools')
| -rw-r--r-- | src/MTools/Comp/MMover.pm | 20 | ||||
| -rw-r--r-- | src/MTools/Comp/MWritable.pm | 61 |
2 files changed, 56 insertions, 25 deletions
diff --git a/src/MTools/Comp/MMover.pm b/src/MTools/Comp/MMover.pm index 7346e83..a2a5b9c 100644 --- a/src/MTools/Comp/MMover.pm +++ b/src/MTools/Comp/MMover.pm @@ -66,6 +66,8 @@ sub new { $self -> recordEvent ('PRESSED_OFF'); $self -> recordEvent ('MOVED_OFF'); $self -> recordEvent ('RELEASED_OFF'); + $self -> recordEvent ('MOVED_OUT_OF_BOUNDS'); + $button = 1 if ! defined $button; binding ($src, "<Button-$button>", [\&__pressed, $self, Ev('x'), Ev('y'), Ev('t')]); @@ -90,12 +92,23 @@ sub setPos { @targets = @{$tgs}; for (my $i = 0; $i < @targets; $i++) { - $targets [$i] -> $translate_cbk ($dx, $dy); + my $obj = $targets [$i]; + if(ref ($obj) ne '') { + $obj -> $translate_cbk ($dx, $dy); + } + else { + $zinc -> $translate_cbk ($obj, $dx, $dy); + } } } else { - $tgs -> $translate_cbk ($dx, $dy); + if(ref ($tgs) ne '') { + $tgs -> $translate_cbk ($dx, $dy); + } + else { + $zinc -> $translate_cbk ($tgs, $dx, $dy); + } } $self -> mconfigure ('x', $x); $self -> mconfigure ('y', $y); @@ -159,6 +172,7 @@ sub __moved { } if( $dx == 0 && $dy == 0 ) { + $self -> notify ('MOVED_OUT_OF_BOUNDS', $x, $y, $t); return; } my $allower = $self -> mget ('allower'); @@ -171,6 +185,7 @@ sub __moved { $dy -= $ddy; if( $dx == 0 && $dy == 0 ) { + $self -> notify ('MOVED_OUT_OF_BOUNDS', $x, $y, $t); return; } } @@ -184,6 +199,7 @@ sub __moved { sub __released { my ($self, $x, $y, $t) = @_; + $self -> {__started} = 0; if (!$self -> mget('-visible')) { $self -> notify ('RELEASED_OFF', $x, $y, $t); diff --git a/src/MTools/Comp/MWritable.pm b/src/MTools/Comp/MWritable.pm index f4826b3..bdbfe0d 100644 --- a/src/MTools/Comp/MWritable.pm +++ b/src/MTools/Comp/MWritable.pm @@ -251,47 +251,62 @@ sub erase { } } sub getArrayFromCurves { - my ($self,$format) = @_; + my ($self, $format, $firstCurveIndex, $lastCurveIndex) = @_; my @tab = (); if (defined $self -> {__curves}) { my @curves = @{$self -> {__curves}}; - for (my $i = $#curves; $i >= 0 ; $i --) + if (defined $format && $format eq "RECO") { - my $single = ""; - my @points = $zinc -> coords ($curves [$i]); - for (my $j = 0; $j <= $#points; $j ++) + for (my $i = 0 ; $i <= $#curves; $i ++) { - if (defined $format && $format eq "RECO") + next if defined $firstCurveIndex && $i < $firstCurveIndex; + last if defined $lastCurveIndex && $i > $lastCurveIndex; + my $single = ""; + my @points = $zinc -> coords ($curves [$i]); + for (my $j = 0; $j <= $#points; $j ++) { - $single .= sprintf" %d %d,",$points[$j]-> [0],$points[$j] -> [1]; - if ($j == $#points) - { - $single .=" break"; - } + if($points[$j]-> [0] != $points[$j-1]-> [0] || $points[$j] -> [1] != $points[$j-1] -> [1]) { + $single .= sprintf" %d %d,",$points[$j]-> [0],$points[$j] -> [1]; + } + + if ($j == $#points) + { + $single .=" break"; + } } - else + push (@tab,$single); + } + } + else { + for (my $i = 0 ; $i <= $#curves; $i ++) + { + next if defined $firstCurveIndex && $i < $firstCurveIndex; + last if defined $lastCurveIndex && $i > $lastCurveIndex; + my $single = ""; + my @points = $zinc -> coords ($curves [$i]); + for (my $j = 0; $j <= $#points; $j ++) { - $single .= sprintf"\[%d,%d",$points[$j]-> [0],$points[$j] -> [1]; - if (defined $points[$j] -> [2]) - { - $single .= sprintf",%s\]-",$points[$j] -> [2]; - } - else - { - $single .= sprintf"\]-"; - } + $single .= sprintf"\[%d,%d",$points[$j]-> [0],$points[$j] -> [1]; + if (defined $points[$j] -> [2]) + { + $single .= sprintf",%s\]-",$points[$j] -> [2]; + } + else + { + $single .= sprintf"\]-"; + } } + push (@tab,$single); } - push (@tab,$single); } } return \@tab; } sub __deleteCurve { my ($self, $index) = @_; - $self -> notify ('ERASE', $index); $self -> deleteCurve ($index); + $self -> notify ('ERASE', $index); } sub deleteCurve { |