串口通信lisp

Question

在Windows上的Common Lisp中是否有串口通信库？

Answer 1

我不知道是否有免费的，但LispWorks有一个 - SERIAL-PORT。

如果失败了，你可能必须自己写。您可以尝试简单地为Windows调用编写FFI包装（GetCommState，WaitCommEvent等）作为开始。这当然是可行的。

Answer 2

这不是一个真正的lisp问题，但我会尽力回答它。简答：不。长答案：可能。这取决于FFI是如何工作的以及您使用的是什么环境（原始窗口，cygwin，mingw）如果您使用原始窗口，机会非常渺茫。其实，无论如何，我敢打赌，机会很渺茫。 Lisp是一种相当高级的语言，并不适用于像这样的东西。

Answer 3

这是一些使用SBCL外部函数POSIX调用实现串行通信的函数。它不是像你一样满库，但我解决了我根据这个协议，谈话的设备的问题

https://valelab.ucsf.edu/svn/micromanager2/branches/micromanager1.3/DeviceAdapters/ZeissCAN/ZeissCAN.cpp

package.lisp：

(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)) 

serial.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)))) 

focus.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"))))