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