; ---------------------------------------------
;
;	Tours de Hanoi avec objets
;	version standard + version graphique
;
;	F. Balmas		20/11/97
;
; ---------------------------------------------

; version standard
; ----------------

; les tiges
(defclasse 'tige 'objet '(disques) nil '(
	(init (lambda (Obj)
		(-> Obj 'putvar 'disques (list '*>)) ))
	(top (lambda (Obj)
		(car (last :disques)) ))
	(ajoute (lambda (Obj disque)
		(nconc :disques (list disque)) ))
	(enleve (lambda (Obj)
		(nreverse (cdr (nreverse :disques))) ))
	(print (lambda (Obj)
		(prin1 '\|)
		(mapc (cdr :disques) (lambda (d) (-> d 'print)))
		(terpri) ))
	))

; les disques
(defclasse 'disque 'objet '(dim) nil '(
	(print (lambda (Obj) (prin1 :dim)) )
	))

; le jeu de hanoi
(defclasse 'hanoi 'objet '(t1 t2 t3 nb-disques tige disque) nil '(
	(init (lambda (Obj)
		(-> Obj 'putvar 'tige 'tige)
		(-> Obj 'putvar 'disque 'disque) ))
	(initialise (lambda (Obj n) 
		(-> Obj 'putvar 't1 (-> :tige 'newI 'A))
		(-> Obj 'putvar 't2 (-> :tige 'newI 'B))
		(-> Obj 'putvar 't3 (-> :tige 'newI 'C))
		(-> Obj 'putvar 'nb-disques n)
		(-> Obj 'init-disques :t1 n)
		))
	(init-disques (lambda (Obj tige n)
		(if (= n 0)
		   t
		   (let ((d (-> :disque 'newI) ))
			(-> tige 'ajoute d)
			(-> d 'putvar 'dim n) )
		   (self Obj tige (- n 1)) ) ))
	(exec (lambda (Obj)
		(-> Obj 'hanoi :nb-disques :t1 :t3 :t2) 
		))
	(hanoi (lambda (Obj n D A I)
		(if (= n 0)
		     t
		     (-> Obj 'hanoi (- n 1) D I A)
		     (-> Obj 'deplace n D A)
		     (-> Obj 'hanoi (- n 1) I A D) ) 
		))
	(deplace (lambda (Obj n tD tA)
		(-> tA 'ajoute (-> tD 'top))
		(-> tD 'enleve)
		(-> Obj 'print) )) 
	(print (lambda (Obj)
		(-> :t1 'print)
		(-> :t2 'print)
		(-> :t3 'print)
		(terpri) (terpri)(terpri)
		)) 
	))

; fonction de lancement
(de hanoi (n)
	(let ((h (-> 'hanoi 'newI)))
		(-> h 'initialise n)
		(-> h 'print)
		(-> h 'exec)
		)
)

; -----------------------------------------------------
; version graphique
; -----------------

; les tiges graphiques
(defclasse 'x-tige 'tige '(x1 x2 y) nil '(
	(init (lambda (Obj)
	   (-> Obj 'putvar 'disques (list '*>))
	   (-> Obj 'putvar 'y 140) ))
		; afficher la tige + les disques qui sont dessus
	(print (lambda (Obj xDessin)		
		; afficher la tige
	   (xDrawLines xDessin 	:x1 140 	(+ :x1 140) 140
				:x2 140	:x2 10) 
		; afficher son nom
	   (xDrawString xDessin (- :x2 5) 160 (strcat (get Obj 'nom)))
		; faire afficher les disques qui sont dessus
	   (let ((d (cdr :disques)) (y 1))
		(if (null d) t
		    (-> (car d) 'print xDessin :x2 y)
		    (self (cdr d) (+ y 1)) ))
	   ))
		; afficher le disque du dessus
	(affiche-top (lambda (Obj xDessin)
	   (-> (car (last :disques)) 'print xDessin
			:x2 (length (cdr :disques)))
	   ))
		; effacer le disque du dessus
	(efface-top (lambda (Obj xDessin)
		; afficher le disque du dessus en couleur de fond
	   (xSetValues xDessin "foreground" "#fff")
	   (-> (car (last :disques)) 'print xDessin 
			:x2 (length (cdr :disques)))
		; reafficher l'axe de la tige
	   (xSetValues xDessin "foreground" "#000")
	   (xDrawLines xDessin :x2 140 :x2 10)
	   ))
	))

; les disques graphiques
(defclasse 'x-disque 'disque '(xCoeff) nil '(
	(print (lambda (Obj xDessin x y) 	; affichage du disque
	   (xFillRectangles xDessin (- x (* :xCoeff :dim)) 
				    (- 140 (* :xCoeff y))
				    (* 2 (* :xCoeff :dim)) :xCoeff)
	   ))
	))

; le jeu de hanoi graphique
(defclasse 'x-hanoi 'hanoi '(xDessin) nil '(
	(init (lambda (Obj)
		; creation d'une instance de x-hanoi 
		; + creation du contexte graphique
	   (-> Obj 'putvar 'tige 'x-tige)
	   (-> Obj 'putvar 'disque 'x-disque)
	   (let ((root (xCreateWidget 'racine "ApplicationShell" "title" 
			"Tours de Hanoļ")))
	   	(-> Obj 'putvar 'xDessin (xCreateWidget 'dessin "Drawxbvl" root 
			"width" 450 "height" 180))
      		(xRealize root) 
	   	)
	   ))
		; tout effacer la fenetre
	(clear (lambda (Obj)
	   (xSetValues :xDessin "foreground" "#fff")
	   (xFillRectangles :xDessin 0 0 450 180)
	   (xSetValues :xDessin "foreground" "#000")
	   ))
		; reinitialisation = clear de la fenetre 
		; 		    + nouvelle initialisation
	(reinit (lambda (Obj n)
	   (-> Obj 'clear)
	   (-> Obj 'x-initialise n); a ameliorer pour ne pas recreer des inst
	   ))			; mais que faire si n,i+1  !=  n,i
		; initialisation des tiges, disques, + coordonnees graphiques
	(x-initialise (lambda (Obj n)
	   (-> Obj 'initialise n)
	   (-> :t1 'putvar 'x1 5)
	   (-> :t2 'putvar 'x1 155)
	   (-> :t3 'putvar 'x1 305)
	   (-> :t1 'putvar 'x2 75)
	   (-> :t2 'putvar 'x2 225)
	   (-> :t3 'putvar 'x2 375)
	   ))
		; initialisation des disques
	(init-disques (lambda (Obj tige n)
	   (let ((i n) )
			(if (= i 0)
		   	   t
		   	   (let ((d (-> :disque 'newI) ))
				(-> tige 'ajoute d)
				(-> d 'putvar 'dim i)
				(-> d 'putvar 'xCoeff (/ 70 n)) )
		   	   (self (- i 1)) ) ) ))
		; afficher les tiges + disques
	(print (lambda (Obj)		
	   (-> :t1 'print :xDessin)
	   (-> :t2 'print :xDessin)
	   (-> :t3 'print :xDessin) ))
		; deplacer un disque 
		; + mettre a jour l'affichage
	(deplace (lambda (Obj n tD tA)
	   (-> tA 'ajoute (-> tD 'top))
	   (-> tA 'affiche-top :xDessin)
	   (-> tD 'efface-top :xDessin)
	   (-> tD 'enleve)
	   (-> Obj 'temporise)
	   ))
		; faire attendre, pour avoir le temps de voir quelque chose
	(temporise (lambda (Obj i)
	   (setq i 0)
	   (while (< i 10000) (incr i))
	   ))
	))

; fonction de lancement
(de x-hanoi (n)
	(if (get 'xH 'inst-de) 		; objets ET contexte graphique
					; deja crees
		(-> 'xH 'reinit n) 	; pour remettre les disques en
					; position initiale
		(-> 'x-hanoi 'newI 'xH)	; pour creer l'instance x-hanoi 
					; ET creer contexte graphique
		(-> 'xH 'x-initialise n)) 	; pour creer les x-tiges et x-disques
					; et les mettre en position initiale
	(-> 'xH 'print)			; afficher l'etat initial
	(-> 'xH 'exec)			; faire deplacer les disques
)

; --------------------------------------------------------------------------
; et pour continuer ... 
; ---------------------

; implementer un vrai deplacement des disques :
;	remonter la tige de depart, translation vers la tige d'arrivee, 
;	puis descendre sur cette tige

; implementer une version de jeu :
;	l'utilisateur choisit tout seul les deplacement a effectuer
;	- en mode texte (en nommant les tiges concernees)
;	- en mode graphique (en cliquant sur le disque a deplacer ... 

; --------------------------------------------------------------------------