Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 170 lines (149 sloc) 6.904 kb
0e92d26 @soemraws First commit
authored
1 ;;;; cl-libusb.lisp
2
3 (in-package #:cl-libusb)
4
5 (defclass usb-device ()
6 ((device-pointer :initarg :device-pointer :reader usb-device-pointer)
7 (handle-pointer :initform nil :reader usb-handle-pointer)
8 (claimed-interfaces :initform nil)))
9
10 (defun usb-open-p (device)
11 "Predicate to see if a device has been opened."
12 (not (null (usb-handle-pointer device))))
13
14 (defun usb-open (device)
15 "Open a usb device. If the device is already open, do nothing."
16 (unless (usb-open-p device)
17 (let ((handle (libusb-ffi:usb-open (usb-device-pointer device))))
18 (setf (slot-value device 'handle-pointer) handle)
19 (tg:finalize device #'(lambda () (libusb-ffi:usb-close handle)))))
20 device)
21
22 (defun usb-close (device)
23 "Close a usb device. If a device is already closed, do nothing."
24 (when (usb-open-p device)
25 (let ((handle (usb-handle-pointer device)))
26 (dolist (number (slot-value device 'claimed-interfaces))
27 (libusb-ffi:usb-release-interface handle number))
28 (setf (slot-value device 'claimed-interfaces) nil)
29 (libusb-ffi:usb-close handle)
30 (setf (slot-value device 'handle-pointer) nil)
31 (tg:cancel-finalization device)))
32 device)
33
34 (defun usb-get-vendor-id (device)
35 "Return the vendor id of the device."
36 (libusb-ffi:usb-get-vendor-id (usb-device-pointer device)))
37
38 (defun usb-get-product-id (device)
39 "Return the product id of the device."
40 (libusb-ffi:usb-get-product-id (usb-device-pointer device)))
41
42 (defun usb-get-devices-by-ids (vendor-id product-id)
43 "Return a list of devices that match the given vendor id and product
44 id. If either is NIL, that parameter is not used as a filter. Thus
45 if both are NIL, a list containing all devices is returned."
46 (flet ((make-device-from-pointer (pointer)
47 (make-instance 'usb-device :device-pointer pointer)))
48 (mapcar #'make-device-from-pointer
49 (libusb-ffi:usb-get-devices-by-ids vendor-id product-id))))
50
51 (defun usb-get-string (device index-or-symbol &optional language-id)
52 "Return the string associated with the given index or symbol. If no
53 language id is given, a simple ascii string is returned, else the
54 string with the given language id is returned. The allowed symbols
55 are :manufacturer, :product or :serial-number. If the device was not
56 open, it is opened to obtain the string and then closed again."
57 (let ((index index-or-symbol)
58 (was-open (usb-open-p device)))
59 (unless (integerp index)
60 (setf index (libusb-ffi:usb-get-string-index (usb-device-pointer device)
61 index-or-symbol)))
62 (unless was-open
63 (usb-open device))
64 (unwind-protect
65 (libusb-ffi:usb-get-string (usb-handle-pointer device)
66 index
67 language-id)
68 (unless was-open
69 (usb-close device)))))
70
71 (defun usb-claim-interface (device setting-or-number)
72 "Claim the given interface for the handle. The interface can be
73 specified by its setting, or its (integer) number."
74 (let ((number (if (integerp setting-or-number)
75 setting-or-number
76 (libusb-ffi:usb-interface-setting-get-number setting-or-number)))
77 handle)
78 (with-slots (claimed-interfaces handle-pointer) device
79 (unless (find number claimed-interfaces
80 :test #'=)
81 (usb-open device)
82 (setf handle handle-pointer)
83 (libusb-ffi:usb-claim-interface handle number)
84 (push number claimed-interfaces)
85 (tg:finalize device
86 #'(lambda ()
87 (libusb-ffi:usb-release-interface handle number)))))))
88
89 (defun usb-rebuild-finalization (device)
90 "Rebuild the finalization list for the given USB device."
91 (tg:cancel-finalization device)
92 (if (usb-open-p device)
93 (let ((handle (usb-handle-pointer device)))
94 (tg:finalize device
95 #'(lambda ()
96 (libusb-ffi:usb-close handle)))
97 (dolist (number (slot-value device 'claimed-interfaces))
98 (tg:finalize device
99 #'(lambda ()
100 (libusb-ffi:usb-release-interface handle number)))))
101 (setf (slot-value device 'claimed-interfaces) nil)))
102
103 (defun usb-release-interface (device setting-or-number)
104 "Release the given interface for the handle. The interface can be
105 specified by its setting, or its (integer) number."
106 (let ((number (if (integerp setting-or-number)
107 setting-or-number
108 (libusb-ffi:usb-interface-setting-get-number setting-or-number))))
109 (with-slots (claimed-interfaces handle-pointer) device
110 (when (find number claimed-interfaces
111 :test #'=)
112 (libusb-ffi:usb-release-interface handle-pointer number)
113 (setf claimed-interfaces (delete number claimed-interfaces :test #'=))
7d7e5ae @sionescu Fix typo
sionescu authored
114 (usb-rebuild-finalization device)))))
0e92d26 @soemraws First commit
authored
115
116 (defun usb-set-altinterface (device setting-or-number)
117 "Set the alternate interface setting to that of the given
118 setting. The alternate interface setting can be specified by
119 setting, or by its (integer) value."
120 (libusb-ffi:usb-set-altinterface (usb-handle-pointer device)
121 setting-or-number))
122
123 (defun usb-set-configuration (device configuration-or-number)
124 "Set the given configuration for the handle. The configuration can
125 be specified also by its (integer) value."
126 (libusb-ffi:usb-set-configuration (usb-handle-pointer device)
127 configuration-or-number))
128
129 (defun usb-simple-setup (device)
130 "Set up the device by using the first found configuration, interface
131 and settings."
132 (usb-open device)
133 (let* ((configuration
134 (car (libusb-ffi:usb-get-configurations (usb-device-pointer device))))
135 (interface
136 (car (libusb-ffi:usb-configuration-get-interfaces configuration)))
137 (setting
138 (car (libusb-ffi:usb-interface-get-settings interface))))
139 (usb-set-configuration device configuration)
140 (usb-claim-interface device setting)
141 (usb-set-altinterface device setting)))
142
143 (defun usb-bulk-read (device endpoint bytes-to-read timeout)
144 "Read the given amount of bytes in a bulk transfer and return the
145 buffer (a foreign array)."
146 (libusb-ffi:usb-bulk-read (usb-handle-pointer device)
147 endpoint bytes-to-read timeout))
148
149 (defun usb-bulk-write (device endpoint buffer timeout)
150 "Write data in the given buffer (a foreign array) in a bulk transfer
151 and return the amount of bytes actually written."
152 (libusb-ffi:usb-bulk-write (usb-handle-pointer device)
153 endpoint buffer timeout))
154
155 (defun usb-interrupt-read (device endpoint bytes-to-read timeout)
156 "Read the given amount of bytes in an interrupt transfer and return
157 the buffer (a foreign array)."
158 (libusb-ffi:usb-interrupt-read (usb-handle-pointer device)
159 endpoint bytes-to-read timeout))
160
161 (defun usb-interrupt-write (device endpoint buffer timeout)
162 "Write data in the given buffer (a foreign array) in an interrupt
163 transfer and return the amount of bytes actually written."
164 (libusb-ffi:usb-interrupt-write (usb-handle-pointer device)
165 endpoint buffer timeout))
166
167 (defun usb-clear-halt (device endpoint)
168 "Clear the halt flag on the given endpoint of the device."
169 (libusb-ffi:usb-clear-halt (usb-handle-pointer device) endpoint))
Something went wrong with that request. Please try again.