(require "serial-port")

;;;; (defun comm-test-old ()
;;;;   (let ((sp1
;;;;          (serial-port:open-serial-port "COM1" :baud-rate 19200 :data-bits 8 :stop-bits 2 :parity :none)))
;;;;     (setf *sp1* sp1)
;;;;     (loop
;;;;      with res = nil
;;;;      with byte = nil
;;;;      with byte1 = nil
;;;;      with i = 0
;;;;      do
;;;;      (setf byte (msys::to-cl (msys::get-byte 0 (msys::cl-to i))))
;;;;      (setf res (send-byte sp1 byte))
;;;;      (if res
;;;;          (progn
;;;;            (send-ch sp1 (code-char 32))
;;;;            (setf byte1 (char-code (recv-ch sp1)))
;;;;            (if (= byte1 byte)
;;;;                (progn
;;;;                  (send-ch sp1 (code-char 32))
;;;;                  (setf i (+ i 1)))
;;;;              (send-ch sp1 (code-char 33))))
;;;;        (send-ch sp1 (code-char 33)))
;;;;      until (>= i 132000))

;;;;     (send-byte sp1 0)
;;;;     (send-ch sp1 (code-char 34))
;;;;     
;;;;     (serial-port:close-serial-port sp1)))


(defun test-vector ()
  (loop
   for i from 0 to 8191 do
   (msys::set-byte 0 (msys::cl-to i) (msys::cl-to (mod i 255)))))


(defun comm-test ()
  (let ((sp1
         (serial-port:open-serial-port "COM1" :baud-rate 19200 :data-bits 8 :stop-bits 2 :parity :none)))
    (setf *sp1* sp1)

    (loop
     with addr = 0
     with res = nil
     with len = 1024
     with q = nil
     with q1 = nil
     do
     (send-word sp1 addr)
;     (format t "before rcv-word.~%")
     (setf res (recv-word sp1))
;     (format t "res = ~a~%" res)
     (if (/= res addr)
         (progn
;           (format t "point addr = error~%")
           (send-byte sp1 33)
           (recv-byte sp1))
       (progn
;         (format t "point addr:res = ~a~%" res)
         (send-byte sp1 32)
         (recv-byte sp1)
         (send-hword sp1 len)
         (setf res (recv-hword sp1))
         (if (/= res len)
             (progn
;               (format t "point len = error~%")
               (send-byte sp1 33)
               (recv-byte sp1))
           (progn
;             (format t "point len: res = ~a~%" res)
             (send-byte sp1 32)
             (recv-byte sp1)
             (setf q 0)
             (loop
              with i = 0
              with bt = 0
              do 
              (setf bt (msys::to-cl (msys::get-byte 0 (msys::cl-to (+ addr i)))))
              (send-byte sp1 bt)
              (setf q (+ bt q))
              (setf i (+ i 1))
              until (>= i len))
             (setf q1 (recv-byte sp1))
;             (format t "q = ~a q1 = ~a~%" q q1)
             (if (= q1 (logand q 255))
                 (progn
                   (if (= (mod addr 512) 0)
                       (format t "addr = ~a~%" addr))
                   (setf addr (+ addr len))))))))
             
     until (>= addr 135168))
    (send-word sp1 0)
    (recv-word sp1)
    (send-byte sp1 34)
    (recv-byte sp1)
    (serial-port:close-serial-port sp1)))


(defun clear-sp ()
  (serial-port:close-serial-port *sp1*))


;;;; (defun send-ch (sp ch)
;;;;   (let ((res (serial-port:write-serial-port-char ch sp nil)))
;;;;     (if (null res)
;;;;         (format t "error: could not send: ~a . Timeout.~%"))
;;;;     res))

;;;; (defun recv-ch (sp)
;;;;   (let ((ch (serial-port:read-serial-port-char sp nil nil)))
;;;;     (if (null ch)
;;;;         (format t "error: timeout received: ~%"))
;;;;     ch))


(defun send-byte (sp ch)
  (let ((res (serial-port:write-serial-port-char (code-char ch) sp nil)))
    (if (null res)
        (format t "error: could not send: ~a . Timeout.~%"))
    res))


(defun recv-byte (sp)
  (let ((ch (serial-port:read-serial-port-char sp nil nil)))
;    (print (char-code ch))
    (send-byte sp (char-code ch))
    (if (null ch)
        (format t "error: timeout received: ~%"))
    (char-code ch)))



;;;; (defun send-byte (sp byte)
;;;;   (let ((nib-low (logand byte 15))
;;;;         (nib-high (logand (ash byte -4) 15)))
;;;;     (send-ch sp (code-char nib-high))
;;;;     (send-ch sp (code-char nib-low))
;;;;     (let ((chr (recv-ch sp)))
;;;;       (setf chr (char-code chr))
;;;;       (if (/= chr byte)
;;;;           (progn
;;;;             (format t "error: receipt fault. transmitting ~a~%" byte)
;;;;             nil)
;;;;         chr))))

(defun send-hword (sp hw)
  (send-byte sp (logand (ash hw -8) 255))
  (send-byte sp (logand hw 255)))


(defun recv-hword (sp)
  (let ((lb nil)
        (hb nil))
    (setf lb (recv-byte sp))
    (setf hb (recv-byte sp))
    (+ (* hb 256) lb)))


(defun send-word (sp w)
  (send-hword sp (logand (ash w -16) 65535))
  (send-hword sp (logand w 65535)))


(defun recv-word (sp)
  (let ((lhw (recv-hword sp))
        (uhw (recv-hword sp)))
    (+ (* uhw 65536) lhw)))