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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 12 ;;        DatagraphiX 132B emacs control package               ;;
 13 ;;        created 22 February 1979 by Lee A. Newcomb, HIS, FSO ;;
 14 ;;        modified VIP 7800 controller.                        ;;
 15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 16 
 17 ;;; HISTORY COMMENTS:
 18 ;;;  1) change(86-04-23,Margolin), approve(86-04-23,MCR7325),
 19 ;;;     audit(86-08-12,Harvey), install(86-08-20,MR12.0-1136):
 20 ;;;     Added *expr declarations so that it would compile without warnings.
 21 ;;;                                                      END HISTORY COMMENTS
 22 
 23 
 24 (%include e-macros)
 25 
 26 (declare (special X Y screenheight screenlinelen tty-type))
 27 (declare (special idel-lines-availablep idel-chars-availablep))
 28 (declare (special given-tty-type))
 29 (declare (array* (notype (dg132b-posit ?))))
 30 
 31 (declare (*expr Rprinc Rtyo))
 32 
 33 ; Initialize terminal and terminal control package.
 34 (defun DCTL-init ()
 35        (setq idel-lines-availablep t idel-chars-availablep t)
 36        (setq screenlinelen 131.)
 37        (setq screenheight
 38              (cond ((eq given-tty-type 'dg132b) 30.)        ;30 lines for the screen
 39                    ((eq given-tty-type 'dg132b120) 120.)     ; user has the full terminal memory option
 40                    ((eq given-tty-type 'dg132b60) 60.)))     ; user has the default terminal memory
 41        (setq tty-type 'dg132b)
 42        (Rtyo 33)(Rprinc "H")                      ;clear/home cursor
 43        (setq X 0 Y 0))
 44 
 45 
 46 ; Move terminal's cursor to desired position.
 47 (defun DCTL-position-cursor (x y)
 48        (cond ((and (= x X)(= y Y))
 49               nil)                                ;cursor already at <x,y>
 50              ((and (= x 0)(= y 0))
 51               (Rtyo 33)(Rprinc "T")
 52               (setq X 0 Y 0))                     ;go home
 53              ((and (< (+ (cond ((< x X) (- X x))
 54                                (t (* 2 (- x X))))
 55                          (cond ((< Y y) (- y Y))
 56                                (t (* 2 (- Y y))))) 8))
 57               (cond ((< X x)
 58                      (do ex X (1+ ex)(= ex x) (Rtyo 33) (Rprinc "L")))
 59                     ((< x X)
 60                      (do ex x (1+ ex)(= ex X) (Rtyo 10))))
 61               (cond ((< Y y)
 62                      (do wy Y (1+ wy)(= wy y) (Rtyo 12)))
 63                     ((< y Y)
 64                      (do wy y (1+ wy) (= wy Y)(Rtyo 33)(Rprinc "K"))))
 65               (setq X x Y y))
 66                                                   ;; Direct Cursor Addressing is best.
 67              (t (setq X x Y y)
 68                 (Rtyo 33)(Rprinc "8")(Rprinc (dg132b-posit Y))(Rprinc (dg132b-posit X))
 69        )))
 70 
 71 ; Output string.
 72 (defun DCTL-display-char-string (string)
 73        (Rprinc string)
 74        (setq X (+ X (stringlength string))))
 75 
 76 ; Clear to end of screen.
 77 (defun DCTL-clear-rest-of-screen ()
 78        (Rtyo 33)(Rprinc "I"))
 79 
 80 ; Clear to end of line.
 81 (defun DCTL-kill-line ()
 82        (Rtyo 33)(Rprinc "O"))
 83 
 84 (defun DCTL-insert-lines (n)
 85        (do i 1 (1+ i) (> i n)
 86            (Rtyo 33)(Rprinc "3")))
 87 
 88 (defun DCTL-delete-lines (n)
 89        (do i 1 (1+ i) (> i n)
 90            (Rtyo 33)(Rprinc "4")))
 91 
 92 (defun DCTL-insert-char-string (str)
 93        (Rtyo 33)(Rprinc "0")
 94        (Rprinc  str)
 95        (Rtyo 33) (Rprinc "5")
 96        (setq X (+ X (stringlength str))))
 97 
 98 (defun DCTL-delete-chars (n)
 99        (do i 0 (1+ i)(= i n)
100            (Rtyo 33)(Rprinc "6")))
101 
102 (array dg132b-posit t 132.)
103 (fillarray 'dg132b-posit '("001" "002" "003" "004" "005" "006" "007" "008"
104                                       "009" "010" "011" "012" "013" "014" "015"
105                                       "016" "017" "018" "019" "020" "021" "022"
106                                       "023" "024" "025" "026" "027" "028" "029"
107                                       "030" "031" "032" "033" "034" "035" "036"
108                                       "037" "038" "039" "040" "041" "042" "043"
109                                       "044" "045" "046" "047" "048" "049" "050"
110                                       "051" "052" "053" "054" "055" "056" "057"
111                                       "058" "059" "060" "061" "062" "063" "064"
112                                       "065" "066" "067" "068" "069" "070" "071"
113                                       "072" "073" "074" "075" "076" "077" "078"
114                                       "079" "080" "081" "082" "083" "084" "085"
115                                       "086" "087" "088" "089" "090" "091" "092"
116                                       "093" "094" "095" "096" "097" "098" "099"
117                                       "100" "101" "102" "103" "104" "105" "106"
118                                       "107" "108" "109" "110" "111" "112" "113"
119                                       "114" "115" "116" "117" "118" "119" "120"
120                                       "121" "122" "123" "124" "125" "126" "127"
121                                       "128" "129" "130" "131" "132"))