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 ;;;       Soroc IQ120 control package
14 ;;;       Ripped off from vt52ctl Paul Schauble 3/24/79
15 ;;;
16 
17 (declare (special X Y screenheight screenlinelen tty-type))
18 (declare (special idel-lines-availablep idel-chars-availablep))
19 
20 
21 ; Initialize terminal and terminal control package.
22 (defun DCTL-init ()
23        (setq idel-lines-availablep nil idel-chars-availablep nil)
24        (setq screenheight 24. screenlinelen 79.)
25        (setq tty-type 'iq120)
26        (Rtyo 33) (Rprinc "*")
27        (setq X 0 Y 0))
28 
29 
30 ; Move terminal's cursor to desired position.
31 (defun DCTL-position-cursor (x y)
32        (cond ((and (= x X)(= y Y))
33               nil)
34              ((and (= x 0)(= y 0))
35               (Rtyo 36)
36               (setq X 0 Y 0))
37              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
38               (cond ((< X x)
39                      (do ex X (1+ ex)(= ex x)(Rtyo 14)))
40                     ((< x X)
41                      (do ex x (1+ ex)(= ex X)(Rtyo 10))))
42               (cond ((< Y y)
43                      (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
44                     ((< y Y)
45                      (do wy y (1+ wy)(= wy Y)(Rtyo 13))))
46               (setq X x Y y))
47 ;; Direct Cursor Addressing is best.
48              (t (setq X x Y y)
49                 (Rtyo 33) (Rprinc "=")(Rtyo (+ 40 y))(Rtyo (+ 40 x))
50                     )))
51 
52 
53 ; Output string.
54 (defun DCTL-display-char-string (string)
55        (setq X (+ X (stringlength string)))
56        (Rprinc string))
57 
58 
59 ; Clear to end of screen.
60 (defun DCTL-clear-rest-of-screen ()
61        (Rtyo 33)(Rprinc "Y"))
62 
63 
64 ; Clear to end of line.
65 (defun DCTL-kill-line ()
66        (Rtyo 33)(Rprinc "T"))
67 
68 
69