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 VIP7200 control package
14 ;;;       Ripped off from vt52ctl BSG 3/9/78
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 'vip7200)
26        (Rtyo 33)(Rprinc "H")(Rtyo 33)(Rprinc "J")
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 33)(Rprinc "H")
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 33)(Rprinc "C")))
40                     ((< x X)
41                      (do ex x (1+ ex)(= ex X)(Rtyo 33)(Rprinc "D"))))
42               (cond ((< Y y)
43                      (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rprinc "B")))
44                     ((< y Y)
45                      (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "A"))))
46               (setq X x Y y))
47 ;; Direct Cursor Addressing is best.
48              (t (setq X x Y y)
49                 (Rtyo 33)(Rprinc "f")(Rtyo (+ 40 x))(Rtyo (+ 40 y))
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 "J")
62        (Rtyo 0))  ;needed only at 9.6kb
63 
64 
65 ; Clear to end of line.
66 (defun DCTL-kill-line ()
67        (Rtyo 33)(Rprinc "K"))
68 
69 
70