Refactor to use lists for scans of the matrix instead of vectors.

menelaus.scm

@@ -6,70 +6,61 @@
 (define columns (list 0 1 2 3 4 5 6 7 8 9 10))
 (define column-pins (vector 6 5 9 8 7 4 10 19 18 12 11))
 
-(define max-keys 6) ; a single USB frame can only send 6 keycodes plus modifiers
+(define max-keys 10) ; single USB frame can only send 6 keycodes plus modifiers
 
 ;;;;;;;;;;;;;;;;;;; matrix
 
 (define (offset-for row col)
   (+ col (* row (length columns))))
 
-(define (scan-key keys-pressed key-count row col)
+(define (scan-key scan row col)
+  (if (and (< (length scan) max-keys)
            ;; pullup resistors mean a closed circuit is low rather than high
-  (if (low? (vector-ref column-pins col))
-      (if (<= key-count max-keys)
-          (begin
-            (vector-set! keys-pressed key-count (offset-for row col))
-            (+ key-count 1))
-          key-count)
-      key-count))
+           (low? (vector-ref column-pins col)))
+      (cons (offset-for row col) scan)
+      scan))
 
-(define (scan-column keys-pressed key-count row columns-left)
-  (if (= (length columns-left) 0)
-      key-count
-      (let ((key-count (scan-key keys-pressed key-count
-                                 row (car columns-left))))
-        (scan-column keys-pressed key-count row (cdr columns-left)))))
+(define (scan-column scan row columns-left)
+  (if (empty? columns-left)
+      scan
+      (scan-column (scan-key scan row (car columns-left))
+                   row (cdr columns-left))))
 
 (define (activate-row row)
   (for-each-vector high row-pins)
   (low (vector-ref row-pins row)))
 
-(define (scan-matrix keys-pressed key-count rows-left)
-  (if (= (length rows-left) 0)
-      key-count
-      (let ((_ (activate-row (car rows-left)))
-            (key-count (scan-column keys-pressed key-count
-                                    (car rows-left) columns)))
-        (scan-matrix keys-pressed key-count (cdr rows-left)))))
+(define (scan-matrix scan rows-left)
+  (if (empty? rows-left)
+      scan
+      (begin
+        (activate-row (car rows-left))
+        (scan-matrix (scan-column scan (car rows-left) columns)
+                     (cdr rows-left)))))
 
 ;;;;;;;;;;;;;;;;;;; debouncing
 
-(define this-scan (vector 0 0 0 0 0 0 0))
-(define last-scan (vector 0 0 0 0 0 0 0))
-
 (define debounce-passes 4)
 
-(define (debounce-matrix keys-pressed last-count passes-left)
-  ;; older versions of microscheme don't have vector-copy!, only vector-copy
-  ;; which does the same thing but takes the arguments in a different order
-  (vector-copy! last-scan 0 this-scan 0 6)
+(define (debounce-matrix-aux last-scan passes-left)
   (if (< 0 passes-left)
-      (let ((this-count (scan-matrix this-scan 1 rows)))
-        (if (and (= this-count last-count)
-                 (equal? this-scan last-scan))
-            (debounce-matrix keys-pressed this-count (- passes-left 1))
-            (debounce-matrix keys-pressed this-count passes-left)))
-      (begin (vector-copy! keys-pressed 0 this-scan 0 6)
-             last-count)))
+      (let ((this-scan (scan-matrix (list) rows)))
+        (if (equal? this-scan last-scan)
+            (debounce-matrix-aux this-scan (- passes-left 1))
+            (debounce-matrix-aux this-scan debounce-passes)))
+      last-scan))
+
+(define (debounce-matrix)
+  (debounce-matrix-aux (list) debounce-passes))
 
 ;;;;;;;;;;;;;;;;;;; layout
 
-(define (lookup keys-pressed which-key)
+(define (lookup key-pos)
   (let ((layout (or momentary-layer current-layer)))
-    (vector-ref layout (vector-ref keys-pressed which-key))))
+    (vector-ref layout key-pos)))
 
-(define (keycode-for keys-pressed which-key keycodes)
-  (let ((code (lookup keys-pressed which-key)))
+(define (keycode-for key-pos keycodes)
+  (let ((code (lookup key-pos)))
     ;; (printf "keycode ~s ~s~n" code which-key)
     (if (modifier? code)
         (begin (vector-set! keycodes 0 (+ (vector-ref keycodes 0)
@@ -77,23 +68,28 @@
                (uncombo code))
         (and (not (procedure? code)) code))))
 
-(define (call-functions keys-pressed key-count)
-  (if (< 0 key-count)
-      (let ((code (lookup keys-pressed key-count)))
+(define (call-functions keys-scanned)
+  (if (empty? keys-scanned)
+      #f
+      (let ((code (lookup (car keys-scanned))))
         (and (procedure? code) (code))
-        (call-functions keys-pressed (- key-count 1)))
-      #f))
+        (call-functions (cdr keys-scanned)))))
+
+(define (first-zero v n)
+  (if (or (= 0 (vector-ref v n)) (= 6 n))
+      n
+      (first-zero v (+ n 1))))
 
 ;; translate key numbers into specific USB keycodes
-(define (keycodes-for keys-pressed key-count keycodes)
+(define (keycodes-for keys-scanned keycodes)
   ;; this happens before we look up "regular" keycodes because it changes layers
-  (call-functions keys-pressed key-count)
-  (if (= 0 key-count)
+  (call-functions keys-scanned)
+  (if (empty? keys-scanned)
       (vector->list keycodes)
-      (let ((keycode (keycode-for keys-pressed key-count keycodes)))
+      (let ((keycode (keycode-for (car keys-scanned) keycodes)))
         (and keycode
-             (vector-set! keycodes key-count keycode))
-        (keycodes-for keys-pressed (- key-count 1) keycodes))))
+             (vector-set! keycodes (first-zero keycodes 1) keycode))
+        (keycodes-for (cdr keys-scanned) keycodes))))
 
 ;;;;;;;;;;;;;;;;;;; showtime
 
@@ -112,13 +108,10 @@
 
 (define (loop)
   (set! momentary-layer #f)
-  (free! (let ((keys-pressed (vector 0 0 0 0 0 0 0)))
-           ;; scanning the matrix tells us only which physical keys were
-           ;; pressed and how many; it doesn't tell us which keycodes to
-           ;; send yet.
-           (let ((key-count (debounce-matrix keys-pressed 1 debounce-passes)))
-             (apply usb-send (keycodes-for keys-pressed (- key-count 1)
-                                           (vector 0 0 0 0 0 0 0))))))
+  ;; scanning the matrix tells us only which physical keys were pressed and
+  ;; how many; it doesn't tell us which keycodes to send yet.
+  (free! (let ((keys-scanned (debounce-matrix)))
+           (apply usb-send (keycodes-for keys-scanned (vector 0 0 0 0 0 0 0)))))
   (loop))
 
 (init)

test.rkt

@@ -51,7 +51,7 @@
     ;; another single key
     ((2) . (0 ,key-e 0 0 0 0 0))
     ;; multiple normal keys
-    ((2 3) . (0 ,key-e ,key-r 0 0 0 0))
+    ((2 3) . (0 ,key-r ,key-e 0 0 0 0))
     ;; modifier keys (ctrl)
     ((27) . (1 0 0 0 0 0 0))
     ;; two modifiers (shift+ctrl) get ORed together
@@ -59,7 +59,7 @@
     ;; modifier (shift) and normal key
     ((36 4) . (2 ,key-t 0 0 0 0 0))
     ;; modifier and multiple normal keys
-    ((36 4 6) . (2 ,key-t ,key-y 0 0 0 0))
+    ((36 4 6) . (2 ,key-y ,key-t 0 0 0 0))
     ;; fn key alone
     ((40) . (0 0 0 0 0 0 0))
     ;; fn key and normal key