; .EnTete "Le-Lisp (c) version 15.2" " " "Gestion du terminal virtuel"
; .EnPied " " "%" " "
; .Chapitre 8 "Gestion du Terminal"
;
; .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: virtty.ll,v 4.4 89/01/04 16:42:38 neidl Exp $"
(unless (>= (version) 15.2)
(error 'load 'erricf 'virtty))
(add-feature 'virtty)
; La variable globale #:sys-package:tty contient le nom du
; package a` partir
; duquel seront recherche'es les fonctions du terminal.
; Par de'faut cette variable contient TTY.
; Le chargement d'un nouveau type de terminal doit :
; - charger cette variable avec un nom de type #:TTY:nom
; - de'finir les fonctions qui changent, ces fonctions e'tant
; dans le package #:TTY:nom
(defvar #:sys-package:tty 'tty)
; La fonction INITTY, appele'e au de'but du chargement
; de toute image-me'moire, doit de'finir cette variable.
; Fonctions du terminal virtuel :
;
; Standard :
; (tyi) lit un caracte`re sur le terminal
; (tys) indique si un caracte`re est disponible au terminal et le lit
; (tyinstring strg) ligne un ligne en aveugle et la met dans la
; chaine. Retourne le nombre de caracteres lus.
; (tyo o1 o2 ... on) imprime les objets (cn, pname, string) dans le
; tampon du terminal.
; (tyflush) vide le tampon du terminal
; (tyod n nc) valeur nume'rique de n sur nc caracte`res
; (redisplayscreen ...) voir doc Chapitre 7.
;
; Obligatoires :
; (tycursor x y) positionne le curseur en "x" (col.) et "y" (ligne)
; (tycls) efface tout l'e'cran
;
; Facultatifs :
; les fonctions suivantes peuvent ne rien signifier
; pour un certain type de terminal, mais doivent e↑tre
; toujours de'finies. Elles retournent () lorsqu'elles
; sont sans signification, une valeur non () sinon.
;
; (typrologue) qui initialise le terminal en mode vide'o
; (tyepilogue) qui termine le mode vide'o du terminal
; (tycleol) efface du caracte`re courant a` la fin de la ligne
; (tycleos) efface du caracte`re courant a` la fin de l'e'cran
; (tybeep) de'clenche la sonnette
; (tyinsch cn) inse`re le caracte`re cn a` la position du curseur
; (tyinscn cn) inse`re le caracte`re cn a` la position du curseur
; (tydelch) enle`ve le caracte`re a` la position du curseur
; (tydelcn cn) enle`ve le caracte`re cn a` la position du curseur
; (tyinsln) inse`re une nouvelle ligne a` la position courante
; (tydelln) enle`ve la ligne courante
; (tyattrib [i]) change/lit le mode de l'attribut
; (tybs cn) recule sans effacer sur le caractere cn
; (tycr) retourne en colonne 0
; (tyshowcursor [i]) cache ou montre le curseur
;
; Fonctions compose'es :
; (tyco x y c1 c2 ... cn) positionne le curseur et affiche les car.
; (tycot x y c1 c2 ... cn) idem, mais avec l'attribut positionne'
; .Section "La 5e`me fonction standard sur terminal"
(de tyod (x n) (to-tty 'tyod x n))
(de #:tty:tyod (x n)
; Affiche l'entier <x> sur au moins <n> caracte`res
(when (or (gt n 1) (gt x 9)) (#:tty:tyod (div x 10) (sub1 n)))
(tyo (add #/0 (rem x 10))))
; .Section "Fonctions et Variables du terminal virtuel"
(dmd to-tty (cmd . larg)
`(funcall (getfn #:sys-package:tty ,cmd ()) ,@larg))
(dmd get-tty (var)
`(symeval (getsymb #:sys-package:tty ,var ())))
(de tyerror (appel) (to-tty 'tyerror appel))
(de typrologue () (to-tty 'typrologue))
(de tyepilogue () (to-tty 'tyepilogue))
(de tycleol () (to-tty 'tycleol))
(de tycleos () (to-tty 'tycleos))
(de tybeep () (to-tty 'tybeep))
(de tyinsch (cn) (to-tty 'tyinsch cn))
(de tydelch () (to-tty 'tydelch))
(de tyinscn (cn) (to-tty 'tyinscn cn))
(de tydelcn (cn) (to-tty 'tydelcn cn))
(de tyinsln () (to-tty 'tyinsln))
(de tydelln () (to-tty 'tydelln))
(de tyattrib x
(ifn x
(get-tty 'tyattrib)
(to-tty 'tyattrib (car x))
(set (getsymb #:sys-package:tty 'tyattrib ()) (car x))))
(de tybs (cn) (to-tty 'tybs cn))
(de tycr () (to-tty 'tycr))
(de tyshowcursor x
(ifn x
(get-tty 'tyshowcursor)
(to-tty 'tyshowcursor (car x))
(set (getsymb #:sys-package:tty 'tyshowcursor ()) (car x))))
(de tyname () (get-tty 'name))
(de tyxmax () (get-tty 'xmax))
(de tyymax () (get-tty 'ymax))
(de tyupkey () (get-tty 'up))
(de tydownkey () (get-tty 'down))
(de tyleftkey () (get-tty 'left))
(de tyrightkey () (get-tty 'right))
; .Section "Fonctions et Variables par de'faut"
(de #:tty:tyerror (appel) ())
(de #:tty:typrologue ())
(de #:tty:tyepilogue ())
(de #:tty:tycleol () (tyerror '(tycleol)))
(de #:tty:tycleos () (tyerror '(tycleos)))
(de #:tty:tybeep () (tyo #↑G))
(de #:tty:tyinsch (cn) (tyerror (list 'tyinsch cn)))
(de #:tty:tyinscn (cn) (tyerror (list 'tyinscn cn)))
(de #:tty:tydelch () (tyerror '(tydelch)))
(de #:tty:tydelcn (cn) (tydelch))
(de #:tty:tyinsln () (tyerror '(tyinsln)))
(de #:tty:tydelln () (tyerror '(tydelln)))
(de #:tty:tyattrib (i) (tyerror (list 'tyattrib i)))
(de #:tty:tybs (cn) (tyo #\bs))
(de #:tty:tycr () (tyo #\cr))
(de #:tty:tyshowcursor (i) (tyerror (list 'tyshowcursor i)))
(defvar #:tty:tyattrib ())
(defvar #:tty:tyshowcursor ())
(defvar #:tty:name 'dumb)
(defvar #:tty:xmax 79)
(defvar #:tty:ymax 23)
(defvar #:tty:up #↑P)
(defvar #:tty:down #↑N)
(defvar #:tty:left #↑B)
(defvar #:tty:right #↑F)
; .SSection "Les fonctions compose'es"
(de tyco (x y cn . l)
(tycursor x y)
(tyo cn)
(while l (tyo (nextl l))))
(de tycot (x y cn . l)
(tycursor x y)
(tyattrib t)
(tyo cn)
(while l (tyo (nextl l)))
(tyattrib ()))
; .Section "La fonction initty"
(de initty term
; on cherche et on charge le vrai nom de terminal
(setq #:tty:name
(symbol ()
(cond ((consp term)
; l'argument fourni
(car term))
((getenv "TERM"))
((system)))))
; on regarde si l'on n'aurait pas de'ja` fait initty
; sur le me↑me terminal physique.
(unless (and #:sys-package:tty
(equal (string #:tty:name) (string #:sys-package:tty)))
(let ((file (catenate #:system:virtty-directory
#:tty:name
#:system:lelisp-extension)))
; on essaye de charger le fichier relatif au terminal
(if (probefile file)
(loadfile file t)
(or (consp (catcherror t
; on charge le traducteur termcap -> virtty
(libload termcap)
; on effectue la traduction
; ne pas foutre en l'air le FUNCALL
(funcall '#:termcap:compile #:tty:name file)
; on decharge le traducteur
(mapc 'remob (oblist 'termcap))
; on charge le fichier traduit
(loadfile file t)))
(consp (catcherror t
; on charge le traducteur terminfo -> virtty
(libload terminfo)
; on effectue la traduction
; ne pas foutre en l'air le FUNCALL
(funcall '#:terminfo:compile #:tty:name file)
; on decharge le traducteur
(mapc 'remob (oblist 'terminfo))
; on charge le fichier traduit
(loadfile file t)))))
#:tty:name)))