Ajout du magnetisme dans le mover.

Option: magnetic. 0: aucun effet.

1 files changed, 61 insertions, 6 deletions

diff --git a/src/MTools/Comp/MMover.pm b/src/MTools/Comp/MMover.pm
index 6097bd9..6b8c1c1 100644
--- a/src/MTools/Comp/MMover.pm
+++ b/src/MTools/Comp/MMover.pm
@@ -55,6 +55,7 @@ sub new {
 	$self -> recordProperty ('y', 0);
 	$self -> recordProperty ('targets', $targets);
 	$self -> recordProperty ('allower', undef);
+	$self -> recordProperty ('magnetic', 10);
 	$self -> recordProperty ('translate', 'translate');
 	
 	$self -> mconfigure (%options);
@@ -110,7 +111,7 @@ sub __moved {
 	my ($self, $x, $y, $t) = @_;
 	if (!$self -> {__started}) {return;}
 	if(!$self -> mget('-visible')) {return;}
-	
+			
 	my $dx = $x - $self -> {__last_mouse_x};
 	my $dy = $y - $self -> {__last_mouse_y};
 
@@ -120,6 +121,13 @@ sub __moved {
 	my $y_max = $self -> mget('y_max');
 	my $current_x = $self -> mget ('x');
 	my $current_y = $self -> mget ('y');
+	
+	my ($cor_x, $cor_y) = $self -> checkMagneticConstraints ($current_x + $dx, $current_y + $dy);
+	$dx += $cor_x;
+	$dy += $cor_y;
+	$x += $cor_x;
+	$y += $cor_y;
+	
 	if($current_x + $dx > $x_max)
 	{
 		$x -= $current_x + $dx - $x_max;	
@@ -181,24 +189,25 @@ sub translate {
 	my $y_max = $self -> mget('y_max');
 	my $current_x = $self -> mget ('x');
 	my $current_y = $self -> mget ('y');
-	if($current_x + $dx > $x_max)
+	
+	if ($current_x + $dx > $x_max)
 	{
 		$dx -= $current_x + $dx - $x_max;
 	}
-	if($current_y + $dy > $y_max)
+	if ($current_y + $dy > $y_max)
 	{
 		$dy -= $current_y + $dy - $y_max;
 	}
-	if($current_x + $dx < $x_min)
+	if ($current_x + $dx < $x_min)
 	{
 	
 		$dx -= $current_x + $dx - $x_min;
 	}
-	if($current_y + $dy < $y_min)
+	if ($current_y + $dy < $y_min)
 	{
 		$dy -= $current_y + $dy - $y_min;
 	}
-	if( $dx == 0 && $dy == 0 )
+	if ( $dx == 0 && $dy == 0 )
 	{
 		return;
 	}
@@ -219,4 +228,50 @@ sub translate {
 	$self -> notify ('MOVED', $current_x, $current_y, $t);
 }
 
+sub addMagneticConstraints {
+	my ($self, $type, $value) = @_;
+	push (@{$self -> {magnetic_contraints}}, [$type, $value]);
+} 
+
+sub checkMagneticConstraints {
+	my ($self, $x, $y) = @_;
+	if ($self -> {magnetic_contraints}) {
+		my $magnetic_step = $self -> mget ('magnetic');
+		my $cx = undef;
+		my $cy = undef;
+		my @constraints = @{$self -> {magnetic_contraints}};
+		for (my $i = 0; $i < @constraints; $i ++) {
+			my $ct = $constraints [$i];
+			if ($ct -> [0] eq 'x') {
+				if (abs ($ct -> [1] - $x) < $magnetic_step) {
+					if (defined $cx) {
+						if (abs ($ct -> [1] - $x) < $cx) {
+							$cx = $ct -> [1] - $x;
+						}
+					}
+					else {
+						$cx = $ct -> [1] - $x;
+					}
+				}
+			}
+			if ($ct -> [0] eq 'y') {
+				if (abs ($ct -> [1] - $y) < $magnetic_step) {
+					if (defined $cy) {
+						if (abs ($ct -> [1] - $y) < $cy) {
+							$cy = $ct -> [1] - $y;
+						}
+					}
+					else {
+						$cy = $ct -> [1] - $y;
+					}
+				}
+			}
+		}
+		if (!defined $cx) {$cx = 0;}
+		if (!defined $cy) {$cy = 0;}
+		return ($cx, $cy);
+	}
+	return (0, 0);
+}
+
 1;