-
Notifications
You must be signed in to change notification settings - Fork 86
/
Copy pathhidapi.scm
241 lines (204 loc) · 10.8 KB
/
hidapi.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
#|
LambdaNative - a cross-platform Scheme framework
Copyright (c) 2009-2016, University of British Columbia
All rights reserved.
Redistribution and use in source and binary forms, with or
without modification, are permitted provided that the
following conditions are met:
* Redistributions of source code must retain the above
copyright notice, this list of conditions and the following
disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials
provided with the distribution.
* Neither the name of the University of British Columbia nor
the names of its contributors may be used to endorse or
promote products derived from this software without specific
prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|#
;; minimal wrapper around the hidapi library for communicating with USB and Bluetooth HID devices
(##namespace ("hidapi#"))
(##include "~~lib/gambit#.scm")
(##include "hidapi#.scm")
(##namespace ("" log-system))
(define debuglevel 0)
(define (hidapi:log level . x)
(if (>= debuglevel level) (apply log-system (append (list "hidapi: ") x))))
(c-declare #<<end-of-c-declare
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <hidapi/hidapi.h>
typedef struct hid_device_info hid_dev_info;
end-of-c-declare
)
(c-define-type hid_device "hid_device")
(c-define-type hid_device* (pointer hid_device))
(c-define-type hid_device_info "hid_dev_info")
(c-define-type hid_device_info* (pointer hid_device_info))
(define (hid-init) (hidapi:log 1 "hid-init") ((c-lambda () int "hid_init")))
(define (hid-exit) (hidapi:log 1 "hid-exit") ((c-lambda () int "hid_exit")))
;;hid_device * hid_open(unsigned short vendor_id, unsigned short product_id, const wchar_t *serial_number);
(define (hid-open vid pid sn)
(hidapi:log 1 "hid-open " vid " " pid " " sn)
((c-lambda (unsigned-short unsigned-short wchar_t-string) hid_device* "hid_open") vid pid sn))
;;hid_device * hid_open_path(const char *path);
(define (hid-open-path p)
(hidapi:log 1 "hid-open-path " p)
((c-lambda (char-string) hid_device* "hid_open_path") p))
;;struct hid_device_info * hid_enumerate(unsigned short vendor_id, unsigned short product_id);
(define (hid-enumerate vid pid)
(hidapi:log 1 "hid-enumerate " vid " " pid)
((c-lambda (unsigned-short unsigned-short) hid_device_info* "hid_enumerate") vid pid))
(define (hid-device-info->path di)
(hidapi:log 1 "hid-device-info->path " di)
((c-lambda (hid_device_info*) char-string "___result=___arg1->path;") di))
(define (hid-device-info->vendor_id di)
(hidapi:log 1 "hid-device-info->vendor_id " di)
((c-lambda (hid_device_info*) int "___result=___arg1->vendor_id;") di))
(define (hid-device-info->product_id di)
(hidapi:log 1 "hid-device-info->product_id " di)
((c-lambda (hid_device_info*) int "___result=___arg1->product_id;") di))
(define (hid-device-info->serial_number di)
(hidapi:log 1 "hid-device-info->serial_number " di)
((c-lambda (hid_device_info*) wchar_t-string "___result=___arg1->serial_number;") di))
(define (hid-device-info->release_number di)
(hidapi:log 1 "hid-device-info->release_number " di)
((c-lambda (hid_device_info*) unsigned-short "___result=___arg1->release_number;") di))
(define (hid-device-info->manufacturer_string di)
(hidapi:log 1 "hid-device-info->manufacturer_string " di)
((c-lambda (hid_device_info*) wchar_t-string "___result=___arg1->manufacturer_string;") di))
(define (hid-device-info->product_string di)
(hidapi:log 1 "hid-device-info->product_string " di)
((c-lambda (hid_device_info*) wchar_t-string "___result=___arg1->product_string;") di))
(define (hid-device-info->usage_page di)
(hidapi:log 1 "hid-device-info->usage_page " di)
((c-lambda (hid_device_info*) unsigned-short "___result=___arg1->usage_page;") di))
(define (hid-device-info->usage di)
(hidapi:log 1 "hid-device-info->usage " di)
((c-lambda (hid_device_info*) unsigned-short "___result=___arg1->usage;") di))
(define (hid-device-info->interface_number di)
(hidapi:log 1 "hid-device-info->interface_number " di)
((c-lambda (hid_device_info*) int "___result=___arg1->interface_number;") di))
(define (hid-device-info->next di)
(hidapi:log 1 "hid-device-info->next " di)
((c-lambda (hid_device_info*) hid_device_info* "___result=___arg1->next;") di))
;;void hid_free_enumeration(struct hid_device_info *devs);
(define (hid-free-enumeration devs)
(hidapi:log 1 "hid-free-enumeration " devs)
((c-lambda (hid_device_info*) void "hid_free_enumeration") devs))
;;int hid_write(hid_device *device, const unsigned char *data, size_t length);
(define (hid-write dev u8v)
(hidapi:log 2 "hid-write " dev " " u8v)
((c-lambda (hid_device* scheme-object int) int "___result=hid_write(___arg1,___CAST(void*,___BODY_AS(___arg2,___tSUBTYPED)),___arg3);")
dev u8v (u8vector-length u8v)))
;;int hid_read_timeout(hid_device *dev, unsigned char *data, size_t length, int milliseconds);
(define (hid-read-timeout dev data timeout)
(hidapi:log 2 "hid-read-timeout " dev " " data " " timeout)
(let* ((len (u8vector-length data))
(res ((c-lambda (hid_device* scheme-object int int) int
"___result=hid_read_timeout(___arg1,___CAST(void*,___BODY_AS(___arg2,___tSUBTYPED)),___arg3,___arg4);")
dev data len timeout)))
res))
;;int hid_read(hid_device *device, unsigned char *data, size_t length);
(define (hid-read dev data)
(hidapi:log 2 "hid-read " dev " " data)
(let* ((len (u8vector-length data))
(res ((c-lambda (hid_device* scheme-object int) int
"___result=hid_read(___arg1,___CAST(void*,___BODY_AS(___arg2,___tSUBTYPED)),___arg3);")
dev data len)))
res))
;;int hid_set_nonblocking(hid_device *device, int nonblock);
(define (hid-set-nonblocking dev nonblock)
(hidapi:log 1 "hid-set-nonblocking " dev " " nonblock)
(= 0 ((c-lambda (hid_device* int) int "hid_set_nonblocking") dev nonblock)))
;;int hid_send_feature_report(hid_device *device, const unsigned char *data, size_t length);
(define (hid-send-feature-report dev u8v)
(hidapi:log 1 "hid-send-feature-report " dev " " u8v)
((c-lambda (hid_device* scheme-object int) int
"___result=hid_send_feature_report(___arg1,___CAST(void*,___BODY_AS(___arg2,___tSUBTYPED)),___arg3);")
dev u8v (u8vector-length u8v)))
;;int hid_get_feature_report(hid_device *device, unsigned char *data, size_t length);
(define (hid-get-feature-report dev len)
(hidapi:log 1 "hid-get-feature-report " dev " " len)
(let* ((data (make-u8vector len 0))
(res ((c-lambda (hid_device* scheme-object int) int
"___result=hid_get_feature_report(___arg1,___CAST(void*,___BODY_AS(___arg2,___tSUBTYPED)),___arg3);")
dev data len)))
(subu8vector data 0 res)))
;;void hid_close(hid_device *device);
(define (hid-close dev)
(hidapi:log 1 "hid-close " dev)
((c-lambda (hid_device*) void "hid_close") dev))
(define u8vector->wcharstring
(c-lambda (scheme-object) wchar_t-string "___result=(wchar_t*)___CAST(void*,___BODY_AS(___arg1,___tSUBTYPED));"))
;;int hid_get_manufacturer_string(hid_device *device, wchar_t *string, size_t maxlen);
(define (hid-get-manufacturer-string dev len)
(hidapi:log 1 "hid-get-manufacturer-string " dev " " len)
(let* ((data (make-u8vector len 0))
(res ((c-lambda (hid_device* scheme-object int) int
"___result=hid_get_manufacturer_string(___arg1,___CAST(void*,___BODY_AS(___arg2,___tSUBTYPED)),___arg3);")
dev data len)))
(if (>= res 0) (u8vector->wcharstring data) "")))
;;int hid_get_product_string(hid_device *device, wchar_t *string, size_t maxlen);
(define (hid-get-product-string dev len)
(hidapi:log 1 "hid-get-product-string " dev " " len)
(let* ((data (make-u8vector len 0))
(res ((c-lambda (hid_device* scheme-object int) int
"___result=hid_get_product_string(___arg1,___CAST(void*,___BODY_AS(___arg2,___tSUBTYPED)),___arg3);")
dev data len)))
(if (>= res 0) (u8vector->wcharstring data) "")))
;;int hid_get_serial_number_string(hid_device *device, wchar_t *string, size_t maxlen);
(define (hid-get-serial-number-string dev len)
(hidapi:log 1 "hid-get-serial-number-string " dev " " len)
(let* ((data (make-u8vector len 0))
(res ((c-lambda (hid_device* scheme-object int) int
"___result=hid_get_serial_number_string(___arg1,___CAST(void*,___BODY_AS(___arg2,___tSUBTYPED)),___arg3);")
dev data len)))
(if (>= res 0) (u8vector->wcharstring data) "")))
;;int hid_get_indexed_string(hid_device *device, int string_index, wchar_t *string, size_t maxlen);
(define (hid-get-indexed-string dev index len)
(hidapi:log 1 "hid-get-indexed-string " dev " " index " " len)
(let* ((data (make-u8vector len 0))
(res ((c-lambda (hid_device* int scheme-object int) int
"___result=hid_get_indexed_string(___arg1,___arg2, ___CAST(void*,___BODY_AS(___arg3,___tSUBTYPED)),___arg4);")
dev index data len)))
(if (>= res 0) (u8vector->wcharstring data) "")))
;;const wchar_t* hid_error(hid_device *device);
(define (hid-error dev)
(hidapi:log 1 "hid-error " dev)
((c-lambda (hid_device*) wchar_t-string "hid_error") dev))
(define (hid-device-list)
(hidapi:log 1 "hid-device-list")
(let ((devinfo (hid-enumerate 0 0)))
(let loop ((di devinfo)(res '()))
(if (not di) (begin (hid-free-enumeration devinfo) res)
(loop (hid-device-info->next di)
(append res (list (list
(cons 'path (hid-device-info->path di))
(cons 'vendor_id (hid-device-info->vendor_id di))
(cons 'product_id (hid-device-info->product_id di))
(cons 'serial_number (hid-device-info->serial_number di))
(cons 'release_number (hid-device-info->release_number di))
(cons 'manufacturer_string (hid-device-info->manufacturer_string di))
(cons 'product_string (hid-device-info->product_string di))
(cons 'usage_page (hid-device-info->usage_page di))
(cons 'usage (hid-device-info->usage di))
(cons 'interface_number (hid-device-info->interface_number di)))))
)))))
(hid-init)
;; eof