下面是一些使用SBCL外部函数POSIX调用实现串行通信的函数。它不如一个完整的库好,但我解决了我的问题,与设备交谈,根据这个协议
https://valelab.ucsf.edu/svn/micromanager2/branches/micromanager1.3/DeviceAdapters/ZeissCAN/ZeissCAN.cpp
(defpackage :serial
(:shadowing-import-from :cl close open ftruncate truncate time
read write)
(:use :cl :sb-posix)
(:export #:open-serial
#:close-serial
#:fd-type
#:serial-recv-length
#:read-response
#:write-zeiss
#:talk-zeiss))
(defpackage :focus
(:use :cl :serial)
(:export #:get-position
#:set-position
#:connect
#:disconnect))
串行.lisp:
(in-package :serial)
(defconstant FIONREAD #x541B)
(defconstant IXANY #o4000)
(defconstant CRTSCTS #o20000000000)
(deftype fd-type ()
`(unsigned-byte 31))
(defun open-serial (tty)
(declare (string tty)
(values stream fd-type &optional))
(let* ((fd (sb-posix:open
tty (logior O-RDWR
O-NOCTTY #+nil (this terminal can't control this program)
O-NDELAY #+nil (we don't wait until dcd is space)
)))
(term (tcgetattr fd))
(baud-rate B9600))
(fcntl fd F-SETFL (logior O-RDWR O-NOCTTY)) #+nil (reset file status flags, clearing e.g. O-NDELAY)
(cfsetispeed baud-rate term)
(cfsetospeed baud-rate term)
(macrolet ((set-flag (flag &key (on ()) (off ()))
`(setf ,flag (logior ,@on (logand ,flag ,@off)))))
(setf
(aref (termios-cc term) VMIN) 1 #+nil (wake up after 32 chars are read)
(aref (termios-cc term) VTIME) 5 #+nil (wake up when no char arrived for .1 s))
;; check and strip parity, handshake off
(set-flag (termios-iflag term)
:on ()
:off (IXON IXOFF IXANY
IGNBRK BRKINT PARMRK ISTRIP
INLCR IGNCR ICRNL
))
;; process output
(set-flag (termios-oflag term)
:off (OPOST))
;; canonical input but no echo
(set-flag (termios-lflag term)
:on ()
:off (ICANON ECHO ECHONL IEXTEN ISIG))
;; enable receiver, local mode, 8N1 (no parity)
(set-flag (termios-cflag term)
:on (CLOCAL CREAD
CS8 CRTSCTS)
:off (CSTOPB CSIZE PARENB)))
(tcflush fd TCIFLUSH) #+nil (throw away any input data)
(tcsetattr fd TCSANOW term) #+nil (set terminal port attributes)
(values
(sb-sys:make-fd-stream fd :input t :output t
:buffering :full)
fd)))
(defun close-serial (fd)
(declare (fd-type fd)
(values null &optional))
(fcntl fd F-SETFL 0) #+nil (reset file status flags, clearing e.g. O-NONBLOCK)
(sb-posix:close fd) #+nil (this will set DTR low)
nil)
(defun serial-recv-length (fd)
(declare (fd-type fd)
(values (signed-byte 32) &optional))
(sb-alien:with-alien ((bytes sb-alien:int))
(ioctl fd FIONREAD (sb-alien:addr bytes))
bytes))
(defun read-response (tty-fd tty-stream)
(declare (fd-type tty-fd)
(stream tty-stream)
(values string &optional))
(declare (fd-type tty-fd)
(stream tty-stream)
(values string &optional))
(let ((n (serial-recv-length tty-fd)))
(if (eq 0 n)
""
(let ((ret (make-string n)))
(dotimes (i n)
(setf (char ret i) (read-char tty-stream)))
ret))))
(defun write-zeiss (tty-stream command)
(declare (stream tty-stream)
(string command))
(format tty-stream "~a~a" command #\Return)
(finish-output tty-stream))
(defun talk-zeiss (tty-fd tty-stream command)
(declare (fd-type tty-fd)
(stream tty-stream)
(string command)
(values string &optional))
(write-zeiss tty-stream command)
;; I measured that the position is fully transmitted after 30 ms.
(let ((n (do ((i 0 (1+ i))
(n 0 (serial-recv-length tty-fd)))
((or (< 0 n) (<= 30 i)) n)
(sleep .03d0))))
(if (eq 0 n)
""
(read-response tty-fd tty-stream))))
焦点.lisp:
(in-package :focus)
(defvar *stream* nil)
(defvar *fd* nil)
(defun run-shell (command)
(with-output-to-string (stream)
(sb-ext:run-program "/bin/bash" (list "-c" command)
:input nil
:output stream)))
(defun find-zeiss-usb-adapter ()
(let ((port (run-shell "dmesg|grep pl2303|grep ttyUSB|tail -n1|sed s+.*ttyUSB+/dev/ttyUSB+g|tr -d '\\n'")))
(if (string-equal "" port)
(error "dmesg output doesn't contain ttyUSB assignment. This can happen when the system ran a long time. You could reattach the USB adapter that is connected to the microscope.")
port)))
#+nil
(find-zeiss-usb-adapter)
(defun connect (&optional (devicename (find-zeiss-usb-adapter)))
(multiple-value-bind (s fd)
(open-serial devicename)
(defparameter *stream* s)
(defparameter *fd* fd)))
#+nil
(connect)
(defun disconnect ()
(close-serial *fd*)
(setf *stream* nil))
#+nil
(disconnect)
#+nil
(serial-recv-length *fd*)
#+nil ;; do cat /dev/ttyUSB1 in some terminal, or use read-response below
(progn
(format *stream* "HPTv0~a" #\Return)
(finish-output *stream*))
#+nil
(progn
(format *stream* "FPZp~a" #\Return)
(finish-output *stream*))
#+nil
(read-response *fd* *stream*)
#+nil
(response->pos-um (read-response *fd* *stream*))
#+nil
(close-serial *fd2*)
#+nil
(time
(response->pos-um (talk-zeiss *fd2* *s2* "FPZp")))
#+nil ;; measure the time it takes until the full response has arrived
(progn
(format *s2* "FPZp~a" #\Return)
(finish-output *s2*)
(dotimes (i 10)
(sleep .01d0)
(format t "~a~%" (list i (serial-recv-length *fd2*))))
(read-response *fd2* *s2*))
(defconstant +step-size+ .025s0 "Distance of one z step in micrometer.")
(defun response->pos-um (answer)
(declare (string answer)
(values single-float &optional))
(if (equal "PF" (subseq answer 0 2))
(let* ((uval (the fixnum (read-from-string
(format nil "#x~a" (subseq answer 2)))))
(val (if (eq 0 (logand uval #x800000))
uval ;; positive
(- uval #xffffff 1))))
(* +step-size+ val))
(error "unexpected answer on serial port.")))
;; some tricks with two's complement here! be sure to generate a
;; 24bit signed number consecutive application of pos-um->request and
;; response->pos-um should be the identity (if you don't consider the
;; prefix "PF" that response->pos-um expects)
(defun pos-um->request (pos-um)
(declare (single-float pos-um)
(values string &optional))
(format nil "~6,'0X"
(let ((val (round pos-um +step-size+)))
(if (< val 0)
(+ #xffffff val 1)
val))))
(defun get-position ()
(declare (values single-float &optional))
(response->pos-um (talk-zeiss *fd* *stream* "FPZp")))
(defun set-position (position-um)
"Decreasing the position moves away from sample."
(declare (single-float position-um))
(write-zeiss *stream*
(format nil "FPZT~a" (pos-um->request position-um))))
#+nil
(format nil "FPZT~a" (pos-um->request -8.0d0))
#+nil
(defparameter current-pos (get-position *fd* *stream*))
#+nil
(format t "pos: ~a~%" (get-position *fd2* *s2*))
# +nil
(time (format t "response ~a~%"
(set-position *s2* (+ current-pos 0.7d0))))
#+nil
(progn
(set-position *s2* (+ current-pos 135d0))
(dotimes (i 20)
(format t "pos ~a~%" (list i (get-position *fd2* *s2*)))))
#+nil
(loop for i below 100 do
(sleep .1)
(format t "~a~%" (response->pos-um (talk-zeiss "FPZp"))))
