1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 (declare (special X Y screenheight screenlinelen tty-type))
24 (declare (special idel-lines-availablep idel-chars-availablep))
25 (declare (special ctl-close-necessaryp))
26
27
28 (defun DCTL-init ()
29 (setq idel-lines-availablep t idel-chars-availablep t)
30 (setq screenheight 33. screenlinelen 79.)
31 (setq tty-type 'tek4025)(setq ctl-close-necessaryp t)
32 (Rtyo 37)(Rprinc "wor 33")(Rtyo 15)
33 (Rtyo 37)(Rprinc "wor")(Rtyo 15)
34 (setq X 0 Y 33))
35
36
37
38 (defun DCTL-position-cursor (x y)
39 (cond ((and (= x X)(= y Y))
40 nil)
41 ((and (= x 0)(= y 0))
42 (Rtyo 37)(Rprinc "jum")(Rtyo 15)
43 (setq X 0 Y 0))
44 ((= x 0)
45 (Rtyo 37)(Rprinc "jum ")
46 (DCTL-4025-outnum (+ y 1))
47 (Rtyo 15)
48 (setq X x Y y))
49 ((and (= x X)(> Y y))
50 (Rtyo 37)(Rprinc "up ")
51 (DCTL-4025-outnum (- Y y))
52 (Rtyo 15)
53 (setq Y y))
54 ((and (= x X)(< Y y))
55 (Rtyo 37)(Rprinc "dow ")
56 (DCTL-4025-outnum (- y Y))
57 (Rtyo 15)
58 (setq Y y))
59 ((and (= y Y)(> X x))
60 (Rtyo 37)(Rprinc "lef ")
61 (DCTL-4025-outnum (- X x))
62 (Rtyo 15)
63 (setq X x))
64 ((and (= y Y)(< X x))
65 (Rtyo 37)(Rprinc "rig ")
66 (DCTL-4025-outnum (- x X))
67 (Rtyo 15)
68 (setq X x))
69
70 (t (setq X x Y y)
71 (Rtyo 37)(Rprinc "jum ")
72 (DCTL-4025-outnum (+ y 1))
73 (Rprinc ",")
74 (DCTL-4025-outnum (+ x 1))
75 (Rtyo 15))))
76
77
78 (defun DCTL-display-char-string (string)
79 (setq X (+ X (stringlength string)))
80 (Rprinc string))
81
82
83
84 (defun DCTL-clear-rest-of-screen ()
85 (Rtyo 37)(Rprinc "dli 33")
86 (Rtyo 15))
87
88
89
90 (defun DCTL-kill-line ()
91 (Rtyo 37)(Rprinc "dch 80")
92 (Rtyo 15))
93
94
95 (defun DCTL-insert-lines (n)
96 (Rtyo 37)(Rprinc "ili ")
97 (DCTL-4025-outnum n)
98 (Rtyo 15))
99
100
101 (defun DCTL-delete-lines (n)
102 (Rtyo 37)(Rprinc "dli ")
103 (DCTL-4025-outnum n)
104 (Rtyo 15)
105 (DCTL-insert-lines n))
106
107
108 (defun DCTL-insert-char-string (str)
109 (Rtyo 37)(Rprinc "ich")(Rtyo 15)
110 (Rprinc str)
111
112 (setq X (+ X (stringlength str))))
113
114
115 (defun DCTL-delete-chars (n)
116 (Rtyo 37)(Rprinc "dch ")
117 (DCTL-4025-outnum n)
118 (Rtyo 15))
119
120 (defun DCTL-4025-outnum (n)
121 (cond ((> n 9.)
122 (Rtyo (+ 60 (// n 10.)))
123 (setq n (- n (* 10. (// n 10.))))))
124 (Rtyo (+ 60 n)))
125
126 (defun DCTL-close-screen ()
127 (Rtyo 37)(Rprinc "wor 0")(Rtyo 15))