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 ;;;       DATAMEDIA 1521 control package
12 ;;;       Adapted from vip7200ctl by Richard Q. Kahler 7/10/79
13 ;;;
14 
15 (declare (special X Y screenheight screenlinelen tty-type))
16 (declare (special idel-lines-availablep idel-chars-availablep))
17 
18 
19 ; Initialize terminal and terminal control package.
20 (defun DCTL-init ()
21        (setq idel-lines-availablep nil idel-chars-availablep nil)
22        (setq screenheight 24. screenlinelen 79.)
23        (setq tty-type 'dm1521)
24        (Rtyo 14)                                  ;clear screen
25        (setq X 0 Y 0))
26 
27 
28 ; Move terminal's cursor to desired position.
29 (defun DCTL-position-cursor (x y)
30        (cond ((and (= x X)(= y Y))
31               nil)                                ;already there
32              ((and (= x 0)(= y 0))
33               (Rtyo 31)                           ;cursor home
34               (setq X 0 Y 0))
35              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
36               (cond ((< X x)
37                      (do ex X (1+ ex)(= ex x)(Rtyo 34)))    ;cursor right
38                     ((< x X)
39                      (do ex x (1+ ex)(= ex X)(Rtyo 10))))   ;cursor left
40               (cond ((< Y y)
41                      (do wy Y (1+ wy)(= wy y)(Rtyo 12)))    ;cursor down
42                     ((< y Y)
43                      (do wy y (1+ wy)(= wy Y)(Rtyo 37))))   ;cursor up
44               (setq X x Y y))
45 ;; Direct Cursor Addressing is best.
46              (t (setq X x Y y)
47                 (Rtyo 36)(Rtyo (+ 40 x))(Rtyo y)
48                     )))
49 
50 
51 ; Output string.
52 (defun DCTL-display-char-string (string)
53        (setq X (+ X (stringlength string)))
54        (Rprinc string))
55 
56 
57 ; Clear to end of screen.
58 (defun DCTL-clear-rest-of-screen ()
59        (Rtyo 13))
60 
61 
62 ; Clear to end of line.
63 (defun DCTL-kill-line ()
64        (Rtyo 35))