Recursive scan-columns.
This commit is contained in:
parent
7a374636bb
commit
20df8134c1
1 changed files with 14 additions and 11 deletions
23
menelaus.scm
23
menelaus.scm
|
@ -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))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue