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 ;;; -*-LISP-*-
 12 
 13 ;;;
 14 ;;;        Concept 100 control package
 15 ;;;        DLW 3/12/79
 16 
 17 
 18 ;;; HISTORY COMMENTS:
 19 ;;;  1) change(86-04-23,Margolin), approve(86-04-23,MCR7325),
 20 ;;;     audit(86-08-12,Harvey), install(86-08-20,MR12.0-1136):
 21 ;;;     Added *expr declarations so that it would compile without warnings.
 22 ;;;                                                      END HISTORY COMMENTS
 23 
 24 ;;;
 25 
 26 
 27 (%include e-macros)
 28 
 29 (eval-when (compile) (setq ibase (+ 8 2)))
 30 
 31 (declare (special
 32           X Y screenheight screenlinelen ospeed tty-type
 33           idel-lines-availablep
 34           idel-chars-availablep
 35           overstrike-availablep
 36           region-scroll-availablep
 37           c100-magic-constant           ; Fudge factor for Concept 100 padding
 38           vmax
 39           ))
 40 
 41 (declare (*expr Rprinc Rtyo))
 42 
 43 ;;; Initialize terminal and terminal control package.
 44 (defun DCTL-init ()
 45        (setq screenheight 24 screenlinelen 79)
 46        (setq idel-lines-availablep t idel-chars-availablep nil)
 47        (setq region-scroll-availablep t)
 48        (setq tty-type 'c100)
 49        (setq overstrike-availablep t)             ; Underscore!
 50        (setq c100-magic-constant
 51              (//$ 1.0
 52                   (-$ 1.0
 53                       (+$ .45 (*$ .3 (//$ (float ospeed) 960.0))))
 54                   1000.0))
 55 
 56        (Rtyo 27) (Rprinc "U")                     ; Set programmer mode.
 57        (Rtyo 27) (Rprinc "f")                     ; Set text mode.
 58        (Rtyo 27) (Rprinc "7")                     ; Set character mode.
 59        (Rtyo 27) (Rprinc "5")                     ; Set upper/lower case mode.
 60        (Rtyo 27) (Rprinc "8")                     ; Set full duplex.
 61        (Rtyo 27) (Rprinc "l")                     ; Reset auto-linefeed.
 62        (Rtyo 27) (Rprinc "N")                     ; Send set attribute word command.
 63        (Rtyo 72)                                  ; Word is all 0 except protect = 1
 64                                                   ;     (no protection)
 65        (Rtyo 27) (Rprinc "o")                     ; Change EOM to null.
 66        (Rtyo 38) (Rtyo 0)                         ; ...
 67 ;      (Rtyo 27) (Rprinc "$")                     ; Reset all function keys.
 68        ;; Here program the function keys, if we ever want to use them.
 69 
 70        (DCTL-define-full-width-window 0 23)
 71        (DCTL-clear-screen)                        ; Clear and home.
 72        ;; Here we could set the tab stops but there is probably no reason.
 73        )
 74 
 75 ;;; Move terminal's cursor to desired position.
 76 ;;; This first implementation is really cheapo and only uses
 77 ;;;   absolute cursor positioning.
 78 (defun DCTL-position-cursor (x y)
 79        (cond ((and (= x X) (= y Y))
 80               nil)
 81              ((and (= x 0) (= y 0))
 82               ;; Home up.
 83               (Rtyo 27) (Rprinc "?"))
 84              ((= (+ (abs (- x X))
 85                     (abs (- y Y)))
 86                  1)
 87               ;; We are only one away, use relative positioning.
 88               (cond ((= x X)
 89                      (cond ((< y Y)  (Rtyo 27) (Rprinc ";"))
 90                            (t        (Rtyo 27) (Rprinc "<"))))
 91                     (t
 92                      (cond ((< x X)  (Rtyo 27) (Rprinc ">"))
 93                            (t        (Rtyo 27) (Rprinc "="))))))
 94              (t
 95               ;; Use absolute positioning.
 96               (Rtyo 27) (Rprinc "a")
 97               (Rtyo (+ 32 y)) (Rtyo (+ 32 x))))
 98        (setq X x Y y)
 99        nil)
100 
101 ;;; Output a string.
102 (defun DCTL-display-char-string (string)
103        (setq X (+ X (stringlength string)))
104        (Rprinc string))
105 
106 ;;; Home up and clear screen.
107 (defun DCTL-clear-screen ()
108        (Rtyo 12)
109        (DCTL-c100-pad 12.0)
110        (setq Y 0 X 0))
111 
112 ;;; Clear to end of screen.
113 (defun DCTL-clear-rest-of-screen ()
114        (if (and (= Y 0) (= X 0))
115            (DCTL-clear-screen)
116         else
117            (Rtyo 27) (Rtyo 5)
118            (DCTL-c100-pad (*$ 4.0 (float (- 24 Y))))))
119 
120 ;;; Clear to end of line.
121 (defun DCTL-kill-line ()
122        (Rtyo 27) (Rtyo 21)
123        (DCTL-c100-pad 4.0))
124 
125 ;;; Insert lines.
126 (defun DCTL-insert-lines (n)
127        (do-times n
128          (Rtyo 27) (Rtyo 18)
129          (DCTL-c100-pad (*$ .75 (float (- vmax X))))))
130 
131 ;;; Delete lines.
132 (defun DCTL-delete-lines (n)
133        (do-times n
134          (Rtyo 27) (Rtyo 2)
135          (DCTL-c100-pad (*$ .75 (float (- vmax X))))))
136 
137 (defun DCTL-define-full-width-window (top bottom)
138        (Rtyo 27)
139        (Rprinc "v")
140        (Rtyo (+ top 32))
141        (Rtyo 32)
142        (Rtyo (+ (- bottom top) 32 1))
143        (Rtyo (+ 80 32))
144        (setq Y top
145              X 0
146              vmax bottom))
147 
148 ;;; Move text in scroll region up n lines (inserts whitespace at bottom)
149 (defun DCTL-scroll-up-region (nlines bottom)
150        (DCTL-define-full-width-window Y bottom)
151        (DCTL-delete-lines nlines)
152        (DCTL-define-full-width-window 0 23))
153 
154 ;;; Move text in scroll region down n lines (inserts whitespace at top)
155 (defun DCTL-scroll-down-region (nlines bottom)
156        (DCTL-define-full-width-window Y bottom)
157        (DCTL-insert-lines nlines)
158        (DCTL-define-full-width-window 0 23))
159 
160 ;;; This takes a number of milliseconds, adjusts it by the
161 ;;; magic constant, and sends the right number of pad characters.
162 (defun DCTL-c100-pad (a)
163        (do-times (fix (*$ a c100-magic-constant (float ospeed)))
164          (Rtyo 127)))