1 ;;; ***********************************************************
 2 ;;; *                                                         *
 3 ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 4 ;;; *                                                         *
 5 ;;; * Copyright (c) 1978 by Massachusetts Institute of        *
 6 ;;; * Technology and Honeywell Information Systems, Inc.      *
 7 ;;; *                                                         *
 8 ;;; ***********************************************************
 9 ;;;
10 ;;;
11 ;;;       Synertek KTM2 control package
12 ;;;
13 ;;;       JRD 9 Sept 79 from vt52ctl, debugged by BSG
14 ;;;       BSG 3/21/78 from DD4000ctl
15 ;;;
16 
17 
18 (declare (special X Y screenheight screenlinelen))
19 (declare (special idel-lines-availablep idel-chars-availablep tty-type))
20 
21 
22 ; Initialize terminal and terminal control package.
23 (defun DCTL-init ()
24        (setq idel-lines-availablep nil idel-chars-availablep nil)
25        (setq screenheight 24. screenlinelen 79.)
26        (setq tty-type 'ktm2)
27        (Rtyo 33)(Rprinc "E")(Rtyo 177)(Rtyo 177)
28        (setq X 0 Y 0))
29 
30 
31                                                   ; Move terminal's cursor to desired position.
32 (defun DCTL-position-cursor (x y)
33        (cond ((and (= x X)(= y Y))
34               nil)
35              ((and (= x 0)(= y 0))
36               (Rtyo 33)(Rprinc "H")
37               (setq X 0 Y 0))
38              (t
39                (let ((cost-of-rel (+ (abs (- x X))(abs (- y Y))))
40                      (cost-of-left (+ 1 x (abs (- y Y))))
41                      (cost-of-abs 4))
42                     (cond
43                       ((and (< cost-of-rel cost-of-left)
44                             (< cost-of-rel cost-of-abs))
45                        (cond
46                          ((> X x) (do i X (1- i) (= i x)(Rtyo 10)))
47                          ((> x X) (do i X (1+ i) (= i x)(Rtyo 11))))
48                        (cond
49                          ((> Y y) (do i Y (1- i) (= i y)(Rtyo 13)))
50                          ((> y Y) (do i Y (1+ i) (= i y)(Rtyo 12)))))
51                       ((and (< cost-of-left cost-of-abs)(not (= X 0)))
52                        (Rtyo 15) (setq X 0)
53                        (DCTL-position-cursor x y))
54                       (t (Rtyo 33)(Rprinc "=") (Rtyo (+ 40 y))(Rtyo (+ 40 x)))))
55                (setq X x Y y))))
56 
57 ; Output string.
58 (defun DCTL-display-char-string (string)
59        (setq X (+ X (stringlength string)))
60        (Rprinc string))
61 
62 
63 ; Clear to end of screen.
64 (defun DCTL-clear-rest-of-screen ()
65        (Rtyo 33)(Rprinc "J")(Rtyo 177))
66 
67 
68 ; Clear to end of line.
69 (defun DCTL-kill-line ()
70        (Rtyo 33)(Rprinc "K"))
71 
72 
73