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 ;;; -*-LISP-*-
 11 
 12 ;;;
 13 ;;;       HP2645 control package
 14 ;;;       EAK 3/18/78
 15 ;;;
 16 
 17 (declare (special xconses yconses escfxconsesyconses X Y screenheight ospeed tty-type))
 18 (declare (special idel-lines-availablep idel-chars-availablep screenlinelen))
 19 
 20 
 21 ; Initialize terminal and terminal control package.
 22 (defun DCTL-init ()
 23        (setq xconses (list nil nil))
 24        (setq yconses (list nil nil))
 25        (setq escfxconsesyconses (nconc (list (ascii 33) '& 'a)
 26                                        xconses (list 'c)
 27                                        yconses (list 'R)))
 28        (setq screenheight 24.)                             ; 20 lines for editing
 29        (setq screenlinelen 79.)
 30        (setq idel-lines-availablep t idel-chars-availablep t)
 31        (setq tty-type 'hp2645)
 32        (Rtyo 33) (Rprinc "H")                           ; clear screen: home,
 33        (Rtyo 33) (Rprinc "J")                     ; and erase to end
 34        (setq X 0 Y 0))
 35 
 36 
 37 ; Move terminal's cursor to desired position.
 38 (defun DCTL-position-cursor (x y)
 39        (prog (ycost                               ; cost of y and x relative
 40                 xcost                                       ; movement
 41                 what                                        ; which movement is best
 42                 cost)                                       ; cost of that movement
 43                (and (= x X)(= y Y)                ; return right away if already
 44                       (return nil))                         ; at desired position
 45                (setq what 1                       ; 1: "home and relative move"
 46                        cost (+ 2 y x x))                    ; cost is V + 2H + 2
 47                (and (> cost 9)                              ; direct cursor address better?
 48                       (setq what 0                          ; 0: "direct cursor address"
 49                               cost 9))            ; cost is 9 characters
 50                (setq ycost (- y Y))
 51                (and (< ycost 0)
 52                       (setq ycost (* (- ycost) 2)))
 53                (setq xcost (- X x))
 54                (and (< xcost 0)
 55                       (setq xcost (* (- xcost) 2)))
 56                (and (< (+ ycost xcost) cost)
 57                       (setq what 3                          ; 3: "relative move"
 58                               cost (+ ycost xcost)))
 59                (and (< (+ 1 ycost x x) cost)
 60                       (setq what 2))              ; 2: "CR and relative move"
 61                (cond ((= what 0)
 62 
 63 ; Direct Cursor Address
 64 
 65                         (rplaca xconses (+ 60 (// x 10.)))
 66                         (rplaca (cdr xconses) (+ 60 (\ x 10.)))
 67 
 68                         (rplaca yconses (+ 60 (// y 10.)))
 69                         (rplaca (cdr yconses) (+ 60 (\ y 10.)))
 70 
 71                         (Rprinc (implode escfxconsesyconses))
 72                         (setq X x Y y)
 73                         (return nil))
 74 
 75                        ((= what 1)                          ; home and relative move?
 76                         (Rtyo 33)(Rprinc "H")     ; home
 77                         (setq X 0 Y 0))           ; keep track of cursor
 78                                                             ; fall through to relative move
 79 
 80                        ((= what 2)                          ; CR and relative move?
 81                         (Rtyo 15)                           ; CR
 82                         (setq X 0)))              ; keep track of cursor
 83                                                             ; fall through to relative move
 84 
 85 ; Relative Move
 86 
 87                (cond ((< X x)
 88                         (do ex X (1+ ex)(= ex x)(Rtyo 33)(Rprinc "C")))
 89                        ((< x X)
 90                         (do ex x (1+ ex)(= ex X)(Rtyo 10))))
 91                (cond ((< Y y)
 92                         (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
 93                        ((< y Y)
 94                         (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "A"))))
 95                (setq X x Y y)
 96                (return nil)))
 97 
 98 
 99 ; Output string.
100 (defun DCTL-display-char-string (string)
101        (setq X (+ X (stringlength string)))
102        (Rprinc string))
103 
104 
105 ; Clear to end of screen.
106 (defun DCTL-clear-rest-of-screen ()
107        (Rtyo 33)(Rprinc "J"))
108 
109 
110 ; Clear to end of line.
111 (defun DCTL-kill-line ()
112        (Rtyo 33)(Rprinc "K"))
113 
114 
115 ; Insert character string in line at current position.
116 (defun DCTL-insert-char-string (str)
117        (Rtyo 33)(Rprinc "Q")
118        (Rprinc str)
119        (Rtyo 33)(Rprinc "R")
120        (setq X (+ X (stringlength str))))
121 
122 
123 ; Delete characters from current position in line.
124 (defun DCTL-delete-chars (n)
125        (do i 1 (1+ i)(> i n)
126            (Rtyo 33)(Rprinc "P")(DCTL-pad 7000.)))
127 
128 
129 ; Insert n blank lines at current position.
130 (defun DCTL-insert-lines (n)
131        (do i 1 (1+ i)(> i n)
132            (Rtyo 33)(Rprinc "L")))
133 
134 
135 ; Delete n lines at current position.
136 (defun DCTL-delete-lines (n)
137        (do i 1 (1+ i)(> i n)
138            (Rtyo 33)(Rprinc "M")))
139 
140 
141 ; Send pad characters to wait specified no. of microseconds.
142 (defun DCTL-pad (n)
143        (do i (// (* n ospeed) 1000000.) (1- i) (= i 0)
144            (Rtyo 0)))