1 ;;; ***********************************************************
  2 ;;; *                                                         *
  3 ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4 ;;; *                                                         *
  5 ;;; ***********************************************************
  6 ;;; -*-LISP-*-
  7 
  8 ;;;
  9 ;;;       ADDS Regent 200 ctl
 10 ;;;       Ripped off from VIP7800 ctl 02/15/80 by CDT
 11 ;;;
 12 
 13 (declare (special X Y screenheight screenlinelen tty-type))
 14 (declare (special idel-lines-availablep idel-chars-availablep))
 15 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep DCTL-insert-mode-on))
 16 
 17 
 18 ; Initialize terminal and terminal control package.
 19 (defun DCTL-init ()
 20        (setq idel-lines-availablep t idel-chars-availablep t)
 21        (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
 22        (setq screenheight 24. screenlinelen 79.)
 23        (setq tty-type 'regent200)
 24        (Rtyo 33)(Rprinc "s")(Rtyo 14)
 25        (setq X 0 Y 0)
 26        (DCTL-prologue))
 27 
 28 
 29 ;;; Prologue code
 30 (defun DCTL-prologue ()
 31        (setq DCTL-insert-mode-on nil)
 32        (Rtyo 14)
 33        (setq X 0 Y 0))
 34 
 35 ;;; Epilogue code
 36 (defun DCTL-epilogue ()
 37        (setq DCTL-insert-mode-on nil)
 38        (Rtyo 33)(Rprinc "s")(Rtyo 14))
 39 
 40 
 41 ; Move terminal's cursor to desired position.
 42 (defun DCTL-position-cursor (x y)
 43        (cond ((and (= x X)(= y Y))
 44               nil)
 45              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
 46               (cond ((< X x)
 47                      (do ex X (1+ ex)(= ex x)(Rtyo 6)))
 48                     ((< x X)
 49                      (do ex x (1+ ex)(= ex X)(Rtyo 25))))
 50               (cond ((< Y y)
 51                      (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
 52                     ((< y Y)
 53                      (do wy y (1+ wy)(= wy Y)(Rtyo 32))))
 54               (setq X x Y y))
 55 ;; Direct Cursor Addressing is best.
 56              (t (setq X x Y y)
 57                 (Rtyo 33)(Rprinc "Y")(Rtyo (+ 37 y))(Rtyo (+ 37 x))
 58                     )))
 59 
 60 
 61 ;;; Output string.
 62 (defun DCTL-display-char-string (string)
 63        ((lambda (strx)
 64                 (cond ((= strx 0))                ;bug in redisplay calls with no string
 65                       (t (cond (DCTL-insert-mode-on
 66                                  (setq DCTL-insert-mode-on nil)
 67                                  (Rtyo 33) (Rprinc "F")))
 68                          (Rprinc string)
 69                          (setq X (+ X strx)))))
 70         (stringlength string)))
 71 
 72 
 73 ; Clear to end of screen.
 74 (defun DCTL-clear-rest-of-screen ()
 75        (Rtyo 33)(Rprinc "k"))
 76 
 77 
 78 ; Clear to end of line.
 79 (defun DCTL-kill-line ()
 80        (Rtyo 33)(Rprinc "K"))
 81 
 82 (defun DCTL-insert-lines (n)
 83        (do i 1 (1+ i)(> i n)
 84                (Rtyo 33)(Rprinc "M")))
 85 
 86 (defun DCTL-delete-lines (n)
 87        (do i 1 (1+ i)(> i n)
 88                (Rtyo 33)(Rprinc  "l")))
 89 
 90 (defun DCTL-insert-char-string (str)
 91        (cond (DCTL-insert-mode-on)
 92              (t
 93                (setq DCTL-insert-mode-on t)
 94                (Rtyo 33) (Rprinc "F")))
 95        (Rprinc str)
 96        (setq X (+ X (stringlength str))))
 97 
 98 
 99 (defun DCTL-delete-chars (n)
100        (do i 0 (1+ i)(= i n)
101            (Rtyo 33)(Rprinc "E")))