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 ;;;       Data Media 2500 control package
 14 ;;;       EAK 3/27/78
 15 ;;;
 16 
 17 (declare (special dcaconses X Y screenheight screenlinelen tty-type))
 18 (declare (special idel-lines-availablep idel-chars-availablep))
 19 
 20 
 21 ;;; Initialize terminal and terminal control package.
 22 (defun DCTL-init ()
 23        (setq idel-lines-availablep t
 24              idel-chars-availablep t)
 25        (setq dcaconses (list (ascii 14) nil nil))
 26        (setq screenheight 24.                              ; 20 lines for editing
 27              screenlinelen 79.)
 28        (setq tty-type 'dm2500)
 29        (DCTL-clear-screen))                             ; clear whole screen
 30 
 31 
 32 ;;; Move terminal's cursor to desired position.
 33 (defun DCTL-position-cursor (x y)
 34        (cond ((and (= x X)(= y Y))
 35               nil)
 36              ((and (= x 0)(= y 0))
 37               (Rtyo 2)
 38               (setq X 0 Y 0))
 39 ;;; Direct Cursor Addressing is best.
 40              (t (rplaca (cdr dcaconses) (boole 6 x 140))
 41                 (rplaca (cddr dcaconses) (boole 6 y 140))
 42                 (Rprinc (implode dcaconses))
 43                 (setq X x Y y))))
 44 
 45 
 46 ; Output string.
 47 (defun DCTL-display-char-string (string)
 48        (setq X (+ X (stringlength string)))
 49        (Rprinc string))
 50 
 51 
 52 ; Clear whole screen.
 53 (defun DCTL-clear-screen ()
 54        (Rtyo 36)
 55        (setq X 0 Y 0))
 56 
 57 
 58 ; Clear to end of screen.
 59 (defun DCTL-clear-rest-of-screen ()
 60    ((lambda (x y)
 61        (do i Y (1+ i) (= i (1- screenheight))
 62            (Rprinc (catenate (ascii 27) (ascii 15) (ascii 12)))
 63            (setq X 0 Y (1+ Y)))
 64        (Rtyo 27)
 65        (DCTL-position-cursor x y))
 66     X Y))
 67 
 68 
 69 ; Clear to end of line.
 70 (defun DCTL-kill-line ()
 71        (Rtyo 27))
 72 
 73 
 74 ; Insert character string in line at current position.
 75 (defun DCTL-insert-char-string (str)
 76        (Rtyo 20)
 77        (do i (stringlength str) (1- i) (not (> i 0))
 78            (Rtyo 34))
 79        (Rtyo 30)
 80        (Rprinc str)
 81        (setq X (+ X (stringlength str))))
 82 
 83 
 84 ; Delete characters from current position in line.
 85 (defun DCTL-delete-chars (n)
 86        (Rtyo 20)
 87        (do i 1 (1+ i)(> i n)
 88            (Rtyo 10))
 89        (Rtyo 30))
 90 
 91 
 92 ; Insert n blank lines at current position.
 93 (defun DCTL-insert-lines (n)
 94        (Rtyo 20)
 95        (do i 1 (1+ i)(> i n)
 96            (Rtyo 12))
 97        (Rtyo 30))
 98 
 99 
100 ; Delete n lines at current position.
101 (defun DCTL-delete-lines (n)
102        (Rtyo 20)
103        (do i 1 (1+ i)(> i n)
104            (Rtyo 32))
105        (Rtyo 30))