1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 (declare (special X Y screenheight idel-lines-availablep idel-chars-availablep screenlinelen tty-type tty-no-upmotionp tty-no-cleolp))
17 (declare (array* (notype (newscreen ?))))
18
19 (defun DCTL-init ()
20 (setq X -777 Y -777)
21 (setq tty-type 'teleray)
22 (setq screenheight 24. screenlinelen 79.)
23 (setq idel-chars-availablep nil idel-lines-availablep nil tty-no-upmotionp t tty-no-cleolp t))
24
25 (defun DCTL-position-cursor (x y)
26 (prog ()
27 (and (= x X)(= y Y)(return nil))
28 (and (< X 0)(DCTL-crlf))
29 (and (= y Y)
30 (progn
31 (cond ((and (= x 0)(> X 4))(DCTL-cret))
32 ((< X x)(DCTL-display-char-string
33 (substr (or (cadr (newscreen Y)) " ") (1+ X) (- x X))))
34 ((< (- X x) x) (do xx X (1- xx)(= xx x)(Rtyo 10)))
35 (t (DCTL-cret)
36 (DCTL-position-cursor x Y)))
37 (setq X x)
38 (return nil)))
39
40
41
42 (DCTL-nextline)
43 (setq Y y)
44 (DCTL-position-cursor x y)))
45
46 (defun DCTL-assert-scpos (x y)
47 (and x (setq X x))
48 (and y (setq Y y)))
49
50 (defun DCTL-clear-rest-of-screen ())
51
52 (defun DCTL-nextline ()(Rtyo 12))
53
54 (defun DCTL-display-char-string (s)
55 (Rprinc s)
56 (setq X (+ X (stringlength s))))
57
58 (defun DCTL-cret ()
59 (Rtyo 15)(setq X 0))
60
61 (defun DCTL-crlf ()
62 (Rtyo 15)(Rtyo 12)(setq X 0))