1 ;;; ***********************************************************
  2 ;;; *                                                         *
  3 ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4 ;;; *                                                         *
  5 ;;; ***********************************************************
  6 ;;;--------------------------------------------------------------------
  7 ;;;
  8 ;;;       This is the source to the VISUAL-200 terminal controller.
  9 ;;;       The suggested name for it is vis200.ctl.lisp.  Do what you
 10 ;;;       wish with it.
 11 ;;;
 12 ;;;--------------------------------------------------------------------
 13 ;;;
 14 ;;;       Visual 200 control package
 15 ;;;       14 July 1982
 16 ;;;       Ripped off from various places by David M. Warme (Warme.FSOEP)
 17 ;;;
 18 
 19 (declare (special X Y screenheight tty-type ospeed))
 20 (declare (special screenlinelen))
 21 (declare (special idel-chars-availablep idel-lines-availablep tty-no-cleolp))
 22 
 23 ; Initialize terminal and terminal control package.
 24 (defun DCTL-init ()
 25        (setq screenheight 24.)              ; 20 lines for editing
 26        (setq screenlinelen 79.)
 27        (setq tty-type 'vis200)
 28        (setq idel-lines-availablep t idel-chars-availablep t tty-no-cleolp nil)
 29        (Rtyo 27.) (Rprinc "v")                    ; clear screen
 30        (setq X 0 Y 0))
 31 
 32 
 33 ; Move terminal's cursor to desired position.
 34 (defun DCTL-position-cursor (x y)
 35        (prog (ycost                             ; cost of y and x relative
 36               xcost                             ; movement
 37               what                              ; which movement is best
 38               cost)                             ; cost of that movement
 39              (and (= x X)(= y Y)                ; return right away if already
 40                   (return nil))                 ; at desired position
 41              (setq what 1                       ; 1: "home and relative move"
 42                    cost (+ 2 y x x))            ; cost is V + 2*H + 2
 43              (and (> cost 4)                    ; direct cursor address better?
 44                   (setq what 0                  ; 0: "direct cursor address"
 45                         cost 4))                ; cost is 4 characters
 46              (setq ycost (cond ((< y Y) (- Y y))
 47                                (t (lsh (- y Y) 1))))
 48              (setq xcost (cond ((> x X) (- x X))
 49                                (t (lsh (- X x) 1))))
 50              (and (< (+ ycost xcost) cost)
 51                   (setq what 3                  ; 3: "relative move"
 52                         cost (+ ycost xcost)))
 53              (and (< (+ 1 ycost x) cost)
 54                   (setq what 2))                ; 2: "CR and relative move"
 55              (cond ((= what 0)
 56 
 57 ; Direct Cursor Address
 58 
 59                     (Rtyo 27.)
 60                     (Rprinc "Y")
 61                     (Rtyo (+ 40 y))
 62                     (Rtyo (+ 40 x))
 63                     (setq X x Y y)
 64                     (return nil))
 65 
 66                    ((= what 1)                  ; home and relative move?
 67                     (Rtyo 27.) (Rprinc "H")     ; home
 68                     (setq X 0 Y 0))             ; keep track of cursor
 69                                                 ; fall through to relative move
 70 
 71                    ((= what 2)                  ; CR and relative move?
 72                     (Rtyo 15)                   ; CR
 73                     (setq X 0)))                ; keep track of cursor
 74                                                 ; fall through to relative move
 75 
 76 ; Relative Move
 77 
 78              (cond ((< X x)
 79                     (do ex X (1+ ex)(= ex x)(Rtyo 27.)(Rprinc "C")))
 80                    ((< x X)
 81                     (do ex x (1+ ex)(= ex X)(Rtyo 10))))
 82              (cond ((< Y y)
 83                     (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
 84                    ((< y Y)
 85                     (do wy y (1+ wy)(= wy Y)(Rtyo 27.)(Rprinc "A"))))
 86              (setq X x Y y)
 87              (return nil)))
 88 
 89 
 90 ; Output string.
 91 (defun DCTL-display-char-string (string)
 92        (setq X (+ X (stringlength string)))
 93        (Rprinc string))
 94 
 95 
 96 ; Clear to end of screen.
 97 (defun DCTL-clear-rest-of-screen ()
 98     (Rtyo 27.)(Rprinc "y")(setq X 0 Y 0))
 99 
100 ; Insert chars.
101 (defun DCTL-insert-char-string (str)
102        (Rtyo 27.)(Rprinc "i")
103        (Rprinc str)
104        (Rtyo 27.)(Rprinc "j")
105        (setq X (+ X (stringlength str))))
106 
107 ; delete characters from current position in line.
108 (defun DCTL-delete-chars (n)
109        (do i 1 (1+ i) (> i n)
110            (Rtyo 27.)(Rprinc "O")))
111 
112 ; Insert blank lines at current position.
113 (defun DCTL-insert-lines (n)
114        (do i 1 (1+ i)(> i n)
115            (Rtyo 27.)(Rprinc "L")))
116 
117 ; Delete lines at current position.
118 (defun DCTL-delete-lines (n)
119        (do i 1 (1+ i)(> i n)
120            (Rtyo 33)(Rprinc "M")))
121 
122 ; Send pad characters to wait specified no. of msecs.
123 (defun DCTL-pad (n)
124        (do i (// (* n ospeed) 100000.) (1- i) (= i 0) (Rtyo 0)))
125 ; Clear to end of line.
126 (defun DCTL-kill-line()
127        (Rtyo 27.)(Rprinc "x"))