1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 (declare (special X Y screenheight screenlinelen))
16 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
17
18 (declare (eval (read)))(setsyntax '/^ 'macro 'hatmac)
19 (declare (eval (read)))(defun hatmac ()(- (tyi) 100))
20
21 (defun DCTL-init ()
22 (setq idel-lines-availablep nil idel-chars-availablep nil)
23 (setq screenheight 16. screenlinelen 79.)
24 (setq tty-type 'cdc713)
25 (setq X 0 Y 0)
26 (Rtyo ^Y)(Rtyo ^X))
27
28
29
30 (defun DCTL-position-cursor (x y)
31 (cond ((and (= x X)(= y Y)))
32 ((and (= x 0)(= y 0))(Rtyo ^Y))
33 ((and (= x 0)(= y Y))(Rtyo ^M))
34 (t
35 (cond ((and (< x X)(> (- X x) x))
36 (cond ((and (< y Y)(> (- Y y) y))
37 (DCTL-position-cursor 0 0))
38 (t (DCTL-position-cursor 0 Y)))))
39 (cond ((< X x)
40 (do ex X (1+ ex)(= ex x)(Rtyo ^U)))
41 ((< x X)
42 (do ex x (1+ ex)(= ex X)(Rtyo ^H))))
43 (cond ((< Y y)
44 (do wy Y (1+ wy)(= wy y)(Rtyo ^J)))
45 ((< y Y)
46 (do wy y (1+ wy)(= wy Y)(Rtyo ^Z))))))
47 (setq X x Y y))
48
49
50 (defun DCTL-display-char-string (string)
51 (setq X (+ X (stringlength string)))
52 (Rprinc string))
53
54
55
56 (defun DCTL-clear-rest-of-screen () (Rtyo ^X))
57
58
59
60 (defun DCTL-kill-line () (Rtyo ^V))