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 ;;;
12 ;;;       ADM3 control package
13 ;;;       Created by Bob Frankston with Bernie's help
14 ;;;       10 Mar 1979
15 ;;;       BSG - Flushed DCTL-kill-line for tty-no-cleolp 2/14/80
16 ;;;
17 
18 (declare (special X Y screenheight tty-type))
19 (declare (special screenlinelen))
20 (declare (special idel-chars-availablep idel-lines-availablep tty-no-cleolp))
21 
22 ; Initialize terminal and terminal control package.
23 (defun DCTL-init ()
24        (setq screenheight 24.)              ; 20 lines for editing
25        (setq screenlinelen 79.)
26        (setq tty-type 'adm3)
27        (setq idel-lines-availablep nil idel-chars-availablep nil tty-no-cleolp t)
28        (Rtyo 32)                            ; clear screen
29        (setq X 0 Y 0))
30 
31 
32 ; Move terminal's cursor to desired position.
33 (defun DCTL-position-cursor (x y)
34        (prog (ycost                             ; cost of y and x relative
35               xcost                             ; movement
36               what                              ; which movement is best
37               cost)                             ; cost of that movement
38              (and (= x X)(= y Y)                ; return right away if already
39                   (return nil))                 ; at desired position
40              (setq what 1                       ; 1: "home and relative move"
41                    cost (+ 1 y x))              ; cost is V + H + 1
42              (and (> cost 4)                    ; direct cursor address better?
43                   (setq what 0                  ; 0: "direct cursor address"
44                         cost 4))                ; cost is 4 characters
45              (setq ycost (abs (- y Y)))
46              (setq xcost (abs (- x X)))
47              (and (< (+ ycost xcost) cost)
48                   (setq what 3                  ; 3: "relative move"
49                         cost (+ ycost xcost)))
50              (and (< (+ 1 ycost x) cost)
51                   (setq what 2))                ; 2: "CR and relative move"
52              (cond ((= what 0)
53 
54 ; Direct Cursor Address
55 
56                     (Rtyo 33)
57                     (Rprinc "=")
58                     (Rtyo (+ 40 y))
59                     (Rtyo (+ 40 x))
60                     (setq X x Y y)
61                     (return nil))
62 
63                    ((= what 1)                  ; home and relative move?
64                     (Rtyo 36)                   ; home
65                     (setq X 0 Y 0))             ; keep track of cursor
66                                                 ; fall through to relative move
67 
68                    ((= what 2)                  ; CR and relative move?
69                     (Rtyo 15)                   ; CR
70                     (setq X 0)))                ; keep track of cursor
71                                                 ; fall through to relative move
72 
73 ; Relative Move
74 
75              (cond ((< X x)
76                     (do ex X (1+ ex)(= ex x)(Rtyo 14)))
77                    ((< x X)
78                     (do ex x (1+ ex)(= ex X)(Rtyo 10))))
79              (cond ((< Y y)
80                     (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
81                    ((< y Y)
82                     (do wy y (1+ wy)(= wy Y)(Rtyo 13))))
83              (setq X x Y y)
84              (return nil)))
85 
86 
87 ; Output string.
88 (defun DCTL-display-char-string (string)
89        (setq X (+ X (stringlength string)))
90        (Rprinc string))
91 
92 
93 ; Clear to end of screen.
94 (defun DCTL-clear-rest-of-screen ()
95     (Rtyo 32)(setq X 0 Y 0))
96 
97 ; Clear to end of screen.
98 (defun DCTL-clear-rest-of-screen ()               ;Dont have eos, do all.
99        (Rtyo 32)(setq X 0 Y 0))