Permalink
Browse files

First commit

  • Loading branch information...
soemraws committed Mar 17, 2011
0 parents commit 0e92d26f5007c87d44031bf5cce0b69547c0c7bb
Showing with 719 additions and 0 deletions.
  1. +12 −0 README
  2. +10 −0 cl-libusb.asd
  3. +169 −0 cl-libusb.lisp
  4. +13 −0 libusb-ffi.asd
  5. +432 −0 libusb-ffi.lisp
  6. +83 −0 libusb-grovel.lisp
12 README
@@ -0,0 +1,12 @@
+cl-libusb provides an easy interface to libusb-0.1. There are two
+systems/packages: libusb-ffi, which provides a (somewhat lispified)
+ffi to libusb-0.1, and cl-libusb, which provides an easier interface.
+
+Buffers are dealt with using unsigned byte arrays from grid and
+foreign-array.
+
+libusb-ffi (and thus cl-libusb) is not complete, but should be usable.
+
+Tested and found to work on:
+linux amd64 (sbcl)
+Windows XP Professional 32-bit (clisp, mingw)
@@ -0,0 +1,10 @@
+;;;; cl-libusb.asd
+
+(asdf:defsystem #:cl-libusb
+ :name "CL-libusb"
+ :description "Lispified bindings to libusb-0.1."
+ :serial t
+ :depends-on (#:libusb-ffi #:trivial-garbage)
+ :components ((:file "package")
+ (:file "cl-libusb")))
+
@@ -0,0 +1,169 @@
+;;;; cl-libusb.lisp
+
+(in-package #:cl-libusb)
+
+(defclass usb-device ()
+ ((device-pointer :initarg :device-pointer :reader usb-device-pointer)
+ (handle-pointer :initform nil :reader usb-handle-pointer)
+ (claimed-interfaces :initform nil)))
+
+(defun usb-open-p (device)
+ "Predicate to see if a device has been opened."
+ (not (null (usb-handle-pointer device))))
+
+(defun usb-open (device)
+ "Open a usb device. If the device is already open, do nothing."
+ (unless (usb-open-p device)
+ (let ((handle (libusb-ffi:usb-open (usb-device-pointer device))))
+ (setf (slot-value device 'handle-pointer) handle)
+ (tg:finalize device #'(lambda () (libusb-ffi:usb-close handle)))))
+ device)
+
+(defun usb-close (device)
+ "Close a usb device. If a device is already closed, do nothing."
+ (when (usb-open-p device)
+ (let ((handle (usb-handle-pointer device)))
+ (dolist (number (slot-value device 'claimed-interfaces))
+ (libusb-ffi:usb-release-interface handle number))
+ (setf (slot-value device 'claimed-interfaces) nil)
+ (libusb-ffi:usb-close handle)
+ (setf (slot-value device 'handle-pointer) nil)
+ (tg:cancel-finalization device)))
+ device)
+
+(defun usb-get-vendor-id (device)
+ "Return the vendor id of the device."
+ (libusb-ffi:usb-get-vendor-id (usb-device-pointer device)))
+
+(defun usb-get-product-id (device)
+ "Return the product id of the device."
+ (libusb-ffi:usb-get-product-id (usb-device-pointer device)))
+
+(defun usb-get-devices-by-ids (vendor-id product-id)
+ "Return a list of devices that match the given vendor id and product
+ id. If either is NIL, that parameter is not used as a filter. Thus
+ if both are NIL, a list containing all devices is returned."
+ (flet ((make-device-from-pointer (pointer)
+ (make-instance 'usb-device :device-pointer pointer)))
+ (mapcar #'make-device-from-pointer
+ (libusb-ffi:usb-get-devices-by-ids vendor-id product-id))))
+
+(defun usb-get-string (device index-or-symbol &optional language-id)
+ "Return the string associated with the given index or symbol. If no
+ language id is given, a simple ascii string is returned, else the
+ string with the given language id is returned. The allowed symbols
+ are :manufacturer, :product or :serial-number. If the device was not
+ open, it is opened to obtain the string and then closed again."
+ (let ((index index-or-symbol)
+ (was-open (usb-open-p device)))
+ (unless (integerp index)
+ (setf index (libusb-ffi:usb-get-string-index (usb-device-pointer device)
+ index-or-symbol)))
+ (unless was-open
+ (usb-open device))
+ (unwind-protect
+ (libusb-ffi:usb-get-string (usb-handle-pointer device)
+ index
+ language-id)
+ (unless was-open
+ (usb-close device)))))
+
+(defun usb-claim-interface (device setting-or-number)
+ "Claim the given interface for the handle. The interface can be
+ specified by its setting, or its (integer) number."
+ (let ((number (if (integerp setting-or-number)
+ setting-or-number
+ (libusb-ffi:usb-interface-setting-get-number setting-or-number)))
+ handle)
+ (with-slots (claimed-interfaces handle-pointer) device
+ (unless (find number claimed-interfaces
+ :test #'=)
+ (usb-open device)
+ (setf handle handle-pointer)
+ (libusb-ffi:usb-claim-interface handle number)
+ (push number claimed-interfaces)
+ (tg:finalize device
+ #'(lambda ()
+ (libusb-ffi:usb-release-interface handle number)))))))
+
+(defun usb-rebuild-finalization (device)
+ "Rebuild the finalization list for the given USB device."
+ (tg:cancel-finalization device)
+ (if (usb-open-p device)
+ (let ((handle (usb-handle-pointer device)))
+ (tg:finalize device
+ #'(lambda ()
+ (libusb-ffi:usb-close handle)))
+ (dolist (number (slot-value device 'claimed-interfaces))
+ (tg:finalize device
+ #'(lambda ()
+ (libusb-ffi:usb-release-interface handle number)))))
+ (setf (slot-value device 'claimed-interfaces) nil)))
+
+(defun usb-release-interface (device setting-or-number)
+ "Release the given interface for the handle. The interface can be
+ specified by its setting, or its (integer) number."
+ (let ((number (if (integerp setting-or-number)
+ setting-or-number
+ (libusb-ffi:usb-interface-setting-get-number setting-or-number))))
+ (with-slots (claimed-interfaces handle-pointer) device
+ (when (find number claimed-interfaces
+ :test #'=)
+ (libusb-ffi:usb-release-interface handle-pointer number)
+ (setf claimed-interfaces (delete number claimed-interfaces :test #'=))
+ (refresh-finalization device)))))
+
+(defun usb-set-altinterface (device setting-or-number)
+ "Set the alternate interface setting to that of the given
+ setting. The alternate interface setting can be specified by
+ setting, or by its (integer) value."
+ (libusb-ffi:usb-set-altinterface (usb-handle-pointer device)
+ setting-or-number))
+
+(defun usb-set-configuration (device configuration-or-number)
+ "Set the given configuration for the handle. The configuration can
+ be specified also by its (integer) value."
+ (libusb-ffi:usb-set-configuration (usb-handle-pointer device)
+ configuration-or-number))
+
+(defun usb-simple-setup (device)
+ "Set up the device by using the first found configuration, interface
+ and settings."
+ (usb-open device)
+ (let* ((configuration
+ (car (libusb-ffi:usb-get-configurations (usb-device-pointer device))))
+ (interface
+ (car (libusb-ffi:usb-configuration-get-interfaces configuration)))
+ (setting
+ (car (libusb-ffi:usb-interface-get-settings interface))))
+ (usb-set-configuration device configuration)
+ (usb-claim-interface device setting)
+ (usb-set-altinterface device setting)))
+
+(defun usb-bulk-read (device endpoint bytes-to-read timeout)
+ "Read the given amount of bytes in a bulk transfer and return the
+ buffer (a foreign array)."
+ (libusb-ffi:usb-bulk-read (usb-handle-pointer device)
+ endpoint bytes-to-read timeout))
+
+(defun usb-bulk-write (device endpoint buffer timeout)
+ "Write data in the given buffer (a foreign array) in a bulk transfer
+ and return the amount of bytes actually written."
+ (libusb-ffi:usb-bulk-write (usb-handle-pointer device)
+ endpoint buffer timeout))
+
+(defun usb-interrupt-read (device endpoint bytes-to-read timeout)
+ "Read the given amount of bytes in an interrupt transfer and return
+ the buffer (a foreign array)."
+ (libusb-ffi:usb-interrupt-read (usb-handle-pointer device)
+ endpoint bytes-to-read timeout))
+
+(defun usb-interrupt-write (device endpoint buffer timeout)
+ "Write data in the given buffer (a foreign array) in an interrupt
+ transfer and return the amount of bytes actually written."
+ (libusb-ffi:usb-interrupt-write (usb-handle-pointer device)
+ endpoint buffer timeout))
+
+(defun usb-clear-halt (device endpoint)
+ "Clear the halt flag on the given endpoint of the device."
+ (libusb-ffi:usb-clear-halt (usb-handle-pointer device) endpoint))
@@ -0,0 +1,13 @@
+;;;; libusb-ffi.asd
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (asdf:oos 'asdf:load-op :cffi-grovel))
+
+(asdf:defsystem #:libusb-ffi
+ :name "libusb-ffi"
+ :description "Common Lisp FFI bindings to libusb-0.1."
+ :serial t
+ :depends-on (#:cffi #:cffi-grovel #:grid #:foreign-array)
+ :components ((:file "package")
+ (cffi-grovel:grovel-file "libusb-grovel")
+ (:file "libusb-ffi")))
Oops, something went wrong.

0 comments on commit 0e92d26

Please sign in to comment.