1 ;;; -*-LISP-*-
  2 
  3 ;;;
  4 ;;;       HISI VIP7201 control package
  5 ;;;       Ripped off from VIP7800ctl  MBA 82-6-3 (!)
  6 ;;;
  7 
  8 (%include e-macros)
  9 
 10 (declare (special X Y ospeed screenheight screenlinelen tty-type))
 11 (declare (special idel-lines-availablep idel-chars-availablep))
 12 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep DCTL-insert-mode-on))
 13 (declare (*expr Rprinc Rtyo))
 14 
 15 
 16 ; Initialize terminal and terminal control package.
 17 (defun DCTL-init ()
 18        (setq idel-chars-availablep t
 19              idel-lines-availablep (not (> ospeed 240.))) ; painfully slow idel-lines
 20        (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
 21        (setq screenheight 24. screenlinelen 79.)
 22        (setq tty-type 'vip7201)
 23        (setq X 0 Y 0)
 24        (DCTL-prologue)
 25           )
 26 
 27 
 28 ;;; Prologue code
 29 (defun DCTL-prologue ()
 30        (setq DCTL-insert-mode-on nil)
 31        (Rtyo 33) (Rprinc "`"))
 32 
 33 
 34 ;;; Epilogue code
 35 (defun DCTL-epilogue ()
 36        (setq DCTL-insert-mode-on nil)
 37        (Rtyo 33) (Rprinc "`"))
 38 
 39 ; Move terminal's cursor to desired position.
 40 (defun DCTL-position-cursor (x y)
 41        (cond ((and (= x X)(= y Y))
 42               nil)
 43              ((and (= x 0)(= y 0))
 44               (Rtyo 33)(Rprinc "H")
 45               (setq X 0 Y 0))
 46              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
 47               (cond ((< X x)
 48                      (do ex X (1+ ex)(= ex x)(Rtyo 33)(Rprinc "C")))
 49                     ((< x X)
 50                      (do ex x (1+ ex)(= ex X)(Rtyo 33)(Rprinc "D"))))
 51               (cond ((< Y y)
 52                      (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rprinc "B")))
 53                     ((< y Y)
 54                      (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "A"))))
 55               (setq X x Y y))
 56 ;; Direct Cursor Addressing is best.
 57              (t (setq X x Y y)
 58                 (Rtyo 33)(Rprinc "f")(Rtyo (+ 40 x))(Rtyo (+ 40 y))
 59                     )))
 60 
 61 
 62 ;;; Output string.
 63 (defun DCTL-display-char-string (string)
 64        ((lambda (strx)
 65                 (cond ((= strx 0))                ;bug in redisplay calls with no string
 66                       (t (cond (DCTL-insert-mode-on
 67                                  (setq DCTL-insert-mode-on nil)
 68                                  (Rtyo 33) (Rprinc "[J")))
 69                          (Rprinc string)
 70                          (setq X (+ X strx)))))
 71         (stringlength string)))
 72 
 73 
 74 ; Clear to end of screen.
 75 (defun DCTL-clear-rest-of-screen ()
 76        (Rtyo 33)(Rprinc "J")
 77        (Rtyo 0))  ;needed only at 9.6kb
 78 
 79 
 80 ; Clear to end of line.
 81 (defun DCTL-kill-line ()
 82        (Rtyo 33)(Rprinc "K"))
 83 
 84 
 85 (defun DCTL-insert-lines (n)
 86        (do i 1 (1+ i)(> i n)
 87                (Rtyo 33)(Rprinc "[L")))
 88 
 89 (defun DCTL-delete-lines (n)
 90        (do i 1 (1+ i)(> i n)
 91                (Rtyo 33)(Rprinc  "[M")))
 92 
 93 (defun DCTL-insert-char-string (str)
 94        (cond (DCTL-insert-mode-on)
 95              (t
 96                (setq DCTL-insert-mode-on t)
 97                (Rtyo 33) (Rprinc "[I")))
 98        (Rprinc str)
 99        (setq X (+ X (stringlength str))))
100 
101 
102 (defun DCTL-delete-chars (n)
103        (do i 0 (1+ i)(= i n)
104            (Rtyo 33)(Rprinc "[P")))