Recursive scan-columns.

This commit is contained in:
Phil Hagelberg 2014-12-08 22:24:55 -08:00
parent 7a374636bb
commit 20df8134c1

View file

@ -2,18 +2,21 @@
(include "keycodes.scm") (include "keycodes.scm")
(define columns (list 0 1 2 3 4 5 6 7 8 9)) (define column-pins (list 11 12 18 19 10 7 8 9 5 6))
(define column-pins (vector 11 12 18 19 10 7 8 9 5 6)) (define layout (list key-a key-s key-d key-f key-g
(define layout (vector key-a key-s key-d key-f key-g
key-h key-j key-k key-l key-semicolon)) key-h key-j key-k key-l key-semicolon))
(define (scan-column last n) (define (scan-column column-pins layout pressed)
(if (low? (vector-ref column-pins n)) (if (null? column-pins)
(vector-ref layout n) pressed
last)) (scan-column (cdr column-pins)
(cdr layout)
(if (low? (car column-pins))
(car layout)
pressed))))
(define (loop) (define (loop)
(let ((pressed (fold scan-column 0 columns))) (let ((pressed (scan-row column-pins layout 0)))
(call-c-func "usb_send" 0 pressed 0 0 0 0 0)) (call-c-func "usb_send" 0 pressed 0 0 0 0 0))
(loop)) (loop))
@ -26,8 +29,8 @@
8 2 4 32 65 128)) 8 2 4 32 65 128))
(output 1) (output 1)
(low 1) (low 1)
(for-each-vector input column-pins) (for-each input column-pins)
(for-each-vector high column-pins) ; activate pullup resistors (for-each high column-pins) ; activate pullup resistors
(call-c-func "usb_init") (call-c-func "usb_init")
(pause 200)) (pause 200))