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 ;;;       FOX-1100 control package
14 ;;;       GMP on 08/17/78
15 ;;;
16 
17 (declare (special X Y screenheight screenlinelen))
18 (declare (special tty-type))
19 (declare (special idel-lines-availablep idel-chars-availablep))
20 
21 
22 ; Initialize terminal and terminal control package.
23 (defun DCTL-init ()
24        (setq idel-lines-availablep nil
25              idel-chars-availablep nil
26              screenheight 24.
27              screenlinelen 79.
28              tty-type 'fox)
29        (setq X -1 Y -1)
30        (DCTL-position-cursor 0 0)
31        (DCTL-clear-rest-of-screen))
32 
33 
34 ; Move terminal's cursor to desired position.
35 (defun DCTL-position-cursor (x y)
36        (cond ((and (= x X) (= y Y))
37               nil)
38              ((and (= x 0) (= y 0))
39               (Rtyo 33) (Rprinc "H")
40               (setq X 0 Y 0))
41              (t (or (= x X)
42                     (cond ((= x 0)
43                            (Rtyo 15))
44                           ((< (abs (- x X)) 2)
45                            (cond ((< X x)
46                                   (do ex X (1+ ex) (= ex x)
47                                       (Rtyo 33) (Rprinc "C")))
48                                  ((< x X)
49                                   (do ex x (1+ ex) (= ex X) (Rtyo 010)))))
50                           (t (Rtyo 33) (Rprinc "Y") (Rtyo (+ 40 x)))))
51                 (or (= y Y)
52                     (cond ((= y (1+ Y))
53                            (Rtyo 12))
54                           ((< (abs (- y Y)) 2)
55                            (cond ((< Y y)
56                                   (do wy Y (1+ wy) (= wy y)
57                                       (Rtyo 33) (Rprinc "B")))
58                                  ((< y Y)
59                                   (do wy y (1+ wy) (= wy Y)
60                                       (Rtyo 33) (Rprinc "A")))))
61                           (t (Rtyo 33) (Rprinc "X") (Rtyo (+ 40 y)))))
62                 (setq X x Y y))))
63 
64 
65 ; Output string.
66 (defun DCTL-display-char-string (string)
67        (setq X (+ X (stringlength string)))
68        (Rprinc string))
69 
70 
71 ; Clear to end of screen.
72 (defun DCTL-clear-rest-of-screen ()
73        (Rtyo 33) (Rprinc "J"))
74 
75 
76 ; Clear to end of line.
77 (defun DCTL-kill-line ()
78        (Rtyo 33) (Rprinc "I"))
79 
80 
81