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

;1;; This file contains all stuff specific to the LMInet (LModem with count) protocol.*



(defflavor lminet-connection ()
	   (modem-connection)
  :initable-instance-variables)

(defmethod (lminet-connection :read-packet) ()
  (or
    (dotimes (count 10)				;Master recount
      (*catch ':master-retry
	(let ((soh-maybe))
	  (loop with time = (time:get-universal-time)
		for current-time = (time:get-universal-time)
		until (or (> (- current-time time) receive-timeout)
			  (memq soh-maybe '(#soh #can #eot)))
		do (setq soh-maybe (send self ':tyi-with-timeout receive-timeout))
		WHEN soh-maybe DO (format latest-terminal-window "~:C " soh-maybe))
	  (unless (equal soh-maybe #soh)
	    (send self ':nak "Bad Char for SOH, ~A~%" soh-maybe))
	  (when (equal soh-maybe #can)
	    (tv:notify nil "CAN received]%")
	    (ferror eh:abort-object))
	  (when (equal soh-maybe #eot)
	    (send modem-stream ':tyo #ack)
	    (*throw ':close-transfer t))
	  (cond
	    ((not soh-maybe) nil)
	    (t (let (block not-block length not-length
		     (data (make-array 128. ':type art-string ':fill-pointer 0))
		     cksum temp (real-check 0))
		 (unless (setq block (send self ':tyi-with-timeout char-timeout))
		   (send self ':nak "Timeout on BLOCK")
		   (*throw ':master-retry nil))
		 (unless (setq not-block (send self ':tyi-with-timeout char-timeout))
		   (send self ':nak "Timeout on NOT-BLOCK")
		   (*throw ':master-retry nil))
		 (unless (setq length (send self ':tyi-with-timeout char-timeout))
		   (send self ':nak "Timeout on LENGTH")
		   (*throw ':master-retry nil))
		 (unless (setq not-length (send self ':tyi-with-timeout char-timeout))
		   (send self ':nak "Timeout on NOT-LENGTH")
		   (*throw ':master-retry nil))
		 (dotimes (count1 128.)
		   (unless (setq temp (send self ':tyi-with-timeout char-timeout))
		     (send self ':nak "Character timeout on character ~A" count1)
		     (*throw ':master-retry nil))
		   (array-push data temp)
		   (setq real-check (+ temp real-check)))
		 (setq real-check (logand real-check 377))
		 (unless (setq cksum (send self ':tyi-with-timeout char-timeout))
		   (send self ':nak "Timeout on checksum")
		   (*throw ':master-retry nil))
		 (cond ((and (equal not-block (- 255. block))
			     (equal not-length (- 255. length))
			     (or (equal block block-number)
				 (equal block (1- block-number)))
			     (equal cksum real-check))
			(return (make-modem-packet block block length length data data)))
		       (t (send self ':nak
				"Check ~A, Real Check ~A, Block ~A, RB ~A L ~A, RL ~A ~%~A"
				cksum real-check block block-number length not-length data)
			  nil))))))))
    (progn
      (send modem-stream ':tyo #can)
;      (tv:notify nil "Ten time timeout~%")
      (ferror eh:abort-object))))

(defmethod (lminet-connection :send-packet-from-file-and-wait) (file-stream)
  (let ((file-string (make-array 128. ':type art-string))
	(check 0) (length 0))
    (dotimes (count 128.)
      (cond (carryover
	     (aset carryover file-string count)
	     (setq check (+ check carryover)
		   carryover nil))
	    (t (cond ((not eof-flag)
		      (aset #Control-Z file-string count)
		      (setq check (+ check #Control-Z)))
		     (t (let* ((char (send file-stream ':tyi))
			       (char1 (and char (fs:lispm-to-ascii char))))
			  (when (equal char #\Return)
			    (setq char1 #Return)
			    (setq carryover #Linefeed))
			  (when char1
			    (setq check (+ check char1))
			    (aset char1 file-string count))
			  (unless char
			    (setq length count)
			    (setq eof-flag nil)
			    (setq check (+ check #Control-Z))
			    (aset #Control-Z file-string count))))))))
    (dotimes (count 10.)
      (send modem-stream ':tyo #Control-A)
      (send modem-stream ':tyo (logand block-number 377))
      (send modem-stream ':tyo (logxor 377 (logand block-number 377)))
      (send modem-stream ':tyo (logand length 377))
      (send modem-stream ':tyo (logand (- 256. length) 377))
      (send modem-stream ':string-out file-string)
      (send modem-stream ':clear-input)
      (send modem-stream ':tyo (logand 377 check))
      (let ((char (send self ':tyi-with-timeout receive-timeout)))
	(cond ((and char (= char #ack))
	       (*throw ':good-send t))
	      (t (when (equal char #can) (ferror eh:abort-object))
		 (send self ':nak
		       "Check ~A,Block ~A, RB ~A L ~A, RL ~A ~%~A"
		       (logand 377 check) (logand block-number 377)
		       (logxor 377 (logand block-number 377)) (logand length 377)
		        (logand (-  256. length) 377) file-string))))))
  (ferror eh:abort-object))

(compile-flavor-methods lminet-connection)