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 ;;; -*-LISP-*-
 11 
 12 ;;;
 13 ;;;       HISI VIP7800 control package
 14 ;;;       Ripped off from VIP7200ctl  BSG 6/6/78 (!)
 15 ;;;       Modified 08/21/79 by GMP to optimize use of INSERT mode
 16 ;;;       Modified 1/19/84 by Barmar to use Data-Space-Home instead
 17 ;;;       of CUrsor-Home, so it works with the 72-line option.
 18                                              ;;;
 19 
 20 (declare (special X Y screenheight screenlinelen tty-type))
 21 (declare (special idel-lines-availablep idel-chars-availablep))
 22 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep DCTL-insert-mode-on))
 23 (declare (*expr Rprinc Rtyo))
 24 
 25 
 26 ; Initialize terminal and terminal control package.
 27 (defun DCTL-init ()
 28        (setq idel-lines-availablep t idel-chars-availablep t)
 29        (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
 30        (setq screenheight 24. screenlinelen 79.)
 31        (setq tty-type 'vip7800)
 32        (Rtyo 33)(Rprinc "[H")(Rtyo 33)(Rprinc "J")
 33        (setq X 0 Y 0)
 34        (DCTL-prologue))
 35 
 36 
 37 ;;; Prologue code
 38 (defun DCTL-prologue ()
 39        (setq DCTL-insert-mode-on nil)
 40        (Rtyo 33) (Rprinc "[J"))
 41 
 42 ;;; Epilogue code
 43 (defun DCTL-epilogue ()
 44        (setq DCTL-insert-mode-on nil)
 45        (Rtyo 33) (Rprinc "[J"))
 46 
 47 
 48 ; Move terminal's cursor to desired position.
 49 (defun DCTL-position-cursor (x y)
 50        (cond ((and (= x X)(= y Y))
 51               nil)
 52              ((and (= x 0)(= y 0))
 53               (Rtyo 33)(Rprinc "[H")
 54               (setq X 0 Y 0))
 55              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
 56               (cond ((< X x)
 57                      (do ex X (1+ ex)(= ex x)(Rtyo 33)(Rprinc "C")))
 58                     ((< x X)
 59                      (do ex x (1+ ex)(= ex X)(Rtyo 33)(Rprinc "D"))))
 60               (cond ((< Y y)
 61                      (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rprinc "B")))
 62                     ((< y Y)
 63                      (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "A"))))
 64               (setq X x Y y))
 65 ;; Direct Cursor Addressing is best.
 66              (t (setq X x Y y)
 67                 (Rtyo 33)(Rprinc "f")(Rtyo (+ 40 x))(Rtyo (+ 40 y))
 68                     )))
 69 
 70 
 71 ;;; Output string.
 72 (defun DCTL-display-char-string (string)
 73        ((lambda (strx)
 74                 (cond ((= strx 0))                ;bug in redisplay calls with no string
 75                       (t (cond (DCTL-insert-mode-on
 76                                  (setq DCTL-insert-mode-on nil)
 77                                  (Rtyo 33) (Rprinc "[J")))
 78                          (Rprinc string)
 79                          (setq X (+ X strx)))))
 80         (stringlength string)))
 81 
 82 
 83 ; Clear to end of screen.
 84 (defun DCTL-clear-rest-of-screen ()
 85        (Rtyo 33)(Rprinc "J")
 86        (Rtyo 0))  ;needed only at 9.6kb
 87 
 88 
 89 ; Clear to end of line.
 90 (defun DCTL-kill-line ()
 91        (Rtyo 33)(Rprinc "K"))
 92 
 93 
 94 (defun DCTL-insert-lines (n)
 95        (do i 1 (1+ i)(> i n)
 96                (Rtyo 33)(Rprinc "[L")))
 97 
 98 (defun DCTL-delete-lines (n)
 99        (do i 1 (1+ i)(> i n)
100                (Rtyo 33)(Rprinc  "[M")))
101 
102 (defun DCTL-insert-char-string (str)
103        (cond (DCTL-insert-mode-on)
104              (t
105                (setq DCTL-insert-mode-on t)
106                (Rtyo 33) (Rprinc "[I")))
107        (Rprinc str)
108        (setq X (+ X (stringlength str))))
109 
110 
111 (defun DCTL-delete-chars (n)
112        (do i 0 (1+ i)(= i n)
113            (Rtyo 33)(Rprinc "[P")))
114