일반적인 lisp로 된 직렬 포트 통신

Question

Windows의 Common Lisp에 직렬 포트 통신을위한 라이브러리가 있습니까?

Answer 1

무료로 사용할 수 있는지 모르겠지만 LispWorks에는 하나가 있습니다 - SERIAL-PORT.

직접 작성해야 할 수도 있습니다. Windows 호출 (GetCommState, WaitCommEvent 등)에 대한 FFI 래퍼를 시작으로 간단하게 작성할 수 있습니다. 가장 확실한 방법입니다.

Answer 2

이것은 실제로는 리스프 질문이 아니지만 어쨌든 대답하려고합니다. 짧은 대답 : 아니오. 긴 대답 : 아마도. 그것은 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"))))