1 ;;; *****************************************************
 2 ;;; *                                                   *
 3 ;;; * Copyright (C) 1983 by Massachusetts Institute of  *
 4 ;;; * Technology and Honeywell Information Systems Inc. *
 5 ;;; *                                                   *
 6 ;;; *****************************************************
 7 ;;;
 8 ;;; -*-LISP-*-
 9 
10 ;;;
11 ;;;       Netronics Smarterm-80 control package
12 ;;;       Ripped off from iq120.ctl.lisp by Alberto Magnani 12/3/83.
13 ;;;
14 
15 (declare (special X Y screenheight screenlinelen tty-type))
16 (declare (special idel-lines-availablep idel-chars-availablep))
17 (declare (*expr Rprinc Rtyo))
18 
19 ; Initialize terminal and terminal control package.
20 (defun DCTL-init ()
21        (setq idel-lines-availablep t idel-chars-availablep t)
22        (setq screenheight 24. screenlinelen 79.)
23        (setq tty-type 'smarterm)
24        (Rtyo 14)
25        (setq X 0 Y 0))
26 
27 
28 ; Move terminal's cursor to desired position.
29 (defun DCTL-position-cursor (x y)
30        (cond ((and (= x X)(= y Y))
31               nil)
32              ((and (= x 0)(= y 0))
33               (Rtyo 32)
34               (setq X 0 Y 0))
35              ((and (= x 0)(= y Y))
36               (Rtyo 15)
37               (setq X 0 Y y))
38              ((and (= x 0)(< (abs(- Y y)) 3))
39               (Rtyo 15)
40               (cond ((< Y y)
41                      (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
42                     ((< y Y)
43                      (do wy y (1+ wy)(= wy Y)(Rtyo 13))))
44               (setq X 0 Y y))
45              ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
46               (cond ((< X x)
47                      (do ex X (1+ ex)(= ex x)(Rtyo 1)))
48                     ((< x X)
49                      (do ex x (1+ ex)(= ex X)(Rtyo 10))))
50               (cond ((< Y y)
51                      (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
52                     ((< y Y)
53                      (do wy y (1+ wy)(= wy Y)(Rtyo 13))))
54               (setq X x Y y))
55 ;; Direct Cursor Addressing is best.
56              (t (setq X x Y y)
57                 (Rtyo 33) (Rprinc "=")(Rtyo (+ 40 y))(Rtyo (+ 40 x))
58                     )))
59 
60 
61 ; Output string.
62 (defun DCTL-display-char-string (string)
63        (setq X (+ X (stringlength string)))
64        (Rprinc string))
65 
66 
67 ; Clear to end of screen.
68 (defun DCTL-clear-rest-of-screen ()
69        (Rtyo 33)(Rprinc "Y"))
70 
71 
72 ; Clear to end of line.
73 (defun DCTL-kill-line ()
74        (Rtyo 33)(Rprinc "T"))
75 
76 
77 ; Inserting/deleteing lines
78 (defun DCTL-insert-lines (n)
79        (do i 1 (1+ i)(> i n)
80            (Rtyo 33)(Rprinc "E")))
81 
82 (defun DCTL-delete-lines (n)
83        (do i 1 (1+ i)(> i n)
84            (Rtyo 33)(Rprinc "R")))
85 
86 
87 ; Inserting/deleteing characters
88 (defun DCTL-insert-char-string (str)
89        (Rtyo 33)(Rprinc "N")
90        (Rprinc str)
91        (Rtyo 33)(Rprinc "M")
92        (setq X (+ X (stringlength str))))
93 
94 (defun DCTL-delete-chars (n)
95        (do i 1 (1+ i)(> i n)
96            (Rtyo 33)(Rprinc "W")))
97 
98 ; That's it guys.