1 ;;; ***********************************************************
  2 ;;; *                                                         *
  3 ;;; * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  4 ;;; *                                                         *
  5 ;;; ***********************************************************
  6 ;;; -*-LISP-*-
  7 
  8 ;;;
  9 ;;;       Bull DKU7102 CTL package
 10 ;;;       6 May 83 by G.Sauvagnat for DKU7102 (SDP mode).
 11 ;;;
 12 
 13 ;;; Include
 14 (%include e-macros)
 15 
 16 ;;; Declarations
 17 (declare (special X Y screenheight screenlinelen tty-type))
 18 (declare (special idel-lines-availablep idel-chars-availablep))
 19 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep))
 20 (declare (special DCTL-insert-mode-on))
 21 (declare (*expr Rprinc Rtyo))
 22 
 23 ;;; Output n to the terminal in decimal.
 24 (defun DCTL-outdec (n)                            ;BSG 3/23/79
 25        ((lambda (have-output)
 26                 (do digi '(1000. 100. 10. 1) (cdr digi) (null digi)
 27                     ((lambda (rem)
 28                              (cond ((or have-output (> rem 0) (= (car digi) 1))
 29                                     (Rtyo (+ 60 rem))
 30                                     (setq have-output t)))
 31                              (setq n (\ n (car digi))))
 32                      (// n (car digi)))))
 33         nil))
 34 
 35 
 36 ; Initialize terminal and terminal control package.
 37 (defun DCTL-init ()
 38        (setq idel-lines-availablep t idel-chars-availablep t)
 39        (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
 40        (setq screenheight 24. screenlinelen 79.)
 41        (setq tty-type 'dku7102)
 42        (DCTL-prologue)
 43        (Rtyo 33)(Rprinc "[2J")                    ; Effacement de l'ecran
 44        (Rtyo 33)(Rprinc "[H")                     ; Positionnement C1 L1
 45        (setq X 0 Y 0))
 46 
 47 
 48 
 49 ;;; Prologue code
 50 (defun DCTL-prologue ()
 51        (Rtyo 33) (Rprinc "[?=h")                  ; Passage en mode SDP
 52        (DCTL-set-insert-mode nil)
 53        (Rtyo 33) (Rprinc "[=l")                   ; Passage en mode PAGE
 54 
 55 
 56 ;;; Epilogue code
 57 (defun DCTL-epilogue ()
 58        (setq DCTL-insert-mode-on nil)
 59        (Rtyo 33) (Rprinc "c"))                    ; Reset Initial State (RIS)
 60 
 61 
 62 
 63 ;;; Move terminal's cursor to desired position.
 64 (defun DCTL-position-cursor (x y)
 65                                                   ;(redf y)
 66        (cond ((and (= x X)(= y Y))
 67               nil)
 68              ((and (= x 0)(= y 0))
 69               (Rtyo 33)(Rprinc "[H")
 70               (setq X 0 Y 0))
 71              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
 72               (cond ((< X x)
 73                      (do ex X (1+ ex)(= ex x)(Rtyo 33)(Rprinc "[C")))
 74                     ((< x X)
 75                      (do ex x (1+ ex)(= ex X)(Rtyo 33)(Rprinc "[D"))))
 76               (cond ((< Y y)
 77                      (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rprinc "[B")))
 78                     ((< y Y)
 79                      (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "[A"))))
 80               (setq X x Y y))
 81 ;; Direct Cursor Addressing is best.
 82              (t (setq X x Y y)
 83                 (Rtyo 33)(Rprinc "[")(DCTL-outdec (1+ y))(Rprinc ";")(DCTL-outdec (1+ x))(Rprinc "f")
 84                     )))
 85 
 86 
 87 
 88 ;;; Output string.
 89 (defun DCTL-display-char-string (string)
 90        ((lambda (strx)
 91                 (cond ((= strx 0))                ;bug in redisplay calls with no string
 92                       (t (DCTL-set-insert-mode nil)
 93 ;                        (cond ((< 19. Y) (Rtyo 33)(Rprinc "[2;7m")))
 94                          (Rprinc string)
 95                          (setq X (+ X strx)))))
 96         (stringlength string)))
 97 
 98 
 99 ;;; Clear to end of screen.
100 (defun DCTL-clear-rest-of-screen ()
101        (Rtyo 33)(Rprinc "[0J"))
102 
103 
104 ;;; Clear to end of line.
105 (defun DCTL-kill-line ()
106        (Rtyo 33)(Rprinc "[0K"))
107 
108 
109 
110 ;;; Insert lines
111 (defun DCTL-insert-lines (n)
112            (Rtyo 33)(Rprinc "[")(DCTL-outdec n)(Rprinc "L")))
113 
114 
115 ;;; Delete lines
116 (defun DCTL-delete-lines (n)
117            (Rtyo 33)(Rprinc "[")(DCTL-outdec n)(Rprinc "M")))
118 
119 
120 ;;; Insert character string
121 (defun DCTL-insert-char-string (str)
122        (DCTL-set-insert-mode t)
123        (Rprinc str)
124        (setq X (+ X (stringlength str))))
125 
126 
127 ;;; Delete characters
128 (defun DCTL-delete-chars (n)
129            (Rtyo 33)(Rprinc "[")(DCTL-outdec n)(Rprinc "P"))
130 
131 
132 ;;; Mode insertion
133 (defun DCTL-set-insert-mode (bit)
134        (if bit                                    ; on le veut on
135            (if DCTL-insert-mode-on                ; ne rien faire
136                else
137                (setq DCTL-insert-mode-on t)
138                (Rtyo 33) (Rprinc "[4h"))
139            else
140            (if (not DCTL-insert-mode-on)
141                else
142                (setq DCTL-insert-mode-on nil)
143                (Rtyo 33) (Rprinc "[4l"))))
144 
145 
146 ;;; Inverse video?
147 ;(defun redf (y)
148 ;       (cond ((< 19. Y) nil)
149 ;            ((and (> 20. Y)(> 20. y)) nil)
150 ;            (t (Rtyo 33)(Rprinc "[0m"))))