;;; -*- Fonts:CPTFONT,TR12I; Mode: LISP; Package: SERIAL; Base: 8. -*- 

;1;;This file contains methods, etc. specific to the H19 terminal type.*
;1;; It does not support the ANSI mode features.*
;1;; It does support making the display window any desired size.*
;1;;The basic serial terminal stuff is in SERIAL; TERMINAL.LISP.*

(defflavor h19 () (basic-serial-terminal)
  :initable-instance-variables)

(defmethod (h19 :after :init) (ignore)		;1We don't need the init-plist.*
  (setq current-terminal-flavor 'h19))

(defvar bad-escapes nil)

(DEFMETHOD (H19 :ESCAPE-DISPATCH) ()
  (LET* ((KEYSTROKE (SEND SELF ':GET-CHAR))
	 (METHOD (GETHASH KEYSTROKE ESCAPE-DISPATCH-TABLE)))
    (IF METHOD (SEND SELF METHOD)
      (push keystroke bad-escapes))))

(def-escape h19 #/[ t :eat-temp
  (let (i1 i2 flag)
    (setq I1 (send self ':get-char))
    (setq I2 (send self ':get-char))
    (cond
      ((= i1 #/?) (setq flag t) (send self ':get-char))
      ((or (> i2 #/9) (< i2 0))
       (setq i1 (- i1 #/0)))
      (t
       (setq i1 (+ (* 10. (- i1 #/0)) (- i2 #/0)))
       (setq i2 (send self ':get-char))))
    (if (not flag)
	(selectq i2
	  (#/L
	   (dotimes (count i1)
	     (send self ':insert-line)))
	  (#/M
	   (dotimes (count i1)
	     (send self ':delete-line)))))))

(DEF-ESCAPE H19 #H NIL :HOME-CURSOR)

(DEF-ESCAPE H19 #p T :REVERSE-VIDEO
  (SETQ REVERSE-VIDEO-FLAG T))

(DEF-ESCAPE H19 #q T :NORMAL-VIDEO
  (SETQ REVERSE-VIDEO-FLAG NIL))

(DEF-ESCAPE H19 #x T :EAT-MODE
  (SEND MODEM-STREAM ':TYI))

(DEF-ESCAPE H19 #y NIL :EAT-MODE)

(DEF-ESCAPE H19 #C T :CURSOR-FORWARD
  (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
    (IF ( (CAR X-Y) 79.)
	(SEND SELF ':SET-CURSORPOS (1+ (CAR X-Y)) (CADR X-Y) ':CHARACTER))))

(DEF-ESCAPE H19 #D T :CURSOR-BACKWARDS
  (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
    (IF ( (CAR X-Y) 0)
	(SEND SELF ':SET-CURSORPOS (1- (CAR X-Y)) (CADR X-Y) ':CHARACTER))))

(DEF-ESCAPE H19 #B T :CURSOR-DOWN
  (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
    (IF ( (CADR X-Y) (- (self-character-height) 2))
	(SEND SELF ':SET-CURSORPOS (CAR X-Y) (1+ (CADR X-Y)) ':CHARACTER))))

(DEF-ESCAPE H19 #A T :CURSOR-UP
  (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
    (IF ( (CADR X-Y) 0)
	(SEND SELF ':SET-CURSORPOS (CAR X-Y) (1- (CADR X-Y)) ':CHARACTER))))

(DEF-ESCAPE H19 #I T :REVERSE-INDEX
  (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
    (IF (ZEROP (CAR X-Y))
	(PROGN
	  (SEND SELF ':SET-CURSORPOS 0 (- (self-character-height) 2) ':CHARACTER)
	  (SEND SELF ':DELETE-LINE)
	  (SEND SELF ':SET-CURSORPOS (CAR X-Y) (CADR X-Y) ':CHARACTER)
	  (SEND SELF ':INSERT-LINE))
      (SEND SELF ':CURSOR-UP))))

(DEF-ESCAPE H19 #n T :REPORT-CURSOR
    (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
      (SEND MODEM-STREAM ':TYO #ALTMODE)
      (SEND MODEM-STREAM ':TYO #Y)
      (SEND MODEM-STREAM ':TYO (+ 32. (CADR X-Y)))
      (SEND MODEM-STREAM ':TYO (+ 32. (CAR X-Y)))))

(DEF-ESCAPE H19 #J NIL :CLEAR-EOF)

(DEFVAR CURSOR-SAVE '(0 0))

(DEF-ESCAPE H19 #j T :SAVE-POS
  (SETQ CURSOR-SAVE (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))

(DEF-ESCAPE H19 #k T :RESTORE-POS
  (SEND SELF ':SET-CURSORPOS (CAR CURSOR-SAVE) (CADR CURSOR-SAVE) ':CHARACTER))

(DEF-ESCAPE H19 #Y T :SET-POS
  (LET ((Y (SEND SELF ':get-char))
	(X (SEND SELF ':get-char)))
    (SEND SELF ':SET-CURSORPOS (- X 32.) (- Y 32.) ':CHARACTER)))

(DEF-ESCAPE H19 #E NIL :CLEAR-SCREEN)

(DEF-ESCAPE H19 #b T :CLEAR-BOD
  (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
    (DOTIMES (LINE (1- (CADR X-Y)))
      (SEND SELF ':SET-CURSORPOS 0 LINE ':CHARACTER)
      (SEND SELF ':CLEAR-EOL))
    (SEND SELF ':SET-CURSORPOS 0 (CADR X-Y) ':CHARACTER)
    (DOTIMES (DUMMY (CAR X-Y))
      (SEND SELF ':CLEAR-CHAR)
      (send self ':CURSOR-FORWARD)))
  (SEND SELF ':CURSOR-BACKWARDS))

(DEF-ESCAPE H19 #l T :CLEAR-LINE
  (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
    (SEND SELF ':SET-CURSORPOS 0 (CADR X-Y) ':CHARACTER)
    (SEND SELF ':CLEAR-EOL)
    (SEND SELF ':SET-CURSORPOS (CAR X-Y) (CADR X-Y) ':CHARACTER)))

(DEF-ESCAPE H19 #o t :ERASE-BOL
  (LET ((X-Y (MULTIPLE-VALUE-LIST (SEND SELF ':READ-CURSORPOS ':CHARACTER))))
    (SEND SELF ':SET-CURSORPOS 0 (CADR X-Y) ':CHARACTER)
    (DOTIMES (DUMMY (CAR X-Y))
      (SEND SELF ':CLEAR-CHAR)
      (send self ':CURSOR-FORWARD)))
  (SEND SELF ':CURSOR-BACKWARDS))

(DEF-ESCAPE H19 #K NIL :CLEAR-EOL)
(DEF-ESCAPE H19 #L T :INSERT-ONE-LINE
  (SEND SELF ':SAVE-POS-1)
  (SEND SELF ':SET-CURSORPOS 0 (- (self-character-height) 2) ':CHARACTER)
  (SEND SELF ':DELETE-LINE)
  (SEND SELF ':RESTORE-POS-1)
  (SEND SELF ':INSERT-LINE)
  (SEND SELF ':GOTO-BEG-OF-LINE))

(DEF-ESCAPE H19 #M T :DELETE-ONE-LINE
  (SEND SELF ':DELETE-LINE)
  (SEND SELF ':SAVE-POS-1)
  (SEND SELF ':SET-CURSORPOS 0 (- (self-character-height) 2) ':CHARACTER)
  (SEND SELF ':INSERT-LINE)
  (SEND SELF ':RESTORE-POS-1)
  (SEND SELF ':GOTO-BEG-OF-LINE))

(DEF-ESCAPE H19 #N NIL :DELETE-CHAR)

(DEF-ESCAPE H19 #@ T :ENTER-INSERT-MODE
  (SETQ INSERT-FLAG T))

(DEF-ESCAPE H19 #O T :EXIT-INSERT-MODE
  (SETQ INSERT-FLAG NIL))

(compile-flavor-methods h19)