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 ;;;       TELERAY 1061 control package
12 ;;;        GMP, 08/14/78 from VT52 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 'teleray1061
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") (DCTL-pad 90.))
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        (do i (stringlength str) (1- i) (= i 0)
70            (Rtyo 33) (Rprinc "P"))
71        (Rprinc str)
72        (setq X (+ X (stringlength str))))
73 
74 
75 ;;; Delete characters from current position in line.
76 (defun DCTL-delete-chars (n)
77        (do i 1 (1+ i) (> i n)
78            (Rtyo 33) (Rprinc "Q")))
79 
80 
81 ;;; Insert n blank lines at current position.
82 (defun DCTL-insert-lines (n)
83        (do i 1 (1+ i) (> i n)
84            (Rtyo 33) (Rprinc "L") (DCTL-pad 60.))
85        (setq X 0))
86 
87 
88 ;;; Delete n lines at current position.
89 (defun DCTL-delete-lines (n)
90        (do i 1 (1+ i) (> i n)
91            (Rtyo 33) (Rprinc "M") (DCTL-pad 60.))
92        (setq X 0))
93 
94 
95 ;;; Send pad characters to wait specified number of milliseconds
96 (defun DCTL-pad (n)
97        (do i (1+ (// (* n ospeed) 1000.)) (1- i) (= i 0)
98            (Rtyo 0)))