; .SSection "De'finition de la structure #:RECTANGLE:WINDOW:TTY" ; ; .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 "*****************************************************************" ; .Centre "$Header: ttywindow.ll,v 4.3 88/11/23 11:41:26 samarcq Exp $" (unless (>= (version) 15.2) (error 'load 'erricf 'ttywindow)) ; pour pouvoir complicer (unless (featurep 'virbitmap) (libload virbitmap)) (setq #:sys-package:colon 'window) (unless (boundp '#:tty:window:tyshowcursor) (defvar #:tty:window:tyshowcursor t)) (defstruct #:image:rectangle:window:tty (cx 0) ; position curseur en x en pixel (cy 0) ; position curseur en y en pixel (lmargin) ; ancienne marge gauche (rmargin) ; ancienne marge droite (tyshowcursor t) ; on voit/ne voit pas le curseur (tty '#:tty:window) ; type de terminal virtuel (itsoft) ; les itsofts ) (de #:image:rectangle:window:tty:create (to le wi he ti hi vi) (let ((win1 (create-window 'window to le wi he ti hi vi)) (win2 (#:image:rectangle:window:tty:make))) (exchvector win1 win2) (typevector win1 '#:image:rectangle:window:tty) ; exch ne le fait pas! (bltvector win1 0 win2 0) (#:image:rectangle:window:tty:cx win1 (x-base-space)) (#:image:rectangle:window:tty:cy win1 (y-base-space)) (#:image:rectangle:window:tty:lmargin win1 0) (#:image:rectangle:window:tty:rmargin win1 (quo (:width win1) (width-space))) (#:image:rectangle:window:tty:itsoft win1 (if (memq '#.#:sys-package:colon #:sys-package:itsoft) #:sys-package:itsoft (cons '#.#:sys-package:colon #:sys-package:itsoft))) win1)) ; .SSection "De'finition des comportements spe'cifiques" ; La se'lection (message CURRENT-WINDOW) d'une fene^tre de type ; #:WINDOW:TTY se'lectionne le type de terminal #:TTY:WINDOW et ajoute ; Le package #:WINDOW:TTY dans le "chemin" des interruptions programmables. ; ; Les marges du canal () et les variables de'crivant la taille de l'e'cran ; sont mises a` jour a` la se'lection de la fene^tre. (de #:image:rectangle:window:tty:current-window (win) (:flip-tty win) (:adjust win) (send-super '#:image:rectangle:window:tty 'current-window win)) (de #:image:rectangle:window:tty:uncurrent-window (win) (itsoft 'flush ()) (tyflush) (when (eq (outchan) ()) (#:image:rectangle:window:tty:lmargin win (lmargin)) (#:image:rectangle:window:tty:rmargin win (rmargin))) (:flip-tty win) (send-super '#:image:rectangle:window:tty 'uncurrent-window win)) (de #:image:rectangle:window:tty:modify-window (win x y w h ti hi vi) (send-super '#:image:rectangle:window:tty 'modify-window win x y w h ti hi vi) (when (and (eq win (current-window)) (or w h)) (:adjust win))) ; .SSection "Fonctions utilitaires" ; Basculement vers le terminal de type #:tty:window. (de :flip-tty (win) (let ((tty #:sys-package:tty) (itsoft #:sys-package:itsoft) (tyshowcursor (tyshowcursor))) (setq #:sys-package:tty (#:image:rectangle:window:tty:tty win)) (setq #:sys-package:itsoft (#:image:rectangle:window:tty:itsoft win)) (tyshowcursor (#:image:rectangle:window:tty:tyshowcursor win)) (#:image:rectangle:window:tty:tty win tty) (#:image:rectangle:window:tty:itsoft win itsoft) (#:image:rectangle:window:tty:tyshowcursor win tyshowcursor) )) ; ajustage des marges et de la taille de l'e'cran (de :adjust (win) (setq #:tty:window:xmax (sub1 (quo (:width win) (width-space))) #:tty:window:ymax (sub1 (quo (:height win) (height-space)))) (setq #:tty:xmax #:tty:window:xmax ; compatibilite' vy5 #:tty:ymax #:tty:window:ymax) (when (eq (outchan) ()) (rmargin (#:image:rectangle:window:tty:rmargin win)) (lmargin (#:image:rectangle:window:tty:lmargin win))) ) ; .Section "Mode Page" ;(de :bol () ; (unless (fixp (inchan)) ; (tycleol)) ; (super-itsoft '#.#:sys-package:colon 'bol ())) ; .Section "De'finition des fonctionnalite's du terminal virtuel" ; .SSection "Fonctionnalite's inde'pendante de la chasse" ; Les ope'rations de'crites ci-dessous fonctionnent aussi bien en ; espacement proportionnel et en espaccement fixe. ; ; Ecriture de caracte`res et de chai^nes de caracte`res a` l'e'cran. (de #:tty:window:tycn (cn) (let ((s "x")) (sset s 0 cn) (#:tty:window:tystring s 1))) (de #:tty:window:tystring (s l) (draw-substring (#:image:rectangle:window:tty:cx (current-window)) (#:image:rectangle:window:tty:cy (current-window)) s 0 l) (#:image:rectangle:window:tty:cx (current-window) (min (:width (current-window)) (add (#:image:rectangle:window:tty:cx (current-window)) (x-inc-substring s 0 l))))) ; passage a` la ligne (defvar #:tty:window:page-mode t) (de #:tty:window:tynewline () (when #:tty:window:page-mode (tycleol)) (#:image:rectangle:window:tty:cx (current-window) 0) (#:image:rectangle:window:tty:cy (current-window) (add (#:image:rectangle:window:tty:cy (current-window)) (height-space))) (when (gt (sub (add (#:image:rectangle:window:tty:cy (current-window)) (height-space)) (y-base-space)) (:height (current-window))) (if #:tty:window:page-mode (tycls) (let ((scroll-height (mul (add1 (div (div (#:window:height (current-window)) 3) (height-space))) (height-space)))) (with ((current-mode #:mode:set)) (bitblit (window-bitmap (current-window)) (window-bitmap (current-window)) 0 0 0 scroll-height (#:window:width (current-window)) (sub (#:window:height (current-window)) scroll-height)) (#:image:rectangle:window:tty:cy (current-window) (sub (#:image:rectangle:window:tty:cy (current-window)) scroll-height)) (current-mode 0) (bitblit (window-bitmap (current-window)) (window-bitmap (current-window)) 0 (sub (#:image:rectangle:window:tty:cy (current-window)) (y-base-space)) 0 0 (#:window:width (current-window)) (#:window:height (current-window)))))))) ; positionnement du curseur dans la ligne (de #:tty:window:tybs (cn) (let ((s "x")) (sset s 0 cn) (#:image:rectangle:window:tty:cx (current-window) (max 0 (sub (#:image:rectangle:window:tty:cx (current-window)) (x-inc-substring s 0 1)))))) (de #:tty:window:tycr () (#:image:rectangle:window:tty:cx (current-window) 0)) ; effacement de l'e'cran ; ; la version "portable" efface l'e'cran en imprimant des chai^nes de ; blancs (caracte`res #\sp). ; ces fonctions peuvent (doivent) bien sur e^tre re'e'crite de manie`re ; plus efficace selon les e'crans. on utilisera par exemple ; la primitive de bitblt pour les e'crans bitmap. (defvar :blankscreen (makestring 256 #\sp)) (de #:tty:window:tycleol () (draw-substring (#:image:rectangle:window:tty:cx (current-window)) (#:image:rectangle:window:tty:cy (current-window)) :blankscreen 0 (quo (sub (:width (current-window)) (#:image:rectangle:window:tty:cx (current-window))) (width-space)))) (de #:tty:window:tycls () (tycursor 0 0) (clear-graph-env)) ; gestion de l'attribut (defvar #:tty:window:tyattrib ()) (de #:tty:window:tyattrib (a) (itsoft 'flush ()) (current-font (if a 1 0))) ; lecture d'un caracte`re avec affichage d'un curseur avant lecture. (defvar :event (#:event:make)) (de #:tty:window:tyi () (tyflush) (when (tyshowcursor) (draw-cursor (#:image:rectangle:window:tty:cx (current-window)) (#:image:rectangle:window:tty:cy (current-window)) t)) (read-event :event) (until (eq (#:event:code :event) 'ascii-event) (read-event :event)) (when (tyshowcursor) (draw-cursor (#:image:rectangle:window:tty:cx (current-window)) (#:image:rectangle:window:tty:cy (current-window)) ())) (#:event:detail :event)) (defvar #:event:code) (de #:tty:window:tys () (when (eventp) (read-event :event) (if (neq (#:event:code :event) 'ascii-event) (#:tty:window:tys) (#:event:detail :event)))) ; .SSection "Les fonctionnalite's fonctionnant uniquement en chasse fixe" ; Les implantations donne'es ci-dessous ne fonctionnent qu'en chasse fixe. ; On pourra parfois re'e'crire ces fonctions, de manie`re ; de'pendante des e'crans, pour fonctionner aussi en chasse variable. ; ; Par exemple, ; les fonctions d'effacement (tyback, tydelch) peuvent e^tre re'e'crites ; en utilisant les primites de bitblit sur le bitmap e'ventuellement ; associe' a` la fene^tre. ; Taille de l'e'cran ; ; ces variables sont mises a` jour automatiquement lors de la se'lection ; et de la modification de taille des fene^tres. (defvar #:tty:window:xmax 79) (defvar #:tty:window:ymax 23) ; de'placement du curseur sur tout l'e'cran (de #:tty:window:tycursor (x y) (tyflush) (#:image:rectangle:window:tty:cx (current-window) (add (x-base-space) (mul (width-space) x))) (#:image:rectangle:window:tty:cy (current-window) (add (y-base-space) (mul (height-space) y)))) ; effacement de caracte`res ; ; le backspace destructif (de #:tty:window:tyback (cn) (tybs cn) (draw-cn (#:image:rectangle:window:tty:cx (current-window)) (#:image:rectangle:window:tty:cy (current-window)) #\sp) ) ; .SSection "Les Fonctionalite's de'pendant de l'implantation" ; Les fonctions ci-dessous doivent e^tre re'e'crites selon les e'crans. ; On y fera utilisation des primitives de bitblit sur un bitmap par exemple. (de #:tty:window:tydelcn (cn)) (de #:tty:window:tyinscn (cn))