1 ;;; ***********************************************************
  2 ;;; *                                                         *
  3 ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4 ;;; *                                                         *
  5 ;;; * Copyright (c) 1981 by Massachusetts Institute of        *
  6 ;;; * Technology and Honeywell Information Systems, Inc.      *
  7 ;;; *                                                         *
  8 ;;; ***********************************************************
  9 ;;;
 10 ;;;
 11 ;;;       OWL 1200 control pachage
 12 ;;;       Richard Lamson, 05/13/81 from TELERAY 1061 control package
 13 ;;;                                     GMP, 08/14/78 from VT52 package
 14 ;;;
 15 
 16 (eval-when (compile eval) (setsyntax '/# 'macro 'sharp-macro)
 17 
 18 (defun sharp-macro ()
 19        (let ((ch (tyi)))
 20             (or (= ch 57)                         ; #/ is the only # macro here
 21                 (error "Unknown # character: " (ItoC ch) 'fail-act))
 22             (tyi)))                               ; return character number
 23 
 24 )
 25 
 26 (declare (special X Y screenheight screenlinelen ospeed %DCTL-escape-char))
 27 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
 28 
 29 
 30 ;;; Initialize terminal and terminal control package.
 31 (defun DCTL-init ()
 32        (setq idel-lines-availablep t idel-chars-availablep t
 33              screenheight 24. screenlinelen 79.
 34              tty-type 'teleray1061
 35              X -777 Y -777
 36              %DCTL-escape-char 33)
 37        (DCTL-position-cursor 0 0)
 38        (DCTL-clear-rest-of-screen))
 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 (= x 0) (= y 0))
 46               (Rtyo %DCTL-escape-char) (Rtyo #/H)
 47               (setq X 0 Y 0))
 48              (t                                   ; must actually set X and Y
 49                  (cond ((= x (1- X)) (Rtyo 10))
 50                        ((= (1+ x) (1- X)) (Rtyo 10) (Rtyo 10))
 51                        ((= X (1- x)) (Rtyo %DCTL-escape-char) (Rtyo #/C))
 52                        (t (Rtyo %DCTL-escape-char) (Rtyo #/Y) (Rtyo y)))
 53                  (cond ((= y (1- Y)) (Rtyo %DCTL-escape-char) (Rtyo #/A))
 54                        ((= Y (1- y)) (Rtyo %DCTL-escape-char) (Rtyo #/B))
 55                        (t (Rtyo %DCTL-escape-char) (Rtyo #/X) (Rtyo y)))
 56                  (setq X x Y x))))
 57 
 58 
 59 ;;; Output string.
 60 (defun DCTL-display-char-string (string)
 61        (setq X (+ X (stringlength string)))
 62        (Rprinc string))
 63 
 64 
 65 ;;; Clear to end of screen.
 66 (defun DCTL-clear-rest-of-screen ()
 67        (Rtyo %DCTL-escape-char) (Rtyo #/J) (DCTL-pad 132.))
 68 
 69 
 70 ;;; Clear to end of line.
 71 (defun DCTL-kill-line ()
 72        (Rtyo %DCTL-escape-char) (Rtyo #/K) (DCTL-pad 6.))
 73 
 74 
 75 ;;; Insert character string in line at current position.
 76 (defun DCTL-insert-char-string (str)
 77        (let ((stringlength (stringlength str)))
 78             (cond ((= 0 stringlength))
 79                   (t
 80                       (do i 1 (1+ i) (= i stringlength)
 81                           (Rtyo %DCTL-escape-char) (Rtyo #/N) (Rprinc (substr str i 1)))
 82                       (setq X (+ X stringlength))))))
 83 
 84 
 85 ;;; Delete characters from current position in line.
 86 (defun DCTL-delete-chars (n)
 87        (do i 1 (1+ i) (> i n)
 88            (Rtyo %DCTL-escape-char) (Rtyo #/O)))
 89 
 90 
 91 ;;; Insert n blank lines at current position.
 92 (defun DCTL-insert-lines (n)
 93        (do i 1 (1+ i) (> i n)
 94            (Rtyo %DCTL-escape-char) (Rtyo #/L))
 95        (DCTL-pad (* 6. n))
 96        (setq X 0))
 97 
 98 
 99 ;;; Delete n lines at current position.
100 (defun DCTL-delete-lines (n)
101        (do i 1 (1+ i) (> i n)
102            (Rtyo %DCTL-escape-char) (Rtyo #/M))
103        (DCTL-pad (* 6. n))
104        (setq X 0))
105 
106 
107 ;;; Send pad characters to wait specified number of milliseconds
108 (defun DCTL-pad (n)
109        (do i (1+ (// (* n ospeed) 1000.)) (1- i) (= i 0)
110            (Rtyo 0)))