; .EnTete "Le-Lisp (c) version 15.2" " " "V D T"
; .EnPied " " "%" " "
; .Chapitre 11 "V D T"
;
; .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: vdt.ll,v 4.1 88/01/13 12:24:57 kuczynsk Rel $"

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

; Petite de'monstration de l'utilisation des fonctions
; du terminal virtuel, de l'art de
; l'animation vide'o et de sa proble'matique en Lisp :
;   - utilisation de la fonction TYS
;   - e'viter les "garbage-collections"
;   - avec une vitesse inde'pendante de la taille des objets
 
(de vdt ()
     (let ((dir 'd)           ; la direction du ver (en symbolique).
           (lobst)            ; la liste des obstacles
           (chemin)           ; le chemin du ver.
           (ochemin)          ; le chemin du coup pre'ce'dent.
           (taille)           ; la taille du ver.
           (x (div (tyxmax) 2))  ; la position actuelle de la
           (y (div (tyymax) 2))  ;    te^te du lombric.
           (xy)               ; la position packe'e.
           (cou)              ; la position du cou de la be^te.
           (score 0)          ; comme son nom l'indique.
           (mscore 0))        ; les milliers (du score)
           ;
           ; 1) dessine le cadre
           ;
           (typrologue)
           (tycls)
           (tyattrib ())
           (tyco 10 0 '#"***   V . D . T .   ***     Score :")
           (tycursor 0 1)
           (repeat (tyxmax) (tyo #/.))
           (tycursor 0 (tyymax))
           (repeat (tyxmax) (tyo #/.))
           (let ((y 1))
                (repeat (1- (tyymax))
                   (tyco 0 y #/.)
                   (tyco (tyxmax) y #/.)
                   (incr y)))
           ;
           ; 2) fabrique le 1er lombric et la liste des obstacles.
           ;
           (repeat (setq taille 5)
                   (newl chemin (+ (* y 128) (incr x))))
           (mapc (lambda (x y)
                         (newl lobst (+ (* y 128) x))
                         (tyco x y #/*))
                 (list 10 10 (- (tyxmax) 10) 
                       (- (tyxmax) 10) (div (tyxmax) 2))
                 (list 5 (- (tyymax) 5) 5 (- (tyymax) 5) 
                        (div (tyymax) 2))
           )
           ;
           ; 3) la boucle principale
           ;
           ; une petite attente ... pour se preparer
           (tyflush)
           (repeat 2 (gc))
           (untilexit vdt
               ; de'codage de la commande
               (selectq (tys)
                  ((#/s #/h #:tty:left)  (if (neq dir 'd) (setq dir 'g)))
                  ((#/f #/l #:tty:right) (if (neq dir 'g) (setq dir 'd)))
                  ((#/c #/j #:tty:down)  (if (neq dir 'h) (setq dir 'b)))
                  ((#/e #/k #:tty:up)    (if (neq dir 'b) (setq dir 'h)))
                  (#^C (exit vdt))
                  (())
                  (t (tybeep)))
               ; on efface la queue
               (setq ochemin chemin)
               (tyco (rem (car chemin) 128)
                     (div (nextl chemin) 128)
                     #/  )
               ; a-t-il fait ou` on lui disait de faire ?
               (when (= (rem score 100) 99)
                     (newl lobst (car ochemin))
                     (tyco (rem (car ochemin) 128)
                           (div (car ochemin) 128)
                           #/*  ))
               ; on calcule la nouvelle position
               (selectq dir
                  (g (decr x) (when (<= x 0) (exit vdt)))
                  (d (incr x) (when (>= x (tyxmax)) (exit vdt)))
                  (h (decr y) (when (<= y 1) (exit vdt)))
                  (b (incr y) (when (>= y (tyymax)) (exit vdt)))
                  (t ()))
               ; grandit-il ?
               (when (= (rem score 20) 10)
                     (newl chemin (car ochemin))
                     (tycursor 60 0)
                     (tyod (incr taille) 3))
               ; test si le lombric se coupe ou se cogne
               (setq xy (+ (* y 128) x))
               (when (or (memq xy chemin) (memq xy lobst))
                     (exit vdt))
               ; on l'ajoute au chemin sans vraiment "conser"
               (setq cou (last chemin))
               (rplacd cou (rplac ochemin xy ()))
               ; et on affiche le cou et la tete
               (tyco (rem (car cou) 128) (div (car cou) 128) #/o)
               (tyco x y #/@)
               ; affiche le score la aussi sans "conser"
               (when (>= (incr score) 1000)
                     (setq score 0)
                     (tycursor 50 0)
                     (tyod (incr mscore) 3))
               (tycursor 53 0)
               (tyod score 3)
               ; l'attente programme'e
               (when (< taille 150)
                     (repeat 500)
                     (when (< taille 100)
                           (repeat 100)
                           (when (< taille 50)
                                 (repeat 2000)
                                 (when (< taille 20)
                                       (repeat 500)
                                       (when (< taille 10)
                                             (repeat 5000))))))
 
           )
          ; pour ne pas effacer le score.
          (tyco 0 (1- (tyymax)) '#"Vous vous etes tamponne."))
          (tyflush)
          'vdt)))))
 
(de vdtend ()
    (mapc 'remfn '(vdt vdtend))
    (libautoload vdt vdt))