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))