1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17 (declare (special X Y screenheight screenlinelen))
18 (declare (special tty-type))
19 (declare (special idel-lines-availablep idel-chars-availablep))
20
21
22
23 (defun DCTL-init ()
24 (setq idel-lines-availablep nil
25 idel-chars-availablep nil
26 screenheight 24.
27 screenlinelen 79.
28 tty-type 'fox)
29 (setq X -1 Y -1)
30 (DCTL-position-cursor 0 0)
31 (DCTL-clear-rest-of-screen))
32
33
34
35 (defun DCTL-position-cursor (x y)
36 (cond ((and (= x X) (= y Y))
37 nil)
38 ((and (= x 0) (= y 0))
39 (Rtyo 33) (Rprinc "H")
40 (setq X 0 Y 0))
41 (t (or (= x X)
42 (cond ((= x 0)
43 (Rtyo 15))
44 ((< (abs (- x X)) 2)
45 (cond ((< X x)
46 (do ex X (1+ ex) (= ex x)
47 (Rtyo 33) (Rprinc "C")))
48 ((< x X)
49 (do ex x (1+ ex) (= ex X) (Rtyo 010)))))
50 (t (Rtyo 33) (Rprinc "Y") (Rtyo (+ 40 x)))))
51 (or (= y Y)
52 (cond ((= y (1+ Y))
53 (Rtyo 12))
54 ((< (abs (- y Y)) 2)
55 (cond ((< Y y)
56 (do wy Y (1+ wy) (= wy y)
57 (Rtyo 33) (Rprinc "B")))
58 ((< y Y)
59 (do wy y (1+ wy) (= wy Y)
60 (Rtyo 33) (Rprinc "A")))))
61 (t (Rtyo 33) (Rprinc "X") (Rtyo (+ 40 y)))))
62 (setq X x Y y))))
63
64
65
66 (defun DCTL-display-char-string (string)
67 (setq X (+ X (stringlength string)))
68 (Rprinc string))
69
70
71
72 (defun DCTL-clear-rest-of-screen ()
73 (Rtyo 33) (Rprinc "J"))
74
75
76
77 (defun DCTL-kill-line ()
78 (Rtyo 33) (Rprinc "I"))
79
80
81