1 ;;; ***********************************************************
  2 ;;; *                                                         *
  3 ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4 ;;; *                                                         *
  5 ;;; * Copyright (c) 1978 by Massachusetts Institute of        *
  6 ;;; * Technology and Honeywell Information Systems, Inc.      *
  7 ;;; *                                                         *
  8 ;;; ***********************************************************
  9 ;;;
 10 ;;;
 11 ;;;        TVI920 control ripped off from ADM3A, TELERAY1061
 12 ;;;        by CLS         06/20/80
 13 ;;;           modified    08/11/80 to  fix insert-chars
 14 ;;;           modified    09/05/80 to  add pad control for =>1200 baud
 15 ;;;           modified    09/18/80 by CDT to pad efficiently at all speeds
 16 
 17 ;;; The TVI920C has a 240-character writebehind buffer that can be used to
 18 ;;; good effect by carefully under-padding operations that need padding.
 19 ;;; Since there is no way to underpad these things deterministically (since
 20 ;;; emacs never lets you know when it has gone blocked for read and therefore
 21 ;;; you really don't know when the buffer is likely to have emptied itself out)
 22 ;;; we cautiously underpad by only slight amounts.
 23 
 24 (declare (special X Y screenheight screenlinelen tty-type ospeed))
 25 (declare (special idel-lines-availablep idel-chars-availablep))
 26 (declare (special DCTL-writebehind-buf-used))
 27 
 28 
 29 ;;; initialize terminal and terminal control package.
 30 
 31 (defun DCTL-init ()
 32        (setq idel-lines-availablep t idel-chars-availablep t)
 33        (setq screenheight 24. screenlinelen 79.)
 34        (setq tty-type 'tvi920)
 35        (DCTL-clear-writebehind-buf)
 36        (Rtyo 36)(Rtyo 33)(Rprinc "Y")
 37        (setq X 0 Y 0))
 38 
 39 ;;; prologue and epilogue will go here
 40 
 41 
 42 ;;; Move terminal's cursor to desired position.
 43 
 44 (defun DCTL-position-cursor (x y)
 45        (cond ((and (= x X)(= y Y))
 46               nil)
 47              ((and (= x 0)(= y 0))
 48               (Rtyo 36)
 49              (setq X 0 Y 0))
 50              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
 51               (cond ((< X x)
 52                      (do ex X (1+ ex)(= ex x)(Rtyo 14)))
 53                     ((< x X)
 54                      (do ex x (1+ ex)(= ex X)(Rtyo 10))))
 55               (cond ((< Y y)
 56                      (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
 57                     ((< y Y)
 58                      (do wy y (1+ wy)(= wy Y)(Rtyo 13))))
 59               (setq X x Y y))
 60 ;; Direct cursor addressing is best.
 61               (t (setq X x Y y)
 62                  (Rtyo 33)(Rprinc "=")
 63                  (Rtyo (+ 40 y))(Rtyo (+ 40 x)))))
 64 
 65 
 66 ;;; Output string.
 67 
 68 (defun DCTL-display-char-string (string)
 69        (Rprinc string)
 70        (setq X (+ X (stringlength string))))
 71 
 72 
 73 ;;; clear to end of screen.
 74 
 75 (defun DCTL-clear-rest-of-screen ()
 76        (Rtyo 33)(Rprinc "Y"))
 77 
 78 
 79 ;;; Clear to end of line.
 80 
 81 (defun DCTL-kill-line ()
 82        (Rtyo 33)(Rprinc "T"))
 83 
 84 
 85 ;;; Insert lines n blank lines at current position.
 86 
 87 (defun DCTL-insert-lines (n)
 88        (DCTL-clear-writebehind-buf)
 89        (do i 1 (1+ i)(> i n)
 90                (Rtyo 33)(Rprinc "E")
 91                (DCTL-underpad 78.))
 92        (setq X 0)
 93        (DCTL-clear-writebehind-buf))
 94 
 95 
 96 ;;; Delete lines.
 97 
 98 (defun DCTL-delete-lines (n)
 99        (DCTL-clear-writebehind-buf)
100        (do i 1 (1+ i)(> i n)
101                (Rtyo 33)(Rprinc "R")
102                (DCTL-underpad 78.))
103        (setq X 0)
104        (DCTL-clear-writebehind-buf))
105 
106 
107 ;;; Insert Characters
108 
109 (defun DCTL-insert-char-string (str)
110        (DCTL-clear-writebehind-buf)
111        (do i (stringlength str) (1- i) (= i 0)
112            (Rtyo 33) (Rprinc "Q")
113            (DCTL-underpad 19.))
114        (Rprinc str)
115        (DCTL-clear-writebehind-buf)
116        (setq X (+ X (stringlength str))))
117 
118 
119 ;;; Delete Characters.
120 
121 (defun DCTL-delete-chars (n)
122        (DCTL-clear-writebehind-buf)
123        (do i 0 (1+ i)(= i n)
124            (Rtyo 33)(Rprinc "W")
125            (DCTL-underpad 19.))
126        (DCTL-clear-writebehind-buf))
127 
128 
129 ;;; Send pad characters to wait specified number of milliseconds
130 ;;; We underpad to take advantage of the 240-char writebehind buffer in the
131 ;;; terminal.  We underpad by 1/3 the buffer and hope it works.
132 
133 (defun DCTL-underpad (n)
134        (do i (1+ (// (* n ospeed) 1000.)) (1- i) (= i 0)
135            (setq DCTL-writebehind-buf-used (1+ DCTL-writebehind-buf-used))
136            (cond ((> DCTL-writebehind-buf-used 80.)(Rtyo 0)))))
137 
138 
139 (defun DCTL-clear-writebehind-buf ()
140        (setq DCTL-writebehind-buf-used 0))