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