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

;1;; This file contains the LMI display terminal simulator.*
;1;; Terminal-type specific code is not here anymore; it lives in its own file now.*
;1;; (Code specific to the Heath-Zenith H19 simulator is in SERIAL;H19.LISP)*

(defvar site-list
	'(("OZ" ("OZ" "2588260" 1200.))
	  ("CCC" ("CCC" "2588864" 1200.))
	  ("MC" ("MC" "2536985" 1200.))
	  ("MIT-TAC" ("MIT-TAC" "4940155" 1200.))
	  ("Multics" ("Multics" "2588313" 1200.))))

(defvar *H19-window* NIL)

(defvar tmodem-pathname "res tmodem
PS:<ALR>TMODEM.EXE"
  
  "Command line to send to the foreign host to initiate LMODEM file transfer.")
(defvar lminet-pathname "TINMAN:<JSOL>TMODEM.EXE"
  "Command line to send to the foreign host to initiate LMINET file transfer.")
(defvar current-terminal-flavor nil
  "The flavor of the most recently created terminal window.")
(defvar default-terminal-flavor 'h19 "The flavor of terminal window to create by default.")
(defvar terminal-instance-number 0 "The number of terminal windows created.")
(defvar latest-terminal-window nil "The most recently created terminal window.")

(defvar terminal-choose-variable-margin-choices
	'("Do it" ("Abort" (ferror eh:abort-object))))

(defsubst self-character-height ()
  (multiple-value-bind (ignore height)
      (send self ':size-in-characters)
    height))

(defsubst self-character-width ()
  (multiple-value-bind (width ignore)
      (send self ':size-in-characters)
    width))

(defmacro def-escape (terminal-type key-number define-p method-name &body body)
  (if define-p
      `(progn 'compile
	      (puthash ,key-number ',method-name escape-dispatch-table)
	      (defmethod (,terminal-type ,method-name) ()
		. ,body))
    `(puthash ,key-number ',method-name escape-dispatch-table)))

(defflavor basic-serial-terminal ((modem-stream nil)
				  (modem-process nil)
				  (reverse-video-flag nil)
				  (go-now nil)
				  (insert-flag nil)
				  (modem-lock nil)
				  (connection-name nil)
				  (baud 1200.)
				  (use-bit-7-for-meta nil)
				  instance-number
				  program-string
				  (modem-file-connection NIL))
	   (tv:notification-mixin tv:process-mixin tv:truncating-window)
  :abstract-flavor
  (:gettable-instance-variables modem-lock)
  :initable-instance-variables
  (:default-init-plist :instance-number (incf terminal-instance-number)
		       :font-map '(fonts:cptfont fonts:cptfontb)
		       :char-aluf tv:alu-xor
		       :deexposed-typeout-action ':permit
		       :save-bits t
		       :process '(terminal-process)))

(defmethod (basic-serial-terminal :update-connection-name) (name)
  (setq connection-name name)
  (send self ':update-label))

(defmethod (basic-serial-terminal :update-label) ()
  (let* ((width (self-character-width))
	 (connected-string (format nil "~:[Not connected~;Connected to ~A~]"
				   connection-name connection-name))
	 (full-label (format nil "~V,,,<~A~;~A~>" width program-string connected-string)))
    (send self ':set-label
	  (if (> (+ (string-length connected-string) (string-length program-string) 4) width)
	      (format nil "~V,,,<~A~>" width connected-string)
	    full-label))))

(defmethod (basic-serial-terminal :AFTER :INIT) (ignore)	;1We don't need the init-plist here.*
  (setq modem-process (make-process (format nil "Terminal Modem Process ~D" instance-number)))
  (setq program-string (format nil "LMI serial terminal simulator ~D" instance-number))
  (send self ':set-baud baud)
  (send modem-process ':preset 'terminal-1 self)
  (process-enable modem-process)
  (send self ':update-label)
  (setq modem-file-connection (make-instance 'LMODEM-CONNECTION ':MODEM-STREAM modem-stream)))

(defmethod (basic-serial-terminal :AFTER :SELECT)(&REST ignore)
  (setq *H19-window* self))

(defmethod (basic-serial-terminal :after :change-of-size-or-margins) (&rest ignore)
  (send self ':update-label))

(defmethod (basic-serial-terminal :after :change-of-default-font) (&rest ignore)
  (send self ':update-label))

(defmethod (basic-serial-terminal :end-of-page-exception) ()
  (send self ':home-cursor)
  (send self ':delete-line)
  (send self ':set-cursorpos 0 (- (self-character-height) 2) ':character))

(defmethod (basic-serial-terminal :kill-process) ()
  (send (send self ':process) ':reset nil t)
  (send modem-process ':reset nil t))

(defmethod (basic-serial-terminal :EAT-UNTIL-READY) ()
  (do ((string (return-string-from-modem modem-stream)
	       (return-string-from-modem modem-stream)))
      ((and
	 (> (string-length string) 18.)
	 (string-equal "TMODEM:  Ready to " (substring string 0 18.))))
    (tv:notify self "~A~%" string)))

(defmethod (basic-serial-terminal :read-char-from-keyboard-to-modem) ()
  (let ((key-stroke (send self ':tyi)))
    (setq latest-terminal-window self)
    (when (memq (ldb %%kbd-char key-stroke) '(#\Rubout #\Delete))
      (setq key-stroke (dpb 177 %%kbd-char key-stroke)))
    (selectq key-stroke
      (#\Ctrl-Clear-INPUT (setq reverse-video-flag NIL))
      (#\Hyper-Ctrl-Y (com-yank-from-editor))
      (#\hold-output (send modem-stream ':tyo #Control-S))
      (#\stop-output (send modem-stream ':tyo #Control-O))
      (#\resume (send modem-stream ':tyo #Control-Q))
      (#\hand-up (send modem-stream ':tyo #Altmode)
		 (send modem-stream ':tyo #A))
      (#\hand-down (send modem-stream ':tyo #Altmode)
		   (send modem-stream ':tyo #B))
      (#\hand-right (send modem-stream ':tyo #Altmode)
		    (send modem-stream ':tyo #C))
      (#\hand-left (send modem-stream ':tyo #Altmode)
		   (send modem-stream ':tyo #D))
      (#\network (network-keystroke-handler))
      (#\call (send modem-stream ':tyo #Control-Z))
      (#\help (send modem-stream ':tyo #Control-_))
      (t (let ((char (ldb %%kbd-char key-stroke))
	       (control (ldb %%kbd-control key-stroke))
	       (meta (ldb %%kbd-meta key-stroke)))
	   (if (and (= 1 meta)(= 1 control))
	       (progn ;; send a ctrl-z first and then the character without
		 ;; the control bits.
		 (send modem-stream ':TYO #/) ;;  is a ctrl-Z
		 (send modem-stream ':TYO (logand char 137)))
	     (when (= control 1) (setq char (logand char 37)))
	     (unless (zerop meta)
	       (if use-bit-7-for-meta
		   (setq char (logior 200 (logand char 177)))
		 (send modem-stream ':tyo #Altmode)
		 (setq char (logior char 40))))
	     (send modem-stream ':tyo char)))))))

(DEFUN COM-YANK-FROM-EDITOR ()
  (declare (:self-flavor basic-serial-terminal))
"Re-insert the last stuff killed.
Leaves point and mark around what is inserted.  A numeric argument means use the
n'th most recent kill from the ring."
  (OR ZWEI:*KILL-RING* (BARF))
  (do ((line (zwei:BP-LINE (zwei:INTERVAL-FIRST-BP (first zwei:*kill-Ring*)))
	     (zwei:LINE-NEXT LINE)))
      ((NULL LINE))
    (let ((string-to-send (format NIL "~A" line)))
      (LOOP WITH length = (string-length string-to-send)
	    FOR index FROM 0 BELOW length
	    AS char = (aref string-to-send index)
	    WHEN (= char #\TAB)
	    DO (send modem-stream ':TYO #/)
	    (send modem-stream ':TYO #TAB)
	    ELSE
	    DO (send modem-stream ':TYO char)))
    (and (zwei:LINE-NEXT line) (send modem-stream ':TYO #\CR))))

(defun network-keystroke-handler ()
  (declare (:self-flavor basic-serial-terminal))
  (let ((key-stroke (char-upcase (send self ':tyi))))
    (selectq key-stroke
      (#\clear-screen (send self ':clear-screen))
      (#\help (terminal-help))
      (#\space nil)
      (#/$ (setq go-now t))
      (#/D (send modem-stream ':eval-inside-yourself
		 '(si:serial-write-command (logand 7775 si:uart-command)))
	   (send modem-stream ':eval-inside-yourself
		 '(si:serial-write-command (logior 2 si:uart-command)))
	   (let ((site-info (tv:menu-choose site-list "Dial site:")))
	     (when site-info (dial-site-1 site-info))))
      (#/T (terminal-start-file-transfer))
      (#/K (send modem-stream ':eval-inside-yourself
		 '(si:serial-write-command (logand 7775 si:uart-command)))
	   (send self ':update-connection-name nil)
	   (send self ':bury)
	   (send self ':kill))
      (#/Q (send modem-stream ':eval-inside-yourself
		 '(si:serial-write-command (logand 75 si:uart-command)))
	   (send self ':update-connection-name nil)
	   (process-sleep 60.)
	   (send modem-stream ':eval-inside-yourself
		 '(si:serial-write-command (logior 2 si:uart-command))))
      (#/B (setq modem-stream
		 (send self ':set-baud
		   (tv:menu-choose '(("1200" 1200.) ("300" 300.) ("110" 110.))
				   "Baud rate:")))
	   (send self ':update-connection-name nil))
      (#/S (condition-case ()
	       (let (width height meta (base 10.) (ibase 10.) old-width old-height)
		 (declare (special width height meta))
		 (setq meta use-bit-7-for-meta)
		 (multiple-value (width height)
		   (send self ':size-in-characters))
		 (setq old-width width
		       old-height height)
		 (tv:choose-variable-values
		   '((width "Characters per line" :number)
		     (height "Lines on screen" :number)
		     (meta "Use bit 7 for Meta" :boolean))
		   ':label "Terminal simulator setup:"
		   ':margin-choices terminal-choose-variable-margin-choices)
		 (when (or ( height old-height)
			   ( width old-width))
		   (send self ':set-size-in-characters width height))
		 (send self ':update-connection-name connection-name)
		 (setq use-bit-7-for-meta meta))
	     (sys:abort nil)))
      (#/R (send modem-stream ':reset))
      (#/V (view-directory))
      (t (send self ':beep)))))

(defmethod (basic-serial-terminal :set-baud) (new-baud)
  (setq modem-stream (si:make-serial-stream ':number-of-stop-bits 1
					    ':number-of-data-bits 8
					    ':parity nil
					    ':ascii-characters nil
					    ':baud new-baud))
  (when modem-file-connection
    (set-in-instance modem-file-connection 'modem-stream modem-stream)))
 
(defun terminal-help ()
  (si:with-help-stream (help-stream :superior self)
    (format help-stream "
This is the LMI serial terminal simulator.

To access special functions, type NETWORK followed by one of the following:

B     Change baud rate (disconnects)
D     Auto dial number
K     Quit and kill window
Q     Toggle Data Terminal Ready (disconnect)
S     Set up terminal parameters
T     LMODEM file transfer program
Space cancel
Help  type this

The hand keys send H19 arrow key sequences. 

Current settings:
")
    (let ((standard-output help-stream))
      (si:serial-status))))

(defun terminal-start-file-transfer ()
  (declare (:self-flavor basic-serial-terminal))
  (unwind-protect
    (condition-case ()
	(terminal-start-file-transfer-1)
      (sys:abort nil))
    (setq modem-lock nil)))

(defvar modem-local-file "")
(defvar modem-remote-file "")
(defvar modem-direction ':RECEIVE)
(defvar modem-transfer-type ':LMINET)
(defvar transfer-string " -st ")

(defun terminal-start-file-transfer-1 ()
  (declare (:self-flavor basic-serial-terminal))
  (tv:choose-variable-values
    '((modem-local-file "Local file" :string)
      (modem-direction "Direction of transfer"
		 :choose (:receive :send))
      (modem-remote-file "Remote file" :string)
      (modem-transfer-type "Type of transfer" :choose (:lmodem :lminet :call-unix)))
    ':label "File transfer parameters:"
    ':margin-choices terminal-choose-variable-margin-choices)
    (unwind-protect
	(let ((transfer-flavor
		(selectq modem-transfer-type
		  (:lmodem 'lmodem-connection)
		  (:call-unix 'cu-connection)
		  (t 'lminet-connection))))
	  (unless (typep modem-file-connection transfer-flavor)
	    (setq modem-file-connection
		  (make-instance transfer-flavor ':MODEM-STREAM modem-stream)))
	  (setq modem-lock t)
	  (send modem-file-connection
		(selectq modem-direction (:receive ':get-file) (t ':send-file))
		modem-local-file modem-remote-file))
      (setq modem-lock nil)))

(defun terminal-process (window)
  (let ((trace-output window)
	(error-output window)
	(standard-output window)
	(query-io window)
	(terminal-io window))
    (do-forever (send window ':read-char-from-keyboard-to-modem))))

(defun terminal-1 (window)
  (do-forever (send window ':read-char-from-modem-to-keyboard)))

(defun terminal (&key &optional (type default-terminal-flavor) baud height width (expose-p t))
  (let ((window (cond ((typep tv:selected-window current-terminal-flavor) tv:selected-window)
		      ((tv:find-window-of-flavor current-terminal-flavor))
		      ((tv:find-window-of-flavor default-terminal-flavor))
		      (t (tv:make-window (cond (type)
					       (t default-terminal-flavor)))))))
    (when baud (send window ':set-baud baud))
    (when height (send window ':set-height height))
    (when width (send window ':set-width width))
    (cond
      (expose-p
       (send window ':expose)
       (send window ':select)))
    window))

(defvar *keystroke-dispatch*
	'(:null-key				;C-@
	   :null-key				;C-A
	   :null-key				;C-B
	   :null-key				;C-C
	   :null-key				;C-D
	   :null-key				;C-E
	   :null-key				;C-F
	   :beep				;C-G
	   :back-space				;C-H
	   :tab-me				;C-I
	   :line-feed				;C-J
	   :null-key				;C-K
	   :null-key				;C-L
	   :cr-me))				;C-M

(defmethod (basic-serial-terminal :read-char-from-modem-to-keyboard) (&aux (fudge self))
  (process-wait "Waiting to TYI" #'(lambda (x) (not (send x ':modem-lock))) fudge)
  (let ((keystroke (send modem-stream ':tyi-with-timeout 60.)))
    (when keystroke
      (setq keystroke (logand keystroke 177))
      (if (= keystroke #Altmode)
	  (send self ':escape-dispatch)
	(when (< 31 keystroke 200)
	  (when insert-flag (send self ':insert-char))
	  (let ((store (send self ':erase-aluf)))
	    (send self ':set-erase-aluf (if reverse-video-flag tv:alu-ior tv:alu-andca))
	    (send self ':clear-char)
	    (send self ':set-erase-aluf store))
	  (when (> (send self ':read-cursorpos ':character) (self-character-width))
	    (send self ':cr-me))
	  (send self ':tyo keystroke))
	(when (< keystroke 16) (send self (nth keystroke *keystroke-dispatch*)))))))

(defmethod (basic-serial-terminal :before :kill) ()
  (send self ':kill-process))

(defvar escape-dispatch-table (make-hash-table))

(defmethod (basic-serial-terminal :get-char) ()
    (logand (send modem-stream ':tyi) 177))

(defmethod (basic-serial-terminal :goto-beg-of-line) ()
  (let ((x-y (multiple-value-list (send self ':read-cursorpos ':character))))
    (send self ':set-cursorpos 0 (cadr x-y) ':character)))

(defvar system-position '(0 0))

(defmethod (basic-serial-terminal :save-pos-1) ()
  (setq system-position (multiple-value-list (send self ':read-cursorpos ':character))))

(defmethod (basic-serial-terminal :restore-pos-1) ()
  (send self ':set-cursorpos (car system-position) (cadr system-position) ':character))

(defmethod (basic-serial-terminal :null-key) ())

(defmethod (basic-serial-terminal :back-space) ()
  (send self ':tyo #\Backspace))

(defmethod (basic-serial-terminal :tab-me) ()
  (send self ':tyo #\Tab))

(defmethod (basic-serial-terminal :cr-me) ()
  (send self ':set-cursorpos
	     0 
	     (cadr (multiple-value-list (send self ':read-cursorpos ':character)))
	     ':character))

(defmethod (basic-serial-terminal :line-feed) ()
  (multiple-value-bind (col row) (send self ':read-cursorpos ':character)
    (if (= row (- (self-character-height) 2))
	(send self ':end-of-page-exception)
      (send self ':set-cursorpos col (1+ row) ':character))))

(defmethod (basic-serial-terminal :beep) ()
  (hacks:with-real-time
    (si:%beep 500 50000)))

(defun string-wait (string stream times)
  (dotimes (dummy times)
    (if (string-equal (return-string-from-modem stream) string) (return t) nil)))


(defun dial-site (site-spec &optional (baud 1200.))
  (if (numberp site-spec)
      (let ((number-string (format nil "~D" site-spec))
	    (window (terminal ':baud baud)))
	(send window ':dial-site number-string number-string)
	(send window ':expose) window)
    (let ((site-info (cdr (assoc site-spec site-list))))
      (if site-info (dial-site-1 site-info)
	(format t "~&Site ~A does not exist." site-spec)))))

(defun dial-site-1 (site-info)
  (let* ((site-name (first site-info))
	 (site-number (second site-info))
	 (baud (third site-info))
	 (window (terminal ':baud baud)))
    (send window ':dial-site site-name site-number)
    (send window ':expose) window))

(defmethod (basic-serial-terminal :dial-site) (name number &optional keep-locked &aux return)
  (setq modem-lock t)
  (dotimes (dummy 5)
    (send modem-stream ':tyo #I)
    (send modem-stream ':tyo #Return))
  (send modem-stream ':clear-input)
  (process-sleep 60.)
  (send modem-stream ':tyo #Control-E)
  (send modem-stream ':tyo #Return)
  (if (not (string-equal (return-string-from-modem modem-stream) "HELLO: I'M READY"))
      (tv:notify self "Modem not responding")
    (send modem-stream ':tyo #D)
    (send modem-stream ':tyo #Return)
    (if (not (string-equal (return-string-from-modem modem-stream) "*NUMBER?"))
	(tv:notify self "Modem in strange state")
      (send modem-stream ':string-out number)
      (send modem-stream ':tyo #Return)
      (if (not (string-equal (return-string-from-modem modem-stream) number))
	  (tv:notify self "Number returned not equal to number sent.  Hit rubouts")
	(send modem-stream ':tyo #Return)
	(if (not (string-equal (return-string-from-modem modem-stream)
			       "DIALING:  ON LINE"))
	    (tv:notify self "Number busy or not answering")
	  (tv:notify self "On Line")
	  (send self ':update-connection-name name)
	  (setq return t)))))
  (setq modem-lock keep-locked)
  return)

(defun return-string-from-modem (stream &optional (echo-p nil))
  (loop with string = (make-array 16. ':type art-string ':fill-pointer 0)
	for char1 = (send stream ':tyi-with-timeout 3000.)
	unless char1 do (return "")		;Foolish modem timed out.
	for char = (logand char1 177)
	when echo-p do (send stream ':tyo char)
	until (= char #Linefeed)
	when ( char #Return) do (if ( char 0) (array-push-extend string char))
	finally	(return string)))

(defun add-phone-site (site number baud)
  (push (list site number baud) site-list))

(defun transmit-files (file-list direction)
  (send latest-terminal-window ':transmit-files file-list direction))

(defmethod (basic-serial-terminal :transmit-files) (file-list direction)
  (unwind-protect
    (progn (setq modem-lock t)
	   (dolist (remote-and-local file-list)
	     (let ((remote-file (car remote-and-local))
		   (file (cadr remote-and-local)))
	       (if (equal direction ':receive)
		   (format modem-stream
			   "TMODEM -ST ~A" remote-file)
		 (format modem-stream "TMODEM -RT ~A" remote-file))
	       (send modem-stream ':tyo #Return)
	       (send self ':eat-until-ready)
	       (if (equal direction ':receive)
		   (send (make-instance 'lmodem-connection
					':modem-stream modem-stream)
			 ':get-file file)
		 (send (make-instance 'lmodem-connection
				      ':modem-stream modem-stream)
		       ':send-file file)))))
    (setq modem-lock nil)))

(tv:add-system-key #/H
		   '(cond (current-terminal-flavor) (t default-terminal-flavor))
		   "LMI serial terminal simulator")

(compile-flavor-methods basic-serial-terminal)