Scan by folding over columns list.

README.md

@@ -1,10 +1,10 @@
 # Menelaus
 
-A keyboard firmware for
-[Atmega32u4](http://www.atmel.com/devices/ATMEGA32U4.aspx), written in
+A firmware for the
+[Atreus](http://atreus.technomancy.us) keyboard, written in
 [Microscheme](http://microscheme.org).
 
-Written one step at a time. Requires microscheme newer than 0.8; at
+Written in an incremental style. Requires microscheme newer than 0.8; at
 the time of this writing only available on git master.
 
 ## License

keycodes.scm

@@ -27,3 +27,8 @@
 (define key-y 28)
 (define key-z 29)
 (define key-semicolon 51)
+
+(define mod-ctrl #x01)
+(define mod-shift #x02)
+(define mod-alt #x04)
+(define mod-gui #x08)

menelaus.scm

@@ -1,24 +1,20 @@
 ;; -*- scheme -*-
 
-;; menelaus.scm
+(include "keycodes.scm")
 
-(include "keyboard.scm")
-
-(define pressed 0)
-
-(define column-pins (vector 11 12 15 14 10 4 7 8 9 5 6))
-(define layout (vector key-a key-s key-d key-f key-g 0
+(define columns (list 0 1 2 3 4 5 6 7 8 9))
+(define column-pins (vector 11 12 18 19 10 7 8 9 5 6))
+(define layout (vector key-a key-s key-d key-f key-g
                        key-h key-j key-k key-l key-semicolon))
 
-(define (scan-column pin keycode)
-  (if (low? pin)
-      (set! pressed keycode)))
+(define (scan-column last n)
+  (if (low? (vector-ref column-pins n))
+      (vector-ref layout n)
+      last))
 
 (define (loop)
-  (set! pressed 0)
-  (for 0 10 (lambda (n) (scan-column (vector-ref column-pins n)
-                                     (vector-ref layout n))))
-  (call-c-func "usb_send" 0 pressed 0 0 0 0 0)
+  (let ((pressed (fold scan-column 0 columns)))
+    (call-c-func "usb_send" 0 pressed 0 0 0 0 0))
   (loop))
 
 (define (init)
@@ -28,6 +24,8 @@
                               #x23 #x23 #x23 #x29 #x2D #x2D))
   (set! arduino-pins (vector 4 8 2 1 16 64 128 64 16 32 64 128 64 128
                              8 2 4 32 65 128))
+  (output 1)
+  (low 1)
   (for-each-vector input column-pins)
   (for-each-vector high column-pins) ; activate pullup resistors
   (call-c-func "usb_init")