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 ;;;       ADDS980 Kludgorama --- BSG 2/12/79... from...
14 ;;;       HISI VIP7800 control package
15 ;;;       Ripped off from VIP7200ctl  BSG 6/6/78 (!)
16 ;;;
17 
18 (declare (special X Y screenheight screenlinelen tty-type))
19 (declare (array* (notype (screen ?))))
20 (declare (special idel-lines-availablep idel-chars-availablep))
21 
22 
23 ; Initialize terminal and terminal control package.
24 (defun DCTL-init ()
25        (setq idel-lines-availablep t idel-chars-availablep nil)
26        (setq screenheight 24. screenlinelen 79.)
27        (setq tty-type 'adds980)
28        (Rtyo 14)
29        (setq X 0 Y 0))
30 
31 
32 ; Move terminal's cursor to desired position.
33 (defun DCTL-position-cursor (x y)
34        (cond ((and (= x X)(= y Y))
35               nil)
36              ((=  x 0)
37               (Rtyo 13)(Rtyo (+ 100 y))
38               (setq X x Y y))
39              ((not (= y Y))
40               (DCTL-position-cursor 0 y)
41               (DCTL-position-cursor x y))
42              ((> x X)
43               (Rtyo 33)(Rtyo 5)
44               (Rtyo (+ 60 (// (- x X) 10.)))
45               (Rtyo (+ 60 (\ (- x X) 10.)))
46               (setq X x))
47              ((< (- X x) 6)
48               (do i (- X x)(1- i)(= i 0)(Rtyo 10)(setq X (1- X))))
49              (t (DCTL-position-cursor 0 Y)
50                 (DCTL-position-cursor x y))))
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 ()               ;Dont have eos, do all.
61        (Rtyo 14)(setq X 0 Y 0))
62 
63 ; Clear to end of line.
64 (defun DCTL-kill-line1 ()
65        (do X1 X (1+ X1)(not (< X1 (cond ((screen Y)(cddr (screen Y)))
66                                         (t 0))))
67            (Rtyo 40)(setq X (1+ X))))
68 
69 (defun DCTL-kill-line ()
70        ((lambda (ox oy)
71                 (cond ((= Y (1- screenheight))
72                        (DCTL-kill-line1))
73                       ((and (screen Y)(< (- (cddr (screen Y)) X) 7))
74                        (DCTL-kill-line1))
75                       (t (Rtyo 15)
76                          (setq X 0 Y (1+ Y))))
77                 (DCTL-position-cursor ox oy))
78         X Y))
79 
80 (defun DCTL-insert-lines (n)
81        (do i 1 (1+ i)(> i n)
82                (Rtyo 33)(Rtyo 16)))
83 
84 (defun DCTL-delete-lines (n)
85        (do i 1 (1+ i)(> i n)
86                (Rtyo 33)(Rtyo 17)))