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 ;;;       ADM2 control package
 14 ;;;       EAK 3/31/78
 15 ;;;
 16 
 17 (declare (special dcaconses X Y screenheight 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 dcaconses (list (ascii 33) '= nil nil))
 24        (setq screenheight 24.)                             ; 20 lines for editing
 25        (setq screenlinelen 79.)
 26        (setq idel-lines-availablep t
 27              idel-chars-availablep t)
 28        (setq tty-type 'adm2)
 29        (Rtyo 33)(Rprinc "*")                            ; 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 (+ 1 y x))              ; cost is V + H + 1
 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 (abs (- y Y)))
 47              (setq xcost (abs (- x X)))
 48              (and (< (+ ycost xcost) cost)
 49                   (setq what 3                  ; 3: "relative move"
 50                         cost (+ ycost xcost)))
 51              (and (< (+ 1 ycost x) cost)
 52                   (setq what 2))                ; 2: "CR and relative move"
 53              (cond ((= what 0)
 54 
 55 ; Direct Cursor Address
 56 
 57                     (rplaca (cddr dcaconses) (+ 40 y))
 58                     (rplaca (cdddr dcaconses) (+ 40 x))
 59 
 60                     (Rprinc (implode dcaconses))
 61                     (setq X x Y y)
 62                     (return nil))
 63 
 64                    ((= what 1)                  ; home and relative move?
 65                     (Rtyo 36)                   ; home
 66                     (setq X 0 Y 0))             ; keep track of cursor
 67                                                 ; fall through to relative move
 68 
 69                    ((= what 2)                  ; CR and relative move?
 70                     (Rtyo 15)                   ; CR
 71                     (setq X 0)))                ; keep track of cursor
 72                                                 ; fall through to relative move
 73 
 74 ; Relative Move
 75 
 76              (cond ((< X x)
 77                     (do ex X (1+ ex)(= ex x)(Rtyo 14)))
 78                    ((< x X)
 79                     (do ex x (1+ ex)(= ex X)(Rtyo 10))))
 80              (cond ((< Y y)
 81                     (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
 82                    ((< y Y)
 83                     (do wy y (1+ wy)(= wy Y)(Rtyo 13))))
 84              (setq X x Y y)
 85              (return nil)))
 86 
 87 
 88 ; Output string.
 89 (defun DCTL-display-char-string (string)
 90        (setq X (+ X (stringlength string)))
 91        (Rprinc string))
 92 
 93 
 94 ; Clear to end of screen.
 95 (defun DCTL-clear-rest-of-screen ()
 96        (Rtyo 33)(Rprinc "Y"))
 97 
 98 
 99 ; Clear to end of line.
100 (defun DCTL-kill-line ()
101        (Rtyo 33)(Rprinc "T"))
102 
103 
104 ; Insert character string in line at current position.
105 (defun DCTL-insert-char-string (str)
106        (do i (stringlength str) (1- i) (= i 0)
107            (Rtyo 33)(Rprinc "Q"))
108        (Rprinc str)
109        (setq X (+ X (stringlength str))))
110 
111 
112 ; Delete characters from current position in line.
113 (defun DCTL-delete-chars (n)
114        (do i 1 (1+ i)(> i n)
115            (Rtyo 33)(Rprinc "W")))
116 
117 
118 ; Insert n blank lines at current position.
119 (defun DCTL-insert-lines (n)
120        (do i 1 (1+ i)(> i n)
121            (Rtyo 33)(Rprinc "E")))
122 
123 
124 ; Delete n lines at current position.
125 (defun DCTL-delete-lines (n)
126        (do i 1 (1+ i)(> i n)
127            (Rtyo 33)(Rprinc "R")))