#! /usr/local/tcl/bin/wish

#
#	   ___    0  Michel Beaudouin-Lafon        e-mail: mbl@lri.fr
#	  /   \  /   LRI - Bat 490                 www   : http://www-ihm.lri.fr/~mbl
#	 /  __/ /    Universite de Paris-Sud       voice : +33 1 69 15 69 10
#	/__   \/     91 405 ORSAY Cedex - FRANCE   fax   : +33 1 69 15 65 86
#
#	Machines a etats pour la creation de segments et de polygones.
#
#	Voir la documentation jointe "Machines a etat mini-tutorial" pour
#	la syntaxe des machines a etats.
#		

source smUtils.tcl

# creation simple d'un segment
#
state_machine CreateLine {
	local P1 P2 line
	
	# etat de depart : attente de l'appui sur le bouton
	state Start {
		when Down at P1 do {
			# creer le segment
			set line [CreateLine $P1 $P1]
		} -> Drag
	}
	
	# suivi de la souris pendant que le bouton est enfoncé
	state Drag {
		when Move at P2 do {
			# ajuster les coordonnees
			ChangeCoords $line $P1 $P2
		}
		
		when Up at P2 do {
			# detruire la ligne ayant servi au feed-back
			DeleteItem $line
			# notifier l'application du nouveau segment
			AppCreateLine $P1 $P2
		} -> Start
	}
	
	# on met la fonction d'application ici pour les besoins de la demo
	lproc AppCreateLine {P1 P2} {
		return [CreateLine $P1 $P2 -fill red]
	}
}

# version avec hysteresis
#
state_machine CreateLineHysteresis {
	local P1 P2 line
	
	# etat de depart : attente de l'appui sur le bouton
	state Start {
		when Down at P1 -> WaitDrag
	}
	
	# etat intermediaire : attente d'un deplacement suffisant
	state WaitDrag {
		when Move at P2 and {! [PointsClose $P1 $P2]} do {
			# deplacement suffisant : on demarre l'interaction
			set line [CreateLine $P1 $P2]
		} -> Drag
		
		# relachement du bouton avant un deplacement suffisant :
		# on ignore l'action
		when Up -> Start
	}
	
	state Drag {
		when Move at P2 do {
			# ajuster les coordonnees
			ChangeCoords $line $P1 $P2
		}
		
		when Up at P2 do {
			# detruire la ligne ayant servi au feed-back
			DeleteItem $line
			# notifier l'application du nouveau segment
			AppCreateLine $P1 $P2
		} -> Start
	}
	
	# on met la fonction d'application ici pour les besoins de la demo
	lproc AppCreateLine {P1 P2} {
		return [CreateLine $P1 $P2 -fill purple]
	}
}

# machine qui "allume" l'item sous la souris
#
state_machine HiliteItem {
	state Start {	
		when Enter onItem l do {
			ChangeItem $l -fill green
		} -> Item
	}
	state Item {
		when Leave onItem l do {
			ChangeItem $l -fill red
		} -> Start
	}
}

# CreatePoly2 : creation d'un polygone
#
# la touche Escape annule la creation, Backspace annule le dernier point saisi.
# la creation est terminee par un double click ou en cliquant sur le point de depart.
#
state_machine CreatePoly {
	# P1, P2 et line representent le segment en cours de creation
	local P1 P2 line
	# lines contient la liste des identificateurs des segments deja crees
	# points contient la liste des sommets du polygone
	local lines points
	
	state Start {
		enter {
			# ce code est execute chaque fois que l'etat Start
			# devient l'etat courant.
			
			# effacer tous les segments deja crees et le segment courant
			foreach l $lines {
				DeleteItem $l
			}
			DeleteItem $line
			
			# initialiser les variables locales
			set lines {}
			set points {}
		}
		
		when Down at P1 do {
			# creation du premier segment
			set line [CreateLine $P1 $P1]
			lappend points $P1
		} -> Drag
	}
	
	state Drag {
		when Motion at P2 do {
			# deplacement de la souris : ajuster la seconde extremite.
			# note : Move correspond seulement aux deplacements avec bouton enfonce
			ChangeCoords $line $P1 $P2
		}
		
		when Down at P2 and {[PointsClose $P1 $P2]} do {
			# double click: fin de la saisie 
			AppCreatePoly $points
		} -> Start
		
		when Down at P2 and {[PointsClose [lindex $points 0] $P2]} do {
			# click sur le premier point : fin de la saisie.
			# fermer le polygone
			lappend points [lindex $points 0]
			AppCreatePoly $points
		} -> Start
		
		when Down at P2 do {
			# autre click : ajout d'un point
			# ajuster le segment
			ChangeCoords $line $P1 $P2
			# l'ajouter a la liste des segments deja crees
			lappend lines $line
			# ajouter le point a la liste des sommets du polygone
			lappend points $P2
			# creer un nouveau segment courant
			set P1 $P2
			set line [CreateLine $P1 $P1]
		}
		
		when Key-Escape do {
			# annulation
			# note : la clause enter de l'etat Start se charge de l'effacement
		} -> Start
		
		when Key-BackSpace and {[llength $lines] == 0} do {
			# effacement du premier point = annulation
			# note : la clause enter de l'etat Start se charge de l'effacement
		} -> Start
		
		when Key-BackSpace do {
			# annuler le dernier point
			# detruire le dernier segment et l'enlever de la liste des segments
			DeleteItem [lindex $lines end]
			set lines [lreplace $lines end end]
			# enlever le dernier point de la liste des points
			set points [lreplace $points end end]
			# reinitialiser le segment courant
			set P1 [lindex $points end]
			ChangeCoords $line $P1 $P2
		}
	}
	
	# procedure locale appelee lorsque la saisie est terminee.
	lproc AppCreatePoly {points} {
		# creer un polygon rouge
		return [CreatePolygon $points -fill red]
	}
}

# CreatePoly2 : creation d'un polygone
#
# dans cette version, on a un hysteresis et un timeout pour les double clicks
#
state_machine CreatePoly2 {
	# P1, P2 et line representent le segment en cours de creation
	local P1 P2 line
	# lines contient la liste des identificateurs des segments deja crees
	# points contient la liste des sommets du polygone
	local lines points
	
	state Start {
		enter {
			# ce code est execute chaque fois que l'etat Start
			# devient l'etat courant.
			
			# effacer tous les segments deja crees et le segment courant
			foreach l $lines {
				DeleteItem $l
			}
			DeleteItem $line
			
			# initialiser les variables locales
			set lines {}
			set points {}
		}
		
		when Down at P1 do {
			lappend points $P1
		} -> WaitDragOrClick
	}
	
	# etat correspondant a l'attent d'un deplacement suffisant de la souris
	# ou d'un second Down qui correspondrait a un double click
	#
	state WaitDragOrClick {
		enter {
			# activation d'un timeout pour detecter les double-clicks
			arm 500
		}
		
		when Motion at P2 and {! [PointsClose $P1 $P2]} do {
			# creation d'un segment si l'on a bouge suffisamment
			set line [CreateLine $P1 $P2]
		} -> Drag
		
		when Down at P2 do {
			# double click: fin de la saisie 
			AppCreatePoly $points
		} -> Start
		
		when TimeOut -> WaitDrag
	}
	
	# etat correspondant a l'attente d'un deplacement suffisant de la souris
	#
	state WaitDrag {
		when Motion at P2 and {! [PointsClose $P1 $P2]} do {
			# creation d'un segment si l'on a bouge suffisamment
			set line [CreateLine $P1 $P2]
		} -> Drag
		
		# cette transition permet de reactiver le double click 
		# si l'on a attendu trop longtemps
		when Down -> WaitDragOrClick
	}
	
	# etat correspondant au suivi de la souris pendant la specification d'un segment
	#
	state Drag {
		when Motion at P2 do {
			# deplacement de la souris : ajuster la seconde extremite.
			# note : Move correspond seulement aux deplacements avec bouton enfonce
			ChangeCoords $line $P1 $P2
		}
		
		when Down at P2 and {[PointsClose [lindex $points 0] $P2]} do {
			# click sur le premier point : fin de la saisie.
			# fermer le polygone
			lappend points [lindex $points 0]
			AppCreatePoly $points
		} -> Start
		
		when Down at P2 do {
			# autre click : ajout d'un point
			# ajuster le segment
			ChangeCoords $line $P1 $P2
			# l'ajouter a la liste des segments deja crees
			lappend lines $line
			set line {}
			# ajouter le point a la liste des points
			lappend points $P2
			# preparer la saisie du prochain segment
			set P1 $P2
		} -> WaitDragOrClick
	}
	
	# les touches d'annulation doivent etre prises en compte dans les etats
	# WaitDragOrClick, WaitDrag et Drag.
	#
	states WaitDragOrClick WaitDrag Drag {
		when Key-Escape do {
			# annulation
			# note : la clause enter de l'etat Start se charge de l'effacement
		} -> Start
		
		when Key-BackSpace and {[llength $lines] == 0} do {
			# effacement du premier point = annulation
			# note : la clause enter de l'etat Start se charge de l'effacement
		} -> Start
		
		when Key-BackSpace do {
			# annuler le dernier point
			# detruire le dernier segment et l'enlever de la liste des segments
			DeleteItem [lindex $lines end]
			set lines [lreplace $lines end end]
			# enlever le dernier point de la liste des points
			set points [lreplace $points end end]
			# reinitialiser le segment courant
			set P1 [lindex $points end]
			if {$line == ""} {
				set line [CreateLine $P1 $P2]
			} else {
				ChangeCoords $line $P1 $P2
			}
		} -> Drag
	}
	
	# procedure locale appelee lorsque la saisie est terminee.
	lproc AppCreatePoly {points} {
		if {[llength $points] < 3} {
			# pas suffisamment de points
			return
		}
		# creer un polygon rouge
		return [CreatePolygon $points -fill red]
	}
}