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 ;;;       Iriscope 200 control package
11 ;;;       Ripped off from vt52ctl BSG 3/9/78
12 ;;;       Ripped off from VIP7200ctl by CAH 17 July 1980
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 16. screenlinelen 80.)
23        (setq tty-type 'iriscope200)
24        (Rtyo 30) (Rtyo 31)
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                                ; near home position?
31                 (< (DCTL-distance y 0 16.) (DCTL-distance Y y 16.))
32                 (<
33                   (+ (DCTL-distance x 0 80.) (DCTL-distance y 0 16.))
34                   (+ (DCTL-distance X x 80.) (DCTL-distance Y y 16.))))
35               (Rtyo 31)                           ; yes: go there first
36               (setq X 0 Y 0)))
37        (cond ((< (DCTL-distance x 0 80.) (DCTL-distance X x 80.))
38               (Rtyo 15)                           ; yes: go there
39               (setq X 0)))
40        (cond ((< X x)
41               (cond ((< (- x X) 40.) (DCTL-rpt 25 (- x X)))
42                     (t (setq Y (1- Y)) (DCTL-rpt 10 (+ 80. (- X x))))))
43              (t
44                (cond ((< (- X x) 40.) (DCTL-rpt 10 (- X x)))
45                      (t (setq Y (1+ Y)) (DCTL-rpt 25 (+ 80. (- x X)))))))
46        (cond ((< Y y)
47               (cond ((< (- y Y) 8.) (DCTL-rpt 12 (- y Y)))
48                     (t (DCTL-rpt 32 (+ 16. (- Y y))))))
49              (t
50                (cond ((< (- Y y) 8.) (DCTL-rpt 32 (- Y y)))
51                      (t (DCTL-rpt 12 (+ 16. (- y Y)))))))
52        (setq X x Y y))
53 
54 
55 ; find modular distance between two points
56 (defun DCTL-distance (A B Mod)
57        (cond ((< (abs (- A B)) (// Mod 2)) (abs (- A B)))
58              ((< A B) (- (+ Mod A) B))
59              ((> A B) (- (+ Mod B) A))))
60 
61 
62 ; send a cursor positioning string
63 (defun DCTL-rpt (Char Num)
64  (do ex 1 (1+ ex) (> ex Num) (Rtyo Char)))
65 
66 
67 ; Output string.
68 (defun DCTL-display-char-string (string)
69        (setq X (+ X (stringlength string)))
70        (Rprinc string)
71        (cond ((< X 80.) nil)
72              (t (setq X (- X 80.)) (setq Y (1+ Y)))))
73 
74 
75 ; Clear to end of screen.
76 (defun DCTL-clear-rest-of-screen ()
77        ((lambda (x y)
78                 (Rtyo 30)
79                 (setq X 0 Y 0)
80                 (DCTL-position-cursor x y))
81         X Y))
82 
83 
84 ; Clear to end of line.
85 (defun DCTL-kill-line ()
86        (Rtyo 26))
87