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 ;;;       Hazeltine 1510 control package
14 ;;;       Ripped off from VIP7800ctl by CDT, 01/80
15 ;;;
16 
17 (declare (special X Y screenheight screenlinelen tty-type))
18 (declare (special idel-lines-availablep idel-chars-availablep))
19 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep))
20 
21 
22 ; Initialize terminal and terminal control package.
23 (defun DCTL-init ()
24        (setq idel-lines-availablep t idel-chars-availablep nil)
25        (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
26        (setq screenheight 24. screenlinelen 79.)
27        (setq tty-type 'haz1510)
28        (Rtyo 33)(Rtyo 34)
29        (setq X 0 Y 0)
30        (DCTL-prologue))
31 
32 
33 ;;; Prologue code
34 (defun DCTL-prologue ()
35        (Rtyo 33) (Rtyo 34))
36 
37 ;;; Epilogue code
38 (defun DCTL-epilogue ()
39        (Rtyo 33) (Rtyo 34))
40 
41 
42 ; Move terminal's cursor to desired position.
43 (defun DCTL-position-cursor (x y)
44        (cond ((and (= x X)(= y Y))
45               nil)
46              ((and (= x 0)(= y 0))
47               (Rtyo 33)(Rtyo 22)
48               (setq X 0 Y 0))
49              ((and (< (+ (abs (- X x))(abs (- Y y))) 3))
50               (cond ((< X x)
51                      (do ex X (1+ ex)(= ex x)(Rtyo 20)))
52                     ((< x X)
53                      (do ex x (1+ ex)(= ex X)(Rtyo 10))))
54               (cond ((< Y y)
55                      (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rtyo 13)))
56                     ((< y Y)
57                      (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rtyo 14))))
58               (setq X x Y y))
59 ;; Direct Cursor Addressing is best.
60              (t (setq X x Y y)
61                 (Rtyo 33)(Rtyo 21)(Rtyo x)(Rtyo y)
62                     )))
63 
64 
65 ;;; Output string.
66 (defun DCTL-display-char-string (string)
67        ((lambda (strx)
68                 (cond ((= strx 0))                ;bug in redisplay calls with no string
69                       (t (Rprinc string)
70                          (setq X (+ X strx)))))
71         (stringlength string)))
72 
73 
74 ; Clear to end of screen.
75 (defun DCTL-clear-rest-of-screen ()
76        (Rtyo 33)(Rtyo 30))
77 
78 
79 ; Clear to end of line.
80 (defun DCTL-kill-line ()
81        (Rtyo 33)(Rtyo 17))
82 
83 
84 (defun DCTL-insert-lines (n)
85        (do i 1 (1+ i)(> i n)
86                (Rtyo 33)(Rtyo 32)))
87 
88 (defun DCTL-delete-lines (n)
89        (do i 1 (1+ i)(> i n)
90                (Rtyo 33)(Rtyo 23)))