;;; -*- Mode:LISP; Package:SERIAL; Base:8; Fonts:(CPTFONT TR12I) -*-

;1;; This file contains all the stuff for modem-connections.*
;1;; It does not contain anything specific to particular protocols; those are in their own files.*
;1;; (Methods for the LMODEM protocol are in SERIAL; LMODEM.LISP*

(defflavor modem-connection (modem-stream (block-number 1) (eof-flag t) (carryover nil))
	   ()
  :abstract-flavor
  :initable-instance-variables)

(defvar char-timeout 5.)
(defvar receive-timeout 10.)

(defmethod (modem-connection :tyi-with-timeout) (timeout)
  (send modem-stream ':tyi-with-timeout (* timeout 60.)))

(defmethod (modem-connection :nak) (reason &rest format-args)
  (lexpr-funcall 'tv:notify nil reason format-args)
  (send modem-stream ':clear-input)
  (send modem-stream ':tyo #nak))

#|
(defmethod (modem-connection :get-file) (file modem-remote-file)
  (condition-case ()
      (with-open-file (file-stream file ':direction ':output)
	(*catch ':close-transfer
	  (send modem-stream ':string-out
		(string-append (selectq modem-transfer-type
				 (:lmodem tmodem-pathname)
				 (t lminet-pathname))
			       transfer-string modem-remote-file))
	  (send modem-stream ':tyo #Return)
	  (send self ':receive-file file-stream))
	(tv:notify nil "Transfer of file ~A complete." file))
    (sys:abort (tv:notify nil "File transfer aborted."))))

(defmethod (modem-connection :send-file) (file)
  (condition-case ()
      (with-open-file (file-stream file ':direction ':input)
	(send self ':transmit-file file-stream)
	(tv:notify nil "Transfer of file ~A complete." file))
    (sys:abort (tv:notify nil "File transfer aborted."))))
|#

(defmethod (modem-connection :receive-file) (file-stream)
  (setq block-number 1
	eof-flag t
	carryover nil)
  (when *Last-Packet-Received*
    (deallocate-resource 'SERIAL-PACKET *Last-Packet-Received*)
    (setq *Last-Packet-Received* NIL))
  (send modem-stream ':tyo #nak)
  (let ((eof
	  (*Catch ':EOF
	    (do-forever
	      (let ((packet (send self ':read-packet)))
		(when *Last-Packet-Received*
		  (dump-packet-to-file file-stream *Last-Packet-Received*)
		  (deallocate-resource 'SERIAL-PACKET *Last-Packet-Received*))
		(setq *Last-Packet-Received* packet)
		(setq block-number (logand (1+ (modem-block packet)) 377)))))))
    (if (eq eof ':SUCCESS)
	(progn
	  (when *Last-Packet-Received*
	    (dump-packet-to-file file-stream *Last-Packet-Received*
				 (find-first-fill-char *Last-Packet-Received*))
	    (deallocate-resource 'SERIAL-PACKET *Last-Packet-Received*)
	    (setq *Last-Packet-Received* NIL))
	  (*Throw ':CLOSE-TRANSFER T))
      (*Throw ':CLOSE-TRANSFER NIL))))

(defun find-first-fill-char (packet)
  (LOOP FOR index FROM 127. DOWNTO 0
	UNLESS (eq #/ (aref packet index))
	RETURN (1+ index)
	FINALLY (return 0)))

(defun dump-packet-to-file (file-stream packet &OPTIONAL (stop (modem-length packet)))
  (dotimes (count stop)
    (let ((char (translate-ascii-to-lispm (aref packet count))))
      (when char (send file-stream ':tyo char)))))


(defmethod (modem-connection :transmit-file) (file-stream)
  (send modem-stream ':CLEAR-INPUT)
  (LOOP WITH count = 0
	AS char = (send self ':TYI-WITH-TIMEOUT receive-timeout)
	WHEN (and char (= char #nak))
	RETURN T
	UNLESS char
	DO (incf count)
	WHEN (= count 10.)
	DO (ferror eh:abort-object))
  (LOOP WHILE eof-flag
	DO (*catch ':GOOD-SEND (send self ':SEND-PACKET-FROM-FILE-AND-WAIT file-stream))
	   (setq block-number (1+ block-number)))
  (unless (dotimes (foo 10.)
	    (send modem-stream ':TYO #eot)
	    (when (equal (send self ':TYI-WITH-TIMEOUT receive-timeout) #ack)
	      (return t))
	    nil)
    (ferror eh:abort-object)))

(compile-flavor-methods modem-connection)

(defun translate-ascii-to-lispm (ch)
  (selectq ch
    (#BS #\BS)
    (#TAB #\TAB)
    (#LF NIL)
    (#FF #\FF)
    (#Return #\CR)
    (#Rubout #\RUBOUT)
    (T CH)))

(defun translate-lispm-to-ascii (ch)
  (selectq ch
    (#\BS #BS)
    (#\TAB #TAB)
;    (#LF NIL)
    (#\FF #FF)
    (#\CR #Return)
    (#\RUBOUT #Rubout)
    (T CH)))

#|
(defun lispm-send-file (file stream)
  (send 
    (make-instance 'lminet-connection
		   ':modem-stream stream)
    ':send-file file))

(defun lispm-receive-file (file stream)
  (send 
    (make-instance 'lminet-connection
		   ':modem-stream stream)
    ':get-file file))
|#