Communication de port série dans un lisp commun

Question

Existe-t-il une bibliothèque pour la communication de port série dans Common Lisp sous Windows?

Answer 1

Je ne sais pas s'il y en a un disponible, mais LispWorks en a un - SERIAL-PORT. En cas d'échec, vous devrez peut-être écrire le vôtre. Vous pouvez essayer simplement d'écrire les wrappers FFI pour les appels Windows (GetCommState, WaitCommEvent, etc.) comme un début. C'est certainement faisable.

Answer 2

Ce n'est pas vraiment une question de lisp, mais je vais essayer d'y répondre de toute façon. Réponse courte: non. Réponse longue: éventuellement. Cela dépend du fonctionnement de la FFI et de l'environnement que vous utilisez (raw windows, cygwin, mingw). Si vous utilisez des fenêtres brutes, les chances sont minces. En fait, je parie que les chances sont minces. Lisp est un langage de haut niveau et n'est pas conçu pour ce genre de choses.

Answer 3

Voici quelques fonctions qui implémentent la communication série à l'aide d'appels POSIX de fonctions étrangères SBCL. Ce ne est pas aussi belle comme une bibliothèque complète mais je résolu mon problème de parler au dispositif selon ce protocole

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