1
2
3
4
5
6
7
8
9
10
11
12
13
14 (%include e-macros)
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 (declare (special DCTL-insert-mode-on))
21 (declare (*expr Rprinc Rtyo))
22
23
24 (defun DCTL-outdec (n)
25 ((lambda (have-output)
26 (do digi '(1000. 100. 10. 1) (cdr digi) (null digi)
27 ((lambda (rem)
28 (cond ((or have-output (> rem 0) (= (car digi) 1))
29 (Rtyo (+ 60 rem))
30 (setq have-output t)))
31 (setq n (\ n (car digi))))
32 (// n (car digi)))))
33 nil))
34
35
36
37 (defun DCTL-init ()
38 (setq idel-lines-availablep t idel-chars-availablep t)
39 (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
40 (setq screenheight 24. screenlinelen 79.)
41 (setq tty-type 'dku7102)
42 (DCTL-prologue)
43 (Rtyo 33)(Rprinc "[2J")
44 (Rtyo 33)(Rprinc "[H")
45 (setq X 0 Y 0))
46
47
48
49
50 (defun DCTL-prologue ()
51 (Rtyo 33) (Rprinc "[?=h")
52 (DCTL-set-insert-mode nil)
53 (Rtyo 33) (Rprinc "[=l")
54
55
56
57 (defun DCTL-epilogue ()
58 (setq DCTL-insert-mode-on nil)
59 (Rtyo 33) (Rprinc "c"))
60
61
62
63
64 (defun DCTL-position-cursor (x y)
65
66 (cond ((and (= x X)(= y Y))
67 nil)
68 ((and (= x 0)(= y 0))
69 (Rtyo 33)(Rprinc "[H")
70 (setq X 0 Y 0))
71 ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
72 (cond ((< X x)
73 (do ex X (1+ ex)(= ex x)(Rtyo 33)(Rprinc "[C")))
74 ((< x X)
75 (do ex x (1+ ex)(= ex X)(Rtyo 33)(Rprinc "[D"))))
76 (cond ((< Y y)
77 (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rprinc "[B")))
78 ((< y Y)
79 (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "[A"))))
80 (setq X x Y y))
81
82 (t (setq X x Y y)
83 (Rtyo 33)(Rprinc "[")(DCTL-outdec (1+ y))(Rprinc ";")(DCTL-outdec (1+ x))(Rprinc "f")
84 )))
85
86
87
88
89 (defun DCTL-display-char-string (string)
90 ((lambda (strx)
91 (cond ((= strx 0))
92 (t (DCTL-set-insert-mode nil)
93
94 (Rprinc string)
95 (setq X (+ X strx)))))
96 (stringlength string)))
97
98
99
100 (defun DCTL-clear-rest-of-screen ()
101 (Rtyo 33)(Rprinc "[0J"))
102
103
104
105 (defun DCTL-kill-line ()
106 (Rtyo 33)(Rprinc "[0K"))
107
108
109
110
111 (defun DCTL-insert-lines (n)
112 (Rtyo 33)(Rprinc "[")(DCTL-outdec n)(Rprinc "L")))
113
114
115
116 (defun DCTL-delete-lines (n)
117 (Rtyo 33)(Rprinc "[")(DCTL-outdec n)(Rprinc "M")))
118
119
120
121 (defun DCTL-insert-char-string (str)
122 (DCTL-set-insert-mode t)
123 (Rprinc str)
124 (setq X (+ X (stringlength str))))
125
126
127
128 (defun DCTL-delete-chars (n)
129 (Rtyo 33)(Rprinc "[")(DCTL-outdec n)(Rprinc "P"))
130
131
132
133 (defun DCTL-set-insert-mode (bit)
134 (if bit
135 (if DCTL-insert-mode-on
136 else
137 (setq DCTL-insert-mode-on t)
138 (Rtyo 33) (Rprinc "[4h"))
139 else
140 (if (not DCTL-insert-mode-on)
141 else
142 (setq DCTL-insert-mode-on nil)
143 (Rtyo 33) (Rprinc "[4l"))))
144
145
146
147
148
149
150