; .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))