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 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep))
20
21
22
23 (defun DCTL-init ()
24 (setq idel-lines-availablep t idel-chars-availablep nil)
25 (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
26 (setq screenheight 24. screenlinelen 79.)
27 (setq tty-type 'haz1510)
28 (Rtyo 33)(Rtyo 34)
29 (setq X 0 Y 0)
30 (DCTL-prologue))
31
32
33
34 (defun DCTL-prologue ()
35 (Rtyo 33) (Rtyo 34))
36
37
38 (defun DCTL-epilogue ()
39 (Rtyo 33) (Rtyo 34))
40
41
42
43 (defun DCTL-position-cursor (x y)
44 (cond ((and (= x X)(= y Y))
45 nil)
46 ((and (= x 0)(= y 0))
47 (Rtyo 33)(Rtyo 22)
48 (setq X 0 Y 0))
49 ((and (< (+ (abs (- X x))(abs (- Y y))) 3))
50 (cond ((< X x)
51 (do ex X (1+ ex)(= ex x)(Rtyo 20)))
52 ((< x X)
53 (do ex x (1+ ex)(= ex X)(Rtyo 10))))
54 (cond ((< Y y)
55 (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rtyo 13)))
56 ((< y Y)
57 (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rtyo 14))))
58 (setq X x Y y))
59
60 (t (setq X x Y y)
61 (Rtyo 33)(Rtyo 21)(Rtyo x)(Rtyo y)
62 )))
63
64
65
66 (defun DCTL-display-char-string (string)
67 ((lambda (strx)
68 (cond ((= strx 0))
69 (t (Rprinc string)
70 (setq X (+ X strx)))))
71 (stringlength string)))
72
73
74
75 (defun DCTL-clear-rest-of-screen ()
76 (Rtyo 33)(Rtyo 30))
77
78
79
80 (defun DCTL-kill-line ()
81 (Rtyo 33)(Rtyo 17))
82
83
84 (defun DCTL-insert-lines (n)
85 (do i 1 (1+ i)(> i n)
86 (Rtyo 33)(Rtyo 32)))
87
88 (defun DCTL-delete-lines (n)
89 (do i 1 (1+ i)(> i n)
90 (Rtyo 33)(Rtyo 23)))