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 ;;;       TEK4023 pseudokludge
12 ;;;
13 ;;;       BSG 3/21/78 from DD4000ctl
14 ;;;       BSG 2/14/80 for tty-no-cleolp :. no more kludge.
15 ;;;
16 
17 (declare (special X Y screenheight screenlinelen))
18 (declare (special idel-lines-availablep idel-chars-availablep tty-type tty-no-cleolp))
19 
20 
21 ; Initialize terminal and terminal control package.
22 (defun DCTL-init ()
23        (setq idel-lines-availablep nil idel-chars-availablep nil tty-no-cleolp t)
24        (setq screenheight 24. screenlinelen 79.)
25        (setq tty-type 'tek4023)
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 28.)(Rtyo 32.)(Rtyo 32.)
35               (setq X 0 Y 0))
36               (t (Rtyo 28.)(Rtyo (+ 40 x))(Rtyo (+ 40 y))
37                 (setq X x Y y))))
38 
39 
40 ; Output string.
41 (defun DCTL-display-char-string (string)
42        (setq X (+ X (stringlength string)))
43        (Rprinc string))
44 
45 
46 ; Clear to end of screen.
47 (defun DCTL-clear-rest-of-screen ()               ;cheat- no eos, just home
48        (Rtyo 33)(Rtyo 14)(mapc 'Rtyo '(0 0 0 0))
49        (setq X 0 Y 0))
50 
51