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