# 
#	(c) 1997, Michel Beaudouin-Lafon, mbl@lri.fr
#
#	agenda.tcl	gestion de mini-agenda pour demontrer
#	l'usage de tableaux globaux pour representer des "objets".
#

# Lorsque l'on veut stocker plusieurs donnees relatives a un meme "objet",
# le meilleur moyen est d'utiliser un tableau Tcl dont chaque donnee est reperee par un indice.
# Comme les tableaux Tcl sont associatifs, les indices peuvent etre des chaine de caracteres
# quelconques, notamment des noms de champs.
#
# Dans cet exemple, les objets manipules sont les personnes dont les coordonnees sont
# stockees dans un agenda. Pour chaque personne, on a son nom, son prenom, son telephone
# et son email. Pour identifier une personne, il suffit de creer un tableau. Par exemple,
# le tableau "michel" serait initialise par :
#	set michel(nom) Beaudouin-Lafon
#	set michel(prenom) Michel
#	set michel(tel) "01 69 15 69 10"
#	set michel(email) mbl@lri.fr
#
# Grace a la commande Tcl 'array', on peut realiser la meme chose de facon plus concise :
#	array set michel {
#		nom		Beaudouin-Lafon
#		prenom		Michel
#		tel		"01 69 15 69 10"
#		email		mbl@lri.fr
#	}
#	
# On peut afficher le contenu d'un tableau avec la commande parray :
#	parray michel
#
# Lorsque l'on veut passer un 'objet' a une procedure, il faut passer son nom
# (et non pas sa valeur). Par exemple, la procedure qui affiche le contenu d'un tableau
#	s'ecrit :
#		proc PrintPerson {personName} {
#			upvar #0 $personName person
#			puts "$person(prenom) $person(nom), $person(tel), $person(email)"
#		}
#		
#		PrintPerson michel
#
# Cette procedure prend en parametre un _nom_ de tableau et non sa valeur.
# Il faut donc faire en sorte que l'on ait acces au contenu du tableau dans la procedure.
# Dans un langage comme Pascal, la declaration d'un parametre par variable permet
# au compilateur de faire ce qu'il faut. En C, on passe explicitement l'adresse de
# l'objet. En Tcl, c'est lorsque l'on accede la variable qu'il faut faire "ce qu'il faut".
# 
# Dans l'exemple ci-dessus, la ligne
#	upvar #0 $personName person
# indique de creer une variable locale "person", aliasee sur la variable globale
# dont le nom est contenu dans personName. La variable locale "person" et la variable
# globale dont le nom est contenu dans "personName" designent alors la même valeur.
# Lorsque l'on accede a la variable 'person' a l'interieur du corps de la procedure 
# (comme par exemple $person(name)), on accede a la valeur de la variable globale 
# dont le nom est dans personName, c'est-a-dire 'michel' dans l'exemple d'appel
# "PrintPerson michel".
#
# L'effet est comparable a celui de
#	global $personName
# qui permet d'acceder, au sein d'une procedure, a une variable globale.
# La difference avec upvar est que upvar permet d'utiliser un nom different pour
# acceder a la variable globale, ce qui dans ce cas est necessaire car on ne peut
# ecrire $$personName(name), ou du moins cela n'a pas l'effet escompte.
#
#
# En resume, pour manipuler des 'objets', il suffit d'utiliser des tableaux
# globaux. Lorsque l'on passe un objet en parametre, il faut passer son nom.
# Dans les procedures qui prennent des noms d'objets en parametre, il faut
# inserer une commande de la forme
#	upvar $objName obj
# pour pouvoir ensuite acceder au contenu de l'objet par $obj(toto).
# La convention de nommage qui consiste a suffixer les _noms_ d'objets
# par "Name" permet de diminuer les risques d'erreurs et les confusions
# entre l'objet et son nom...


# --------
# exemple d'application : un mini-agenda.
# On peut utiliser le debugger (source debug.tcl) pour mieux explorer ce
# qui se passe. Mettre une trace sur la variable globale Persons, et des
# traces sur les tableaux person0(), person1(), ...
#

# variables globales
#	NPerson permet de generer des identificateurs uniques de personnes
#	Persons est la liste des identificateurs de personnes
set NPerson 0
set Persons {}

# creer une nouvelle entree dans l'agenda et retourner son identificateur.
#
proc NewPerson {} {
	# creer l'identificateur (unique) de la nouvelle personne
	# a l'aide de la variable globale NPerson et l'ajouter a la liste des personnes
	global NPerson Persons
	set personName "person$NPerson"
	incr NPerson
	lappend Persons $personName
	
	# initialiser les champs necessaires.
	# le champ "editWindow" sert a savoir si une fenetre d'edition est ouverte sur la personne.
	upvar #0 $personName person
	set person(editWindow) {}
	
	# retourner le nom de la nouvelle personne
	return $personName
}

# editer une personne : creer une fenetre separee
# avec des champs de saisie permettant d'editer le nom, prenom, etc.
#
proc EditPerson {personName} {
	# donner acces a l'objet dont le nom est passe dans personName
	upvar #0 $personName person
	
	if [winfo exist $person(editWindow)] {
		# si la fenetre existe deja, ne pas la creer
		return
	}

	# creer une fenetre
	set edit [toplevel .edit$personName]
	wm title $edit "Personne"
	
	# mettre dans la fenetre un champ editable par champ de la personne.
	# note : on utilise la forme etendue du "foreach" : le couple de variables 'field' et 'title' parcourt la liste :
	# field vaut 'nom' et title "Nom :", pui field vaut 'prenom' et title "Prenom :", etc.
	foreach {field title} {nom "Nom :" prenom "Prenom :" tel "Telephone :" email "Email :"} {
		# mettre un label et un champ editable dans un frame
		frame $edit.$field
		label $edit.$field.title -text $title
		# le champ editable a pour valeur active l'element de tableau de la personne correspondante.
		# Pour l'objet 'michel' et le champ 'nom', le nom de cet element de tableau est michel(nom).
		# Comme le nom de l'objet et le nom du champ sont tous les deux des variables, il faut
		# proteger les parentheses pour eviter que $personName($field) ne soit directement
		# substitue par la valeur du champ $field du tableau personName (qui n'existe pas...).
		# Par ailleurs, les variables actives _doivent_ etre des variables globales. Il ne faut
		# donc par utiliser ici un 'upvar #0 $personName person' et un nom de variable 'person($field)'
		# car la valeur active serait associee a la variable _globale_ 'person', qui n'existe pas.
		entry $edit.$field.edit -textvariable $personName\($field\)
		
		# positionner le label et le champ editable horizontalement dans le frame
		pack $edit.$field.title -side left -padx 5 -pady 5
		pack $edit.$field.edit -side left -padx 5 -pady 5 -expand on -fill x
		# positionner le frame verticalement dans son parent
		pack $edit.$field -side top -expand on -fill x
	}
	# memoriser la fenetre d'edition de cette personne
	set person(editWindow) $edit
	
	# creer un bouton Print qui affiche les infos sur la sortie standard et 
	# un bouton OK qui ferme la fenetre
	# note : il n'y a pas d'annulation possible ici.
	button $edit.print -text Imprimer -command "PrintPerson $personName"
	button $edit.ok -text OK -command "destroy $edit"
	pack $edit.ok -side right -padx 5 -pady 5
	pack $edit.print -side right -padx 5 -pady 5
}

# ouvrir une fenetre d'edition pour chaque personne dont le nom est 'nom'.
# s'il n'y a aucune personne de ce nom, afficher une boite de dialogue
#
proc SearchPerson {nom} {
	global Persons
	set found 0
	
	# parcourir la liste des personnes
	foreach personName $Persons {
		# acceder a la personne par la variable locale 'person'
		upvar #0 $personName person
		# si son nom correspond au nom cherche, ouvrir une fenetre d'edition
		if {$person(nom) == $nom} {
			EditPerson $personName
			incr found
		}
	}
	
	# si l'on n'a trouve aucune personne, avertir l'utilisateur
	if {$found == 0} {
		tk_messageBox -type ok -message "ll n'y a personne avec le nom $nom"
	}
}

# afficher les infos sur une personne sur la sortie standard
#
proc PrintPerson {personName} {
	upvar #0 $personName person
	puts "$person(prenom) $person(nom), $person(tel), $person(email)"
}

# --------
# interface generale : un bouton pour creer une nouvelle personne,
# un champ de saisie et un bouton pour rechercher une personne, 
# un bouton qui affiche tout l'agenda et un bouton pour quitter.
#

# bouton de creation
button .new -text "Nouvelle personne" -command {EditPerson [NewPerson]}

# champ de saisie du nom a chercher.
# note : on utilise un valeur active associee a la variable global searchName
entry .name -textvariable searchName -width 20
# taper Return equivaut a cliquer Chercher
bind .name <Key-Return> {.search invoke}

# bouton pour lancer la recherche
button .search -text "Chercher" -command {SearchPerson $searchName}

# bouton print
button .print -text "Imprimer tout" -command {foreach personName $Persons {PrintPerson $personName}}

# bouton quit
# note : l'interpreteur Tcl termine automatiquement lorsque la fenetre . est detruite
button .quit -text "Quitter" -command {destroy .}

# placer les widgets
pack .new -side top -padx 5 -pady 5 -fill x
pack .quit -side bottom -padx 5 -pady 5 -fill x
pack .print -side bottom -padx 5 -pady 5 -fill x
pack .search -side left -padx 5 -pady 5
pack .name -side left -padx 5 -pady 5 -fill x

# donner un titre a la fenetre principale
wm title . Agenda