1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 (eval-when (compile eval) (setsyntax '/# 'macro 'sharp-macro)
17
18 (defun sharp-macro ()
19 (let ((ch (tyi)))
20 (or (= ch 57)
21 (error "Unknown # character: " (ItoC ch) 'fail-act))
22 (tyi)))
23
24 )
25
26 (declare (special X Y screenheight screenlinelen ospeed %DCTL-escape-char))
27 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
28
29
30
31 (defun DCTL-init ()
32 (setq idel-lines-availablep t idel-chars-availablep t
33 screenheight 24. screenlinelen 79.
34 tty-type 'teleray1061
35 X -777 Y -777
36 %DCTL-escape-char 33)
37 (DCTL-position-cursor 0 0)
38 (DCTL-clear-rest-of-screen))
39
40
41
42 (defun DCTL-position-cursor (x y)
43 (cond ((and (= x X) (= y Y))
44 nil)
45 ((and (= x 0) (= y 0))
46 (Rtyo %DCTL-escape-char) (Rtyo #/H)
47 (setq X 0 Y 0))
48 (t
49 (cond ((= x (1- X)) (Rtyo 10))
50 ((= (1+ x) (1- X)) (Rtyo 10) (Rtyo 10))
51 ((= X (1- x)) (Rtyo %DCTL-escape-char) (Rtyo #/C))
52 (t (Rtyo %DCTL-escape-char) (Rtyo #/Y) (Rtyo y)))
53 (cond ((= y (1- Y)) (Rtyo %DCTL-escape-char) (Rtyo #/A))
54 ((= Y (1- y)) (Rtyo %DCTL-escape-char) (Rtyo #/B))
55 (t (Rtyo %DCTL-escape-char) (Rtyo #/X) (Rtyo y)))
56 (setq X x Y x))))
57
58
59
60 (defun DCTL-display-char-string (string)
61 (setq X (+ X (stringlength string)))
62 (Rprinc string))
63
64
65
66 (defun DCTL-clear-rest-of-screen ()
67 (Rtyo %DCTL-escape-char) (Rtyo #/J) (DCTL-pad 132.))
68
69
70
71 (defun DCTL-kill-line ()
72 (Rtyo %DCTL-escape-char) (Rtyo #/K) (DCTL-pad 6.))
73
74
75
76 (defun DCTL-insert-char-string (str)
77 (let ((stringlength (stringlength str)))
78 (cond ((= 0 stringlength))
79 (t
80 (do i 1 (1+ i) (= i stringlength)
81 (Rtyo %DCTL-escape-char) (Rtyo #/N) (Rprinc (substr str i 1)))
82 (setq X (+ X stringlength))))))
83
84
85
86 (defun DCTL-delete-chars (n)
87 (do i 1 (1+ i) (> i n)
88 (Rtyo %DCTL-escape-char) (Rtyo #/O)))
89
90
91
92 (defun DCTL-insert-lines (n)
93 (do i 1 (1+ i) (> i n)
94 (Rtyo %DCTL-escape-char) (Rtyo #/L))
95 (DCTL-pad (* 6. n))
96 (setq X 0))
97
98
99
100 (defun DCTL-delete-lines (n)
101 (do i 1 (1+ i) (> i n)
102 (Rtyo %DCTL-escape-char) (Rtyo #/M))
103 (DCTL-pad (* 6. n))
104 (setq X 0))
105
106
107
108 (defun DCTL-pad (n)
109 (do i (1+ (// (* n ospeed) 1000.)) (1- i) (= i 0)
110 (Rtyo 0)))