1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 (declare (special X Y screenheight screenlinelen tty-type))
21 (declare (special idel-lines-availablep idel-chars-availablep))
22 (declare (special DCTL-prologue-availablep DCTL-epilogue-availablep DCTL-insert-mode-on))
23 (declare (*expr Rprinc Rtyo))
24
25
26
27 (defun DCTL-init ()
28 (setq idel-lines-availablep t idel-chars-availablep t)
29 (setq DCTL-prologue-availablep t DCTL-epilogue-availablep t)
30 (setq screenheight 24. screenlinelen 79.)
31 (setq tty-type 'vip7800)
32 (Rtyo 33)(Rprinc "[H")(Rtyo 33)(Rprinc "J")
33 (setq X 0 Y 0)
34 (DCTL-prologue))
35
36
37
38 (defun DCTL-prologue ()
39 (setq DCTL-insert-mode-on nil)
40 (Rtyo 33) (Rprinc "[J"))
41
42
43 (defun DCTL-epilogue ()
44 (setq DCTL-insert-mode-on nil)
45 (Rtyo 33) (Rprinc "[J"))
46
47
48
49 (defun DCTL-position-cursor (x y)
50 (cond ((and (= x X)(= y Y))
51 nil)
52 ((and (= x 0)(= y 0))
53 (Rtyo 33)(Rprinc "[H")
54 (setq X 0 Y 0))
55 ((and (< (+ (abs (- X x))(abs (- Y y))) 4))
56 (cond ((< X x)
57 (do ex X (1+ ex)(= ex x)(Rtyo 33)(Rprinc "C")))
58 ((< x X)
59 (do ex x (1+ ex)(= ex X)(Rtyo 33)(Rprinc "D"))))
60 (cond ((< Y y)
61 (do wy Y (1+ wy)(= wy y)(Rtyo 33)(Rprinc "B")))
62 ((< y Y)
63 (do wy y (1+ wy)(= wy Y)(Rtyo 33)(Rprinc "A"))))
64 (setq X x Y y))
65
66 (t (setq X x Y y)
67 (Rtyo 33)(Rprinc "f")(Rtyo (+ 40 x))(Rtyo (+ 40 y))
68 )))
69
70
71
72 (defun DCTL-display-char-string (string)
73 ((lambda (strx)
74 (cond ((= strx 0))
75 (t (cond (DCTL-insert-mode-on
76 (setq DCTL-insert-mode-on nil)
77 (Rtyo 33) (Rprinc "[J")))
78 (Rprinc string)
79 (setq X (+ X strx)))))
80 (stringlength string)))
81
82
83
84 (defun DCTL-clear-rest-of-screen ()
85 (Rtyo 33)(Rprinc "J")
86 (Rtyo 0))
87
88
89
90 (defun DCTL-kill-line ()
91 (Rtyo 33)(Rprinc "K"))
92
93
94 (defun DCTL-insert-lines (n)
95 (do i 1 (1+ i)(> i n)
96 (Rtyo 33)(Rprinc "[L")))
97
98 (defun DCTL-delete-lines (n)
99 (do i 1 (1+ i)(> i n)
100 (Rtyo 33)(Rprinc "[M")))
101
102 (defun DCTL-insert-char-string (str)
103 (cond (DCTL-insert-mode-on)
104 (t
105 (setq DCTL-insert-mode-on t)
106 (Rtyo 33) (Rprinc "[I")))
107 (Rprinc str)
108 (setq X (+ X (stringlength str))))
109
110
111 (defun DCTL-delete-chars (n)
112 (do i 0 (1+ i)(= i n)
113 (Rtyo 33)(Rprinc "[P")))
114