1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24 (declare (special X Y screenheight screenlinelen tty-type ospeed))
25 (declare (special idel-lines-availablep idel-chars-availablep))
26 (declare (special DCTL-writebehind-buf-used))
27
28
29
30
31 (defun DCTL-init ()
32 (setq idel-lines-availablep t idel-chars-availablep t)
33 (setq screenheight 24. screenlinelen 79.)
34 (setq tty-type 'tvi920)
35 (DCTL-clear-writebehind-buf)
36 (Rtyo 36)(Rtyo 33)(Rprinc "Y")
37 (setq X 0 Y 0))
38
39
40
41
42
43
44 (defun DCTL-position-cursor (x y)
45 (cond ((and (= x X)(= y Y))
46 nil)
47 ((and (= x 0)(= y 0))
48 (Rtyo 36)
49 (setq X 0 Y 0))
50 ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
51 (cond ((< X x)
52 (do ex X (1+ ex)(= ex x)(Rtyo 14)))
53 ((< x X)
54 (do ex x (1+ ex)(= ex X)(Rtyo 10))))
55 (cond ((< Y y)
56 (do wy Y (1+ wy)(= wy y)(Rtyo 12)))
57 ((< y Y)
58 (do wy y (1+ wy)(= wy Y)(Rtyo 13))))
59 (setq X x Y y))
60
61 (t (setq X x Y y)
62 (Rtyo 33)(Rprinc "=")
63 (Rtyo (+ 40 y))(Rtyo (+ 40 x)))))
64
65
66
67
68 (defun DCTL-display-char-string (string)
69 (Rprinc string)
70 (setq X (+ X (stringlength string))))
71
72
73
74
75 (defun DCTL-clear-rest-of-screen ()
76 (Rtyo 33)(Rprinc "Y"))
77
78
79
80
81 (defun DCTL-kill-line ()
82 (Rtyo 33)(Rprinc "T"))
83
84
85
86
87 (defun DCTL-insert-lines (n)
88 (DCTL-clear-writebehind-buf)
89 (do i 1 (1+ i)(> i n)
90 (Rtyo 33)(Rprinc "E")
91 (DCTL-underpad 78.))
92 (setq X 0)
93 (DCTL-clear-writebehind-buf))
94
95
96
97
98 (defun DCTL-delete-lines (n)
99 (DCTL-clear-writebehind-buf)
100 (do i 1 (1+ i)(> i n)
101 (Rtyo 33)(Rprinc "R")
102 (DCTL-underpad 78.))
103 (setq X 0)
104 (DCTL-clear-writebehind-buf))
105
106
107
108
109 (defun DCTL-insert-char-string (str)
110 (DCTL-clear-writebehind-buf)
111 (do i (stringlength str) (1- i) (= i 0)
112 (Rtyo 33) (Rprinc "Q")
113 (DCTL-underpad 19.))
114 (Rprinc str)
115 (DCTL-clear-writebehind-buf)
116 (setq X (+ X (stringlength str))))
117
118
119
120
121 (defun DCTL-delete-chars (n)
122 (DCTL-clear-writebehind-buf)
123 (do i 0 (1+ i)(= i n)
124 (Rtyo 33)(Rprinc "W")
125 (DCTL-underpad 19.))
126 (DCTL-clear-writebehind-buf))
127
128
129
130
131
132
133 (defun DCTL-underpad (n)
134 (do i (1+ (// (* n ospeed) 1000.)) (1- i) (= i 0)
135 (setq DCTL-writebehind-buf-used (1+ DCTL-writebehind-buf-used))
136 (cond ((> DCTL-writebehind-buf-used 80.)(Rtyo 0)))))
137
138
139 (defun DCTL-clear-writebehind-buf ()
140 (setq DCTL-writebehind-buf-used 0))