1 ;;; ***********************************************************
  2 ;;; *                                                         *
  3 ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4 ;;; *                                                         *
  5 ;;; ***********************************************************
  6 
  7 ;;; HISTORY COMMENTS:
  8 ;;;  1) change(86-04-23,Margolin), approve(86-04-23,MCR7325),
  9 ;;;     audit(86-08-12,Harvey), install(86-08-20,MR12.0-1136):
 10 ;;;     Added *expr declarations to prevent compiler warnings, and removed the
 11 ;;;     CR characters before newlines.
 12 ;;;                                                      END HISTORY COMMENTS
 13 
 14 
 15 ;;;
 16 ;;;       TDV2220 control package
 17 ;;;       bb 1981-08-19
 18 
 19 (%include e-macros)
 20 
 21 (declare (special X Y screenheight screenlinelen ospeed))
 22 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
 23 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep))
 24 (declare (special region-scroll-availablep))
 25 (declare (*expr Rprinc Rtyo))
 26 
 27 ;;; Macro to output escape sequence
 28 (defun tdv2220-escape ()
 29        (Rtyo 33) (Rprinc "["))
 30 
 31 ;;; Output n to the terminal in decimal.
 32 (defun DCTL-outdec (n)                            ;BSG 3/23/79
 33        ((lambda (have-output)
 34                 (do digi '(1000. 100. 10. 1) (cdr digi) (null digi)
 35                     ((lambda (rem)
 36                              (cond ((or have-output (> rem 0) (= (car digi) 1))
 37                                     (Rtyo (+ 60 rem))
 38                                     (setq have-output t)))
 39                              (setq n (\ n (car digi))))
 40                      (// n (car digi)))))
 41         nil))
 42 
 43 
 44 ;;; Output padding, based on n pad characters at 9600-baud
 45 (defun DCTL-pad (n)
 46        (do-times (// (* n ospeed) 960.)
 47                  (Rtyo 0)))
 48 
 49 
 50 ;;; Initialize terminal and terminal control package.
 51 (defun DCTL-init ()
 52        (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
 53        (setq idel-lines-availablep t idel-chars-availablep t)
 54        (setq region-scroll-availablep nil)
 55        (setq screenheight 24. screenlinelen 79.)
 56        (setq tty-type 'tdv2220)
 57        (DCTL-prologue)
 58        (DCTL-home-cursor)
 59        (DCTL-clear-rest-of-screen))
 60 
 61 ;;; Initialization that must also be done after a QUIT
 62 (defun DCTL-prologue ()
 63        (tdv2220-escape) (Rprinc "36l"))
 64 
 65 
 66 ;;; Restore terminal to outside state
 67 (defun DCTL-epilogue ()
 68        (tdv2220-escape) (Rprinc "36h"))
 69 
 70 
 71 ;;; Move terminal's cursor to desired position.
 72 (defun DCTL-position-cursor (x y)
 73        (let ((deltax (- x X))
 74              (deltay (- y Y)))
 75        (cond ((= deltay 0)
 76               (cond ((= deltax 0) nil)
 77                     ((> deltax 0) (tdv2220-escape) (DCTL-outdec deltax)
 78                                   (Rprinc "C"))
 79                     ((= x 0) (Rtyo 15))  ;move left
 80                     (t (tdv2220-escape) (DCTL-outdec (- deltax)) (Rprinc "D"))))
 81              ((= deltax 0)
 82               (cond ((> deltay 0) (tdv2220-escape) (DCTL-outdec deltay)
 83                                   (Rprinc "B"))
 84                     (t (tdv2220-escape) (DCTL-outdec (- deltay)) (Rprinc "A"))))
 85              (t (tdv2220-absolute-position x y)))
 86        (setq X x Y y)))
 87 
 88 
 89 ;;; Perform absolute cursor positioning
 90 (defun tdv2220-absolute-position (x y)
 91        (tdv2220-escape)
 92        (DCTL-outdec (1+ y))             ;both arguments plus
 93        (Rprinc ";")                           ;semicolon must be present
 94        (DCTL-outdec (1+ x))
 95        (Rprinc "H"))
 96 
 97 
 98 ;;; Output string.
 99 (defun DCTL-display-char-string (string)
100        (setq X (+ X (stringlength string)))
101        (Rprinc string))
102 
103 
104 ;;; Home cursor to upper left corner.
105 (defun DCTL-home-cursor ()
106        (setq X 0 Y 0)
107        (tdv2220-escape) (Rprinc "H"))             ;direct cursor address
108 ;without args.
109 
110 ;;; Clear to end of screen.
111 (defun DCTL-clear-rest-of-screen ()
112        (tdv2220-escape) (Rprinc "J"))
113 
114 
115 ;;; Clear to end of line.
116 (defun DCTL-kill-line ()
117        (tdv2220-escape) (Rprinc "K"))
118 
119 
120 ;;; Insert n lines at the current cursor position
121 (defun DCTL-insert-lines (n)
122        (tdv2220-escape) (DCTL-outdec n) (Rprinc "L")
123        (DCTL-pad (* n 10.)))
124 
125 
126 ;;; Delete n lines at the current cursor position
127 (defun DCTL-delete-lines (n)
128        (tdv2220-escape) (DCTL-outdec n) (Rprinc "M")
129        (DCTL-pad (* n 10.)))
130 
131 
132 ;;; Insert string at the current cursor position
133 (defun DCTL-insert-char-string (string)
134        (tdv2220-escape) (DCTL-outdec (stringlength string))
135        (Rprinc "@")                               ;Insert blanks
136        (DCTL-display-char-string string))         ;and print the string.
137 
138 (defun DCTL-delete-chars (n)
139        (tdv2220-escape) (DCTL-outdec n)
140        (Rprinc "P"))