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 ;;;       CDC713 control package
12 ;;;       JJL, with help from BSG 08/12/79 from VISTAR
13 ;;;
14 
15 (declare (special X Y screenheight screenlinelen))
16 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
17 
18 (declare (eval (read)))(setsyntax '/^ 'macro 'hatmac)
19 (declare (eval (read)))(defun hatmac ()(- (tyi) 100))
20 ; Initialize terminal and terminal control package.
21 (defun DCTL-init ()
22        (setq idel-lines-availablep nil idel-chars-availablep nil)
23        (setq screenheight 16. screenlinelen 79.)
24        (setq tty-type 'cdc713)
25        (setq X 0 Y 0)
26        (Rtyo ^Y)(Rtyo ^X))
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              ((and (= x 0)(= y 0))(Rtyo ^Y))
33              ((and (= x 0)(= y Y))(Rtyo ^M))
34              (t
35                (cond ((and (< x X)(> (- X x) x))
36                       (cond ((and (< y Y)(> (- Y y) y))
37                              (DCTL-position-cursor 0 0))
38                             (t (DCTL-position-cursor 0 Y)))))
39                (cond ((< X x)
40                       (do ex X (1+ ex)(= ex x)(Rtyo ^U)))
41                      ((< x X)
42                       (do ex x (1+ ex)(= ex X)(Rtyo ^H))))
43                (cond ((< Y y)
44                       (do wy Y (1+ wy)(= wy y)(Rtyo ^J)))
45                      ((< y Y)
46                       (do wy y (1+ wy)(= wy Y)(Rtyo ^Z))))))
47        (setq X x Y y))
48 
49 ; Output string.
50 (defun DCTL-display-char-string (string)
51        (setq X (+ X (stringlength string)))
52        (Rprinc string))
53 
54 
55 ; Clear to end of screen.
56 (defun DCTL-clear-rest-of-screen () (Rtyo ^X))
57 
58 
59 ; Clear to end of line.
60 (defun DCTL-kill-line () (Rtyo ^V))