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 'teleray1061
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") (DCTL-pad 90.))
60
61
62
63 (defun DCTL-kill-line ()
64 (Rtyo 33) (Rprinc "K"))
65
66
67
68 (defun DCTL-insert-char-string (str)
69 (do i (stringlength str) (1- i) (= i 0)
70 (Rtyo 33) (Rprinc "P"))
71 (Rprinc str)
72 (setq X (+ X (stringlength str))))
73
74
75
76 (defun DCTL-delete-chars (n)
77 (do i 1 (1+ i) (> i n)
78 (Rtyo 33) (Rprinc "Q")))
79
80
81
82 (defun DCTL-insert-lines (n)
83 (do i 1 (1+ i) (> i n)
84 (Rtyo 33) (Rprinc "L") (DCTL-pad 60.))
85 (setq X 0))
86
87
88
89 (defun DCTL-delete-lines (n)
90 (do i 1 (1+ i) (> i n)
91 (Rtyo 33) (Rprinc "M") (DCTL-pad 60.))
92 (setq X 0))
93
94
95
96 (defun DCTL-pad (n)
97 (do i (1+ (// (* n ospeed) 1000.)) (1- i) (= i 0)
98 (Rtyo 0)))