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 ;;;       H19 control package
 12 ;;;       BSG 3/21/78 from DD4000ctl
 13 ;;;       CAH 7/18/79 from vt52ctl
 14 ;;;       WMY 8/27/80 to add insert-mode stuff
 15 ;;;       AEB 9/17/80 Added delays to delete/insert lines and delete chars
 16 ;;;
 17 
 18 (declare (special X Y ospeed screenheight screenlinelen))
 19 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
 20 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep
 21                   DCTL-insert-mode-on))
 22 
 23 ; Initialize terminal and terminal control package.
 24 
 25 (defun DCTL-init ()
 26        (setq idel-lines-availablep t idel-chars-availablep t)
 27        (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
 28        (setq screenheight 24. screenlinelen 79.)
 29        (setq tty-type 'h19)
 30        (Rtyo 33)(Rprinc "H")(Rtyo 33)(Rprinc "J")
 31        (setq X 0 Y 0)
 32        (DCTL-prologue))
 33 
 34 ;;; Prologue
 35 (defun DCTL-prologue ()
 36        (setq DCTL-insert-mode-on nil)
 37        (Rtyo 33) (Rprinc "O"))          ; turn off insert-mode
 38 
 39 ;;; Epilogue
 40 (defun DCTL-epilogue ()
 41        (setq DCTL-insert-mode-on nil)
 42        (Rtyo 33) (Rprinc "O"))
 43 
 44 ; Move terminal's cursor to desired position.
 45 
 46 (defun DCTL-position-cursor (x y)
 47        (cond ((and (= x X)(= y Y))
 48               nil)
 49              ((and (= x 0)(= y 0))
 50               (Rtyo 33)(Rprinc "H")
 51               (setq X 0 Y 0))
 52              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
 53               (cond ((< X x)
 54                      (do ex X (1+ ex)(= ex x)(Rtyo 33)(Rprinc "C")))
 55                     ((< x X)
 56                      (do ex x (1+ ex)(= ex X)(Rtyo 010))))
 57               (cond ((< Y y)
 58                      (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rprinc "B")))
 59                     ((< y Y)
 60                      (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "A"))))
 61               (setq X x Y y))
 62 ;; Direct Cursor Addressing is best.
 63              (t (setq X x Y y)
 64                 (Rtyo 33)(Rprinc "Y")(Rtyo (+ 40 y))(Rtyo (+ 40 x))
 65                     )))
 66 
 67 
 68 ; Output string.
 69 
 70 (defun DCTL-display-char-string (string)
 71        (cond (DCTL-insert-mode-on
 72                (setq DCTL-insert-mode-on nil)
 73                (Rtyo 33) (Rprinc "O")))
 74        (setq X (+ X (stringlength string)))
 75        (Rprinc string))
 76 
 77 
 78 ; Clear to end of screen.
 79 
 80 (defun DCTL-clear-rest-of-screen ()
 81        (Rtyo 33)(Rprinc "J"))
 82 
 83 
 84 ; Clear to end of line.
 85 
 86 (defun DCTL-kill-line ()
 87        (Rtyo 33)(Rprinc "K"))
 88 
 89 ; Insert character string at current position.
 90 
 91 (defun DCTL-insert-char-string (str)
 92        (cond ((not DCTL-insert-mode-on)
 93               (setq DCTL-insert-mode-on t)
 94               (Rtyo 33)(Rprinc "@")))
 95        (Rprinc str)
 96        (let ((len (stringlength str)))
 97             (DCTL-pad (* len 1050.))
 98             (setq X (+ X len))))
 99 
100 ;;; Delete characters from current position in line.
101 
102 (defun DCTL-delete-chars (n)
103        (do i 1 (1+ i) (> i n)
104            (Rtyo 33) (Rprinc "N"))
105            (DCTL-pad (* n 2900.)))
106 
107 ;;; Insert n blank lines at current position.
108 
109 (defun DCTL-insert-lines (n)
110        (do i 1 (1+ i) (> i n)
111            (Rtyo 33) (Rprinc "L") (DCTL-pad 24000.))
112        (setq X 0))
113 
114 ;;; Delete n lines at current position.
115 
116 (defun DCTL-delete-lines (n)
117        (do i 1 (1+ i) (> i n)
118            (Rtyo 33) (Rprinc "M") (DCTL-pad 24000.))
119        (setq X 0))
120 
121 ; Send pad characters
122 
123 (defun DCTL-pad (n)
124        (do i (// (* n ospeed) 1000000.) (1- i) (= i 0)
125            (Rtyo 0)))