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 ;;;       I100 control package
 15 ;;;       CWH 3/5/79 from VT52ctl
 16 ;;;       BSG 3/21/78 from DD4000ctl
 17 ;;;
 18 
 19 ;;; HISTORY COMMENTS:
 20 ;;;  1) change(86-04-23,Margolin), approve(86-04-23,MCR7325),
 21 ;;;     audit(86-08-12,Harvey), install(86-08-20,MR12.0-1136):
 22 ;;;     Added *expr declarations so that it would compile without warnings.
 23 ;;;                                                      END HISTORY COMMENTS
 24 
 25 
 26 (%include e-macros)
 27 (declare (special X Y screenheight screenlinelen ospeed))
 28 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
 29 (declare (*expr Rprinc Rtyo))
 30 
 31 ; Initialize terminal and terminal control package.
 32 (defun DCTL-init ()
 33        (setq idel-lines-availablep t idel-chars-availablep nil)
 34        (setq screenheight 24. screenlinelen 79.)
 35        (setq tty-type 'infoton100)
 36        (DCTL-home-cursor)
 37        (DCTL-clear-rest-of-screen)
 38        (setq X 0 Y 0))
 39 
 40 ; Move terminal's cursor to desired position.
 41 (defun DCTL-position-cursor (x y)
 42        (cond ((and (= x X)(= y Y))
 43               nil)
 44              ((and (= x 0)(= y 0))
 45               (DCTL-home-cursor)
 46               (setq X 0 Y 0))
 47              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
 48               (cond ((< X x)
 49                      (do ex X (1+ ex)(= ex x)(Rtyo 33)(Rprinc "C")))
 50                     ((< x X)
 51                      (do ex x (1+ ex)(= ex X)(Rtyo 010))))
 52               (cond ((< Y y)
 53                      (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rprinc "B")))
 54                     ((< y Y)
 55                      (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "A"))))
 56               (setq X x Y y))
 57 ;; Direct Cursor Addressing is best.
 58              (t (setq X x Y y)
 59                 (Rtyo 33)(Rprinc "f")(Rtyo (+ 40 x))(Rtyo (+ 40 y))
 60                 )))
 61 
 62 ; Output string.
 63 (defun DCTL-display-char-string (string)
 64        (setq X (+ X (stringlength string)))
 65        (Rprinc string))
 66 
 67 ; Home cursor to upper left corner.
 68 (defun DCTL-home-cursor ()
 69        (Rtyo 33) (Rprinc "H"))
 70 
 71 ; Clear to end of screen.
 72 (defun DCTL-clear-rest-of-screen ()
 73        (Rtyo 33) (Rprinc "J"))
 74 
 75 ; Clear to end of line.
 76 (defun DCTL-kill-line ()
 77        (Rtyo 33)(Rprinc "K"))
 78 
 79 ; Insert n blank lines at current position.
 80 (defun DCTL-insert-lines (n)
 81        (do i 1 (1+ i)(> i n)
 82            (Rtyo 33) (Rprinc "L")
 83            (DCTL-pad 100000.)))
 84 
 85 ; Delete n lines at current position.
 86 (defun DCTL-delete-lines (n)
 87        (do i 1 (1+ i)(> i n)
 88            (Rtyo 33) (Rprinc "M")
 89            (DCTL-pad 100000.)))
 90 
 91 ; Send pad characters
 92 (defun DCTL-pad (n)
 93        (do i (// (* n ospeed) 1000000.) (1- i) (= i 0)
 94            (Rtyo 0)))
 95 
 96 ; Delete characters from current position in line.
 97 ; This won't work unless the terminal has the block mode option.
 98 ; Create a separate terminal type?
 99 ;(defun DCTL-delete-chars (n)
100 ;       (do i 1 (1+ i)(> i n)
101 ;           (Rtyo 33) (Rprinc "P")))
102 
103 ; Insert character string in line at current position.
104 ; This won't work unless terminal has block mode option.
105 ;(defun DCTL-insert-char-string (str)
106 ;       (do i (stringlength str) (1- i) (= i 0)
107 ;          (Rtyo 33) (Rprinc "@"))
108 ;      (Rprinc str)
109 ;      (setq X (+ X (stringlength str))))
110