aboutsummaryrefslogtreecommitdiff
path: root/src/MTools
diff options
context:
space:
mode:
Diffstat (limited to 'src/MTools')
-rw-r--r--src/MTools/Comp/MMover.pm20
-rw-r--r--src/MTools/Comp/MWritable.pm61
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 {