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 ;;;       DATAMEDIA 3000 control package
 12 ;;;        WOS, 11/08/78 from TELERAY1061 package
 13 ;;;
 14 
 15 (declare (special X Y screenheight screenlinelen ospeed))
 16 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
 17 
 18 
 19 ;;; Initialize terminal and terminal control package.
 20 (defun DCTL-init ()
 21        (setq idel-lines-availablep t idel-chars-availablep t
 22              screenheight 24. screenlinelen 79.
 23              tty-type 'dm3000
 24              X -777 Y -777)
 25        (DCTL-position-cursor 0 0)
 26        (DCTL-clear-rest-of-screen))
 27 
 28 
 29 ;;; Move terminal's cursor to desired position.
 30 (defun DCTL-position-cursor (x y)
 31        (cond ((and (= x X) (= y Y))
 32               nil)
 33              ((and (= x 0) (= y 0))
 34               (Rtyo 33) (Rprinc "H")
 35               (setq X 0 Y 0))
 36              ((and (< (+ (abs (- X x)) (abs (- Y y))) 4))
 37               (cond ((< X x)
 38                      (do ex X (1+ ex) (= ex x) (Rtyo 33) (Rprinc "C")))
 39                     ((< x X)
 40                      (do ex x (1+ ex) (= ex X) (Rtyo 010))))
 41               (cond ((< Y y)
 42                      (do wy Y (1+ wy) (= wy y) (Rtyo 33) (Rprinc "B")))
 43                     ((< y Y)
 44                      (do wy y (1+ wy) (= wy Y) (Rtyo 33) (Rprinc "A"))))
 45               (setq X x Y y))
 46              ;; Direct Cursor Addressing is best.
 47              (t (setq X x Y y)
 48                 (Rtyo 33) (Rprinc "Y") (Rtyo (+ 40 y)) (Rtyo (+ 40 x)))))
 49 
 50 
 51 ;;; Output string.
 52 (defun DCTL-display-char-string (string)
 53        (setq X (+ X (stringlength string)))
 54        (Rprinc string))
 55 
 56 
 57 ;;; Clear to end of screen.
 58 (defun DCTL-clear-rest-of-screen ()
 59        (Rtyo 33) (Rprinc "J"))
 60 
 61 
 62 ;;; Clear to end of line.
 63 (defun DCTL-kill-line ()
 64        (Rtyo 33) (Rprinc "K"))
 65 
 66 
 67 ;;; Insert character string in line at current position.
 68 (defun DCTL-insert-char-string (str)
 69        (Rtyo 33) (Rprinc "P")
 70        (Rprinc str)
 71        (Rtyo 33) (Rprinc "Q")
 72        (setq X (+ X (stringlength str))))
 73 
 74 
 75 ;;; Delete characters from current position in line.
 76 (defun DCTL-delete-chars (n)
 77        (Rtyo 33) (Rprinc "P")
 78        (do i 1 (1+ i) (> i n)
 79            (Rtyo 33) (Rprinc "D"))
 80        (Rtyo 33) (Rprinc "Q"))
 81 
 82 
 83 ;;; Insert n blank lines at current position.
 84 (defun DCTL-insert-lines (n)
 85        (Rtyo 33) (Rprinc "P")
 86        (do i 1 (1+ i) (> i n)
 87            (Rtyo 33) (Rprinc "B") (DCTL-pad 130.))
 88        (Rtyo 33) (Rprinc "Q")
 89        (setq X 0))
 90 
 91 
 92 ;;; Delete n lines at current position.
 93 (defun DCTL-delete-lines (n)
 94        (Rtyo 33) (Rprinc "P")
 95        (do i 1 (1+ i) (> i n)
 96            (Rtyo 33) (Rprinc "A") (DCTL-pad 130.))
 97        (Rtyo 33) (Rprinc "Q")
 98        (setq X 0))
 99 
100 
101 ;;; Send pad characters to wait specified number of milliseconds
102 (defun DCTL-pad (n)
103        (do i (1+ (// (* n ospeed) 1000.)) (1- i) (= i 0)
104            (Rtyo 177)))