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