corectl

CHICKEN egg for controlling LEDs on the project 0001 keyboard

git clone https://git.8pit.net/corectl.git

 1(import scheme
 2        (chicken base)
 3        (chicken process-context)
 4        (chicken string)
 5        corectl)
 6
 7(define (string->led s)
 8  (define (led-num x)
 9    (if (number? x) x
10      (let* ((lst1 (string-split x "LED"))
11             (lst2 (string-split x "led"))
12             (num  (cond
13                     ((eq? (length lst1) 1) (car lst1))
14                     ((eq? (length lst2) 1) (car lst2))
15                     (else #f))))
16        (if num (string->number num) #f))))
17
18  (let ((n (led-num s)))
19    (if (and n (< n 6))
20      n
21      (error "unknown LED"))))
22
23(define (string->state s)
24  (cond
25    ((equal? s "on")      'on)
26    ((equal? s "off")     'off)
27    ((equal? s "restore") 'restore)
28    (else (error "invalid LED state"))))
29
30(define (parse-leds input)
31  (map
32    (lambda (x)
33      (let ((pair (string-split x ":")))
34        (if (not (eq? (length pair) 2))
35          (error "invalid input pair")
36          (cons
37            (string->led (car pair))
38            (string->state (cadr pair))))))
39    input))
40
41(define (main)
42  (let* ((leds (parse-leds (command-line-arguments)))
43         (ctrl (make-led-ctl)))
44    (call-with-led-ctl
45      ctrl (lambda (c) (led-ctl-write c leds)))))
46
47(cond-expand
48  ((or chicken-script compiling) (main))
49  (else #t))