#------------------------------------------------------------------------------------------
# utilisation d'un canvas pour la saisie de traces et de textes
#
# Michel Beaudouin-Lafon
# Nov. 1997
#
# mailto:mbl@lri.fr
# http://www-ihm.lri.fr/~mbl
#------------------------------------------------------------------------------------------
#
# On peut creer des dessins a main levee, et entrer du texte apres avoir pose le curseur
# texte par un click.
# Les marques et les textes peuvent etre deplaces par cliquer-tirer.
# On peut editer un texte en cliquant dedans pour y positionner le curseur texte.
# On peut detruite une ligne de texte en la rayant d'une marque horizontale.
# 
#------------------------------------------------------------------------------------------

# faire le menage
catch {eval destroy [winfo children .]}

# charger le package de reconnaissance de trace
source mark-utils.tcl

# creer un canvas, un bouton pour effacer et un bouton pour quitter
#
pack [canvas .c -borderwidth 2 -relief sunken] -expand on -fill both
pack [button .quit -text Quitter -command {destroy .}] -side right -padx 5 -pady 5
pack [button .clear -text Effacer -command {.c delete all}] -side right -padx 5 -pady 5

# variable globale indiquant l'action en cours
set action "rien"

# liaisons d'evenement pour la creation d'une trace.
# Ces liaisons sont definies pour le canvas (commande bind)
# car on veut pouvoir creer une trace en cliquant n'importe ou.
# Comme les liaisons definies pour le canvas sont toujours executees
# on utilise une variable globale "action" qui indique l'action en cours
#
bind .c <ButtonPress-1> {
	if {$action == "rien"} {
		# passer dans l'etat de creation de trace
		set action "trace"
		# memoriser la position de la souris
		set X %x
		set Y %y
		set trace {%x %y}
	}
}

bind .c <Button1-Motion> {
	if {$action == "trace"} {
		# creer un segment entre la position precedente et la position courante
		%W create line $X $Y %x %y -tag encre
		# memoriser la nouvelle position courante
		set X %x
		set Y %y
		# memoriser la trace
		lappend trace %x %y
	}
}

bind .c <ButtonRelease-1> {
	if {$action == "trace"} {
		# si l'on a cree au moins un segment, les remplacer par une trace,
		# sinon on a fait un click et l'on cree un item texte.
		if {[llength $trace] > 2} {
			# detruire les segments qui ont servi au feed-back
			%W delete encre
			# creer un seul item representant l'ensemble de la trace
			# on utilise "eval" pour que la liste $trace soit "mise a plat" :
			# eval fait un concat de ses arguments avant de les evaluer.
			# Sans eval, la commande executee serait
			#		%W create line {x1 y1 x2 y2 ... xn yn} -tag trace
			# alors qu'avec eval elle est
			#		%W create line x1 y1 x2 y2 ... xn yn -tag trace
			set item [eval %W create line $trace -tag trace]
			# interpreter la trace
			InterpreteTrace %W $item
		} else {
			CreerTexte %W %x %y
		}
		# revenir a l'etat par defaut
		set action "rien"
	}
}

# mise en evidence d'une trace lorsque le curseur est dessus.
# on utilise la methode bind du canvas pour que seuls les items
# ayant le tag "trace" soient concernes.
#
.c bind trace <Enter> {
	# changer l'epaisseur et la couleur
	%W itemconfigure current -width 3 -fill blue
}

.c bind trace <Leave> {
	# remettre l'epaisseur et la couleur a leur valeur initiale
	%W itemconfigure current -width 1 -fill black
}

# deplacement des items par drag and drop.
# ces liaisons sont activees avant les liaisons du canvas
# specifiees par la commande bind. La variable globale "action"
# est affectee ici, de telle sorte que les liaisons globales
# soient sans effet. Le codage est "defensif" : les tests sur
# la valeur de action sont ici inutiles, mais pourraient s'averer
# necessaire si l'on ajoutait des fonctionnalites
#
.c bind all <ButtonPress-1> {
	if {$action == "rien"} {
		set action "deplace"
		# memoriser la position de la souris
		set X %x
		set Y %y
	}
}

.c bind all <Button1-Motion> {
	if {$action == "deplace"} {
		# deplacer l'item sous la souris
		%W move current [expr %x - $X] [expr %y - $Y]
		# memoriser la position de la souris
		set X %x
		set Y %y
	}
}

.c bind all <ButtonRelease-1> {
	if {$action == "deplace"} {
		set action "rien"
	}
}

# creation et modification d'items textes.
# Un click sur un item texte permet de positionner
# le curseur d'insertion dans cet item.
# Un click sur le fond du canvas creer un nouvel
# item texte et le rend editable. Ce cas est traite
# par la liaison <ButtonPress-1> ci-dessus, qui
# appelle CreerTexte.

# faire en sorte que le widget ait le focus clavier
# lorsque la souris est a l'interieur.
#
bind .c <Enter> {
	focus %W
}

# faire en sorte que le texte change de couleur lorsque la souris
# passe dessus, pour etre coherent avec le feed-back des traces.
# Noter que l'option -width pour un item texte a un sens different
# que pour les items polyligne : c'est la longueur maximale, en
# caracteres, de chaque ligne. 
.c bind texte <Enter> {
	%W itemconfigure current -fill blue
}

.c bind texte <Leave> {
	%W itemconfigure current -fill black
}

# creation d'un item texte vide a la position x y.
#
proc CreerTexte {widget x y} {
	# creer un nouvel item texte
	set text [$widget create text $x $y -anchor nw -tags texte]
	# si l'item qui a le focus est vide, le detruire
	# mettre le focus du canvas sur l'item que l'on vient de creer
	SetFocus $widget $text
}

# positionner le focus sur un item texte.
# detruire l'item qui avait le focus auparavant s'il est vide.
# Cela evite de laisser trainer des items vides.
#
proc SetFocus {widget item} {
	set olditem [$widget focus]
	if {$olditem != "" && [$widget itemcget $olditem -text] == ""} {
		$widget delete $olditem
	}
	# poser le focus sur l'item
	$widget focus $item
}

# liaison lorsque l'on clique sur un item texte. On rend l'item
# editable et on met le curseur d'insertion a la position de la souris.
# on utilise une variable globale "click" qui est mise a zero lorsque
# l'on bouge la souris avec le bouton enfonce. Cette variable permet
# de ne positioner le curseur d'insertion que si l'on a fait un click
# et pas un drag. Cette distinction est importante car le drag est
# interpretes par d'autres liaisons ci-dessus pour deplacer un item.
#
set click 1
.c bind texte <Button1-Motion> {
	set click 0
}
.c bind texte <ButtonRelease-1> {
	if {$click == 1} {
		# mettre le focus sur l'item courant
		SetFocus %W current
		# positionner le curseur d'insertion a la position de la souris
		%W icursor current @%x,%y
	}
	set click 1
}

# inserer un caractere dans l'item texte courant.
# noter que cette liaison est specifiee pour l'ensemble du widget
# (commande bind) et non pas pour les items texte (".c bind text ...").
# Cela signifie que l'on peut inserer des caracteres quelle que soit
# la position de la souris dans le canvas. Si l'on utilisait ".c bind text ..."
# on ne pourrait inserer des caracteres que si la souris est sur un item texte.
#
bind .c <KeyPress> {
	# inserer le caractere dans l'item qui a le focus, a la position de son point d'insertion
	%W insert [%W focus] insert %A
}

bind .c <KeyPress-Return> {
	# inserer le caractere \n dans l'item qui a le focus, a la position de son point d'insertion
	%W insert [%W focus] insert \n
}

# la touche backspace efface le caractere devant le curseur (s'il y en a un)
#
bind .c <KeyPress-BackSpace> {
	# recuperer l'item qui a le focus
	set txt [%W focus]
	# recuperer la position du point d'insertion de l'item qui a le focus
	set idx [%W index $txt insert]
	# detruire le caractere devant le point d'insertion
	if {$idx > 0} {
		%W dchars $txt [expr $idx - 1]
	}
}

# interpretation d'une trace.
# On regarde s'il s'agit d'un trait horizontal et s'il est sur un texte.
# Si c'est le cas on detruit le texte et le trait.
#
proc InterpreteTrace {widget trace} {
	# verifier que c'est bien un trait horizontal
	set line [$widget coords $trace]
	if {[MarkIsFlick $line] != "E"} {
		return
	}
	
	# recupere le widget texte qui est sous le trait
	set box [$widget bbox $trace]
	set text {}
	foreach item [eval $widget find overlapping $box] {
		if {[$widget type $item] == "text"} {
			set text $item
			break
		}
	}
	if {$text == {}} {
		return
	}
	
	# trouver la partie qui a ete rayee
	set x [lindex $line 0]
	set y [lindex $line 1]
	set first [$widget index $text @$x,$y]
	
	set l [llength $line]
	set x [lindex $line [expr $l -2]]
	set y [lindex $line [expr $l -1]]
	set last [$widget index $text @$x,$y]
	
	# detruire les caracteres ou l'item tout entier
	set end [$widget index $text end]
	if {$first == 0 && $last == $end} {
		$widget delete $text
	} else {
		$widget dchars $text $first $last
	}
	
	# detruire le trait
	$widget delete $trace
}