; .EnTete "Le-Lisp (c) version 15.2" " " "Les Tours de Hanoi"
; .EnPied " " "%" " "
; .Chapitre 10 "Les Tours de Hanoi Anime'es"
;
; .Centre "*****************************************************************"
; .Centre " Ce fichier est en lecture seule hors du projet ALE de l'INRIA.  "
; .Centre " Il est maintenu par ILOG SA, 2 Avenue Gallie'ni, 94250 Gentilly "
; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA                 "
; .Centre "*****************************************************************"

; .Centre "$Header: whanoi.ll,v 4.1 88/01/13 12:25:18 kuczynsk Rel $"

(unless (>= (version) 15.2)
        (error 'load 'erricf 'whanoi))

; Tous les symboles pre'ce'de's de : seront cre'e's
; dans le package WHANOI.

(defvar #:sys-package:colon 'whanoi)

; Ce programme, qui simule e'galement une tour de Hanoi,
; utilise les possibilite's d'affichage asynchrone
; du syste`me Le←Lisp (redisplayscreen).

;----   De'finition des objets globaux

(defvar :nsdpy 0)   ; pour les statistiques sur "redisplayscreen"

;----   Fonctions auxiliaires

(dmd :coord (x y) 
     ; calcule les :coordonne'es du point <x> <y>
     `(+ (* (1+ (tyxmax)) ,y) ,x))

(de :redisplay ()
    ; re:affiche le nouvel e'cran
    (redisplayscreen nscreen oscreen
                     (1+ (tyxmax)) (1+ (tyymax)))
    (tyflush))

(dmd :fillxy (x y string)
     ; remplit <nscreen> a` partir de <x> <y> avec <string>
     `(bltstring nscreen (:coord ,x ,y) ,string))

(de :nieme-disque (n)
    ; retourne la chai↑ne du <n>ie`me disque
    (vref #["          |          "
            "         *|*         "
            "        **|**        "
            "       ***|***       "
            "      ****|****      "
            "     *****|*****     "
            "    ******|******    "
            "   *******|*******   "
            "  ********|********  "
            " *********|********* "
            "====================="
            "                     "]
          n))

;----   Les fonctions principales

(de whanoi n
    ; pour mesurer la rapidite' du "redisplayscreen"
    (let ((rt (runtime)) (:nsdpy 0))
         (:hanoi n)
         (print "Nb de redisplayscreen : " :nsdpy)
         (print "temps total           : " 
                (setq rt (differ (runtime) rt)))
         (print "temps moyen           : " 
                (/ rt :nsdpy))))))))

(de :hanoi (n)
    (if (consp n)
        (setq n (car n))
        (print "Combien de disque ")
        (setq n (read)))
    (unless (and (numberp n) (> n 0) (< n 10))
            (error 'whanoi 'erroob n))
    (let ((oscreen (makestring (:coord 0 (1+ (tyymax))) #\sp))
          (nscreen (makestring (:coord 0 (1+ (tyymax))) #\sp)))
         (typrologue)
         (tycls)
         (let ((a1 '(10))        ; contenu de la 1e`re aiguille
               (a2 '(10))        ; contenu de la 2e`me aiguille
               (a3 '(10))        ; contenu de la 3e`me aiguille
               (nmv 0))          ; nombre de mouvements
              (putprop 'a1 2 'pos)
              (putprop 'a2 27 'pos)
              (putprop 'a3 52 'pos)
              (let ((n n)) (repeat n (newl a1 n) (decr n)))
              (let ((s "Les Tours de Hanoi"))
                   (for (i 0 1 (sub1 (slen s)))
                        (sset s i (logor #$80 (sref s i))))
                   (:fillxy 28 1 s))
              (:affiche 'a1)
              (:affiche 'a2)
              (:affiche 'a3)
              (:redisplay)
              (incr :nsdpy)
              (:moteur n 'a1 'a3 'a2)
              (tycursor 0 (tyymax))
              (tyflush)
             ':hanoi)))

(de :moteur (n dep arr int)
    (when (> n 0)
          (:moteur (1- n) dep int arr)
          (:bouge n dep arr)
          (:moteur (1- n) int arr dep))))

(de :bouge (n dep arr)
    (:fillxy 18 4 (incr nmv))
    (:fillxy 20 4 " : je bouge le disque ")
    (:fillxy 42 4 n)
    (:fillxy 44 4 " de ")
    (:fillxy 48 4 dep)
    (:fillxy 50 4 " vers ")
    (:fillxy 56 4 arr)
    (:monte n (getprop dep 'pos) (- 10 (length (eval dep))))
    (:avance n (getprop dep 'pos) (getprop arr 'pos))
    (:descend n (getprop arr 'pos) (- 10 (length (eval arr))))
    (set dep (cdr (eval dep)))
    (set arr (cons n (eval arr))))))


;-----   La fonction d'affichage

(de :affiche (a)
    ; :affiche toute l'aiguille "a"
    (let ((y 21)
          (l (reverse (eval a)))
          (x (getprop a 'pos)))
         (repeat 10
                 (:fillxy x (decr y) 
                              (:nieme-disque (or (nextl l) 0))))
         (:fillxy (+ x 10) 21 a)))

;-----   Les fonctions de mouvement de disque

(de :monte (n x nb)
    ; disque "n" en "x" "nb" fois
    (let ((y (+ nb 10)))
         (repeat (1+ nb)
                 (:fillxy x y (:nieme-disque n))
                 (:fillxy x (1+ y) (:nieme-disque 0))
                 (:redisplay) 
                 (incr :nsdpy)
                 (decr y))))))))))

(de :descend (n x nb)
    ; disque "n" en "x" "nb" fois
    (let ((y 11))
         (:fillxy x 10 (:nieme-disque 11))
         (repeat (1- nb)
                 (:fillxy x y (:nieme-disque 0))
                 (:fillxy x (incr y) (:nieme-disque n))
                 (:redisplay) 
                 (incr :nsdpy))))))

(de :avance (n x1 x2)
    ; :avance horizontalement le disque "n" de "x1" vers "x2"
    (if (> x1 x2)
        (repeat (- x1 x2) 
                (:fillxy (decr x1) 10 (:nieme-disque n))
                (:redisplay) 
                (incr :nsdpy)))
        (repeat (- x2 x1) 
                (:fillxy (incr x1) 10 (:nieme-disque n))
                (:redisplay) 
                (incr :nsdpy))))))

;-----   Pour re'cuperer la place occupe'e par WHANOI

(de whanoiend ()
    (mapc 'remob (oblist '#.#:sys-package:colon))
    (libautoload whanoi whanoi)
    'whanoiend)