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