corectl

 1(define vid #x1c6c)
 2(define pid #xa002)
 3
 4(define in-addr  #x81)
 5(define out-addr #x02)
 6
 7(define num-leds 6)
 8(define data-size 64)
 9
10(define pkt-hdr #x06)
11(define pkt-pad 56)
12(define pkt-rw 1)
13(define pkt-on 1)
14(define pkt-off 0)
15(define pkt-restore 2)
16
17;; Poor man's garbage collection
18(define num-allocs 0)
19
20(define (make-led-ctl)
21  (when (zero? num-allocs)
22    (libusb-init #f)
23    (set! num-allocs (inc num-allocs)))
24  (make-usb-endpoint vid pid out-addr))
25
26(define (close-led-ctl ctl)
27  (display "close") (newline)
28  (close-usb-endpoint ctl)
29  (if (zero? (begin
30               (set! num-allocs (dec num-allocs))
31               num-allocs))
32    (libusb-exit #f)))
33
34(define (call-with-led-ctl ctl proc)
35  (let ((r (call-with-current-continuation
36             (lambda (k)
37               (with-exception-handler
38                 (lambda (x)
39                   (close-led-ctl ctl)
40                   (k x))
41                 (lambda ()
42                   (proc ctl)))))))
43    (if (condition? r)
44      (signal r)
45      (close-led-ctl ctl))))
46
47(define (led-ctl-write ctl asc)
48  (if (< num-leds (length asc))
49    (error "invalid association list length")
50    (call-with-usb-endpoint
51      ctl
52      (lambda (endpoint)
53        (endpoint-transfer
54          (marshal asc)
55          endpoint)))))