Implement press/release tracking.

This fixes the layer-switching bug which has been so problematic on
this firmware and on atreus-firmware.

README.md

@@ -11,23 +11,20 @@ A firmware for the
 * Multiple layers, momentary and sticky (limited only by memory)
 * Combo keys (a single keystroke can send a modifier and a non-modifier)
 * Bind arbitrary Scheme functions to a key
-* ~200 lines of code
+* ~250 lines of code
 
 ## Usage
 
-This currently requires Microscheme with the addition of
+This requires [avrdude](https://www.nongnu.org/avrdude/) for uploading
-`vector-copy!` which at the time of this writing is only on the master branch.
+to the controller on the keyboard; install with your package manager
-
+of choice.
-Also requires [avrdude](https://www.nongnu.org/avrdude/) for uploading
-to the device.
 
 Replace `/dev/ttyACM0` with the path your OS assigns to the USB
-bootloader of the microcontroller:
+bootloader of the microcontroller (on Mac OS X sometimes it is
+`/dev/cu.usbmodem1411` or similar):
 
     $ make upload USB=/dev/ttyACM0
 
-On Mac OS X sometimes the USB path is `/dev/cu.usbmodem1411` or similar.
-
 Currently only the "multidvorak" layout is included.
 
 ## Development
@@ -37,14 +34,13 @@ microcontroller in the keyboard using `test.rkt` which loads it up
 into Racket and simulates the GPIO functions with a test harness:
 
     $ make test
+    racket test.rkt
+    ..........................
 
 ## Known bugs
 
-Still working out some quirks with sticky layers.
+If you hold down two keys which contain a modifier (for instance,
-
+shift and !) and release one of them, it will count as if both are released.
-If you hold the fn key, press a button (say Q) and then release fn
-without releasing Q, it will send a keycode for Q rather than simply
-leaving the previous fn+Q keycodes as held down.
 
 ## License
 

keycodes.scm

@@ -97,9 +97,10 @@
 (define (combo modifier keycode) (list (car modifier) keycode))
 (define (uncombo keycode) (and (= 2 (length keycode)) (car (cdr keycode))))
 
-(define mod-ctrl (modify #x01))
+;; we're treating these a little differently; they are not literal USB values
-(define mod-shift (modify #x02))
+(define mod-ctrl (modify 1))
-(define mod-alt (modify #x04))
+(define mod-shift (modify 2))
-(define mod-super (modify #x08))
+(define mod-alt (modify 3))
+(define mod-super (modify 4))
 
 (define (sft keycode) (combo mod-shift keycode)) ; shorthand

layout.scm

@@ -5,13 +5,12 @@
 (define current-layer #f)
 (define momentary-layer #f)
 
-(define (fn)
+(define (fn on?) (set! momentary-layer (and on? (vector-ref layers 1))))
-  (set! momentary-layer (vector-ref layers 1)))
 
 (define (set-layer n)
-  (lambda () (set! current-layer (vector-ref layers n))))
+  (lambda (_) (set! current-layer (vector-ref layers n))))
 
-(define (reset) (call-c-func "reset"))
+(define (reset _) (call-c-func "reset"))
 
 ;;;; layers
 
@@ -38,9 +37,7 @@
          key-dash key-equal (sft key-9) (sft key-0) (sft key-7) mod-ctrl
          key-backtick key-1 key-2 key-3 key-backslash
 
-         ;; still got some bugs in layering to work out! make this reset for now
+         (set-layer 2) key-insert mod-super mod-shift key-backspace mod-alt
-         reset ;; (set-layer 2)
-         key-insert mod-super mod-shift key-backspace mod-alt
          key-space fn key-e key-0 key-right-bracket))
 
 (define l2-layer
@@ -54,7 +51,7 @@
          (set-layer 4) key-f1 key-f2 key-f3 key-f12
 
          0 key-vol-down mod-super mod-shift key-backspace mod-alt
-         key-space 0 key-printscreen key-scroll-lock key-pause))
+         key-space (set-layer 0) key-printscreen key-scroll-lock key-pause))
 
 (define hard-dvorak-layer
  (vector key-quote key-comma key-period key-p key-y key-backslash

menelaus.scm

@@ -8,6 +8,25 @@
 
 (define max-keys 10) ; single USB frame can only send 6 keycodes plus modifiers
 
+;;;;;;;;;;;;;;;;;;; utils
+
+(define (member v lst)
+  (if (null? lst)
+      #f
+      (if (equal? v (car lst))
+          lst
+          (member v (cdr lst)))))
+
+(define (find-aux v x n max)
+  (if (= x (or (vector-ref v n) (- 0 1)))
+      n
+      (if (= n max)
+          #f
+          (find-aux v x (+ n 1) max))))
+
+(define (find v x)
+  (find-aux v x 0 (- (vector-length v) 1)))
+
 ;;;;;;;;;;;;;;;;;;; matrix
 
 (define (offset-for row col)
@@ -21,7 +40,7 @@
       scan))
 
 (define (scan-column scan row columns-left)
-  (if (empty? columns-left)
+  (if (null? columns-left)
       scan
       (scan-column (scan-key scan row (car columns-left))
                    row (cdr columns-left))))
@@ -31,7 +50,7 @@
   (low (vector-ref row-pins row)))
 
 (define (scan-matrix scan rows-left)
-  (if (empty? rows-left)
+  (if (null? rows-left)
       scan
       (begin
         (activate-row (car rows-left))
@@ -53,46 +72,125 @@
 (define (debounce-matrix)
   (debounce-matrix-aux (list) debounce-passes))
 
-;;;;;;;;;;;;;;;;;;; layout
+;;;;;;;;;;;;;;;;;;; press and release tracking
+
+(define last-keys-down (vector 0 0 0 0 0 0 0 0 0 0))
+
+(define (add-last-down-aux key n)
+  (if (= 0 (vector-ref last-keys-down n))
+      (vector-set! last-keys-down n key)
+      (if (< n 9)
+          (add-last-down-aux key (+ n 1))
+          ;; microscheme does not have a `when' form, so for compatibility with
+          ;; racket, we must always include an else branch.
+          #f)))
+
+(define (remove-last-down-aux key n)
+  (if (< n 9)
+      (if (= key (vector-ref last-keys-down n))
+          (vector-set! last-keys-down n 0)
+          (remove-last-down-aux key (+ n 1)))
+      #f))
+
+(define (add-last-down key) (add-last-down-aux key 0))
+(define (remove-last-down key) (remove-last-down-aux key 0))
+
+(define (remove-aux v lst checked all?)
+  (if (null? lst)
+      (reverse checked)
+      (if (= v (car lst))
+          (if all?
+              (remove-aux v (cdr lst) checked all?)
+              (reverse (append (cdr lst) checked)))
+          (remove-aux v (cdr lst) (cons (car lst) checked) all?))))
+
+(define (remove v lst) (remove-aux v lst (list) #f))
+(define (remove-all v lst) (remove-aux v lst (list) #t))
+
+(define (press/release-aux press release keys-scanned)
+  (if (null? keys-scanned)
+      (cons press release)
+      (let ((key (car keys-scanned)))
+        (if (member key release)
+            (press/release-aux press (remove key release) (cdr keys-scanned))
+            (press/release-aux (cons key press) release (cdr keys-scanned))))))
+
+(define (press/release-for keys-scanned)
+  (let ((p/r (press/release-aux (list)
+                                (remove-all 0 (vector->list last-keys-down))
+                                keys-scanned)))
+    ;; save off press/release into last-keys-down for next cycle
+    (for-each add-last-down (car p/r))
+    (for-each remove-last-down (cdr p/r))
+    p/r))
+
+;;;;;;;;;;;;;;;;;;; using press/release data to generate keycodes
 
 (define (lookup key-pos)
   (let ((layout (or momentary-layer current-layer)))
     (vector-ref layout key-pos)))
 
-(define (keycode-for key-pos keycodes)
+(define modifiers (vector 0 0 0 0))
-  (let ((code (lookup key-pos)))
+(define keycodes-down (vector 0 0 0 0 0 0))
-    ;; (printf "keycode ~s ~s~n" code which-key)
-    (if (modifier? code)
-        (begin (vector-set! keycodes 0 (+ (vector-ref keycodes 0)
-                                          (unmodify code)))
-               (uncombo code))
-        (and (not (procedure? code)) code))))
 
-(define (call-functions keys-scanned)
+;; which keys caused the keycodes/modifiers to be down?
-  (if (empty? keys-scanned)
+(define keys-for-modifiers (vector #f #f #f #f))
-      #f
+(define keys-for-frame (vector #f #f #f #f #f #f))
-      (let ((code (lookup (car keys-scanned))))
-        (and (procedure? code) (code))
-        (call-functions (cdr keys-scanned)))))
 
-(define (first-zero v n)
+(define (press-modifier keycode key)
-  (if (or (= 0 (vector-ref v n)) (= 6 n))
+  (vector-set! modifiers (- keycode 1) 1)
-      n
+  ;; TODO: there is one bug here: if multiple keys have caused a modifier to be
-      (first-zero v (+ n 1))))
+  ;; active, then releasing only one of the keys will release the modifier.
+  (vector-set! keys-for-modifiers (- keycode 1) key))
 
-;; translate key numbers into specific USB keycodes
+(define (release-modifier keycode key n)
-(define (keycodes-for keys-scanned keycodes)
+  (if (= (or (vector-ref keys-for-modifiers n) (- 0 1)) key)
-  ;; this happens before we look up "regular" keycodes because it changes layers
+      (begin
-  (call-functions keys-scanned)
+        (vector-set! modifiers n 0)
-  (if (empty? keys-scanned)
+        (vector-set! keys-for-modifiers n #f))
-      (vector->list keycodes)
+      (if (< n 3)
-      (let ((keycode (keycode-for (car keys-scanned) keycodes)))
+          (release-modifier keycode key (+ n 1))
-        (and keycode
+          #f)))
-             (vector-set! keycodes (first-zero keycodes 1) keycode))
+
-        (keycodes-for (cdr keys-scanned) keycodes))))
+(define (press-normal-key keycode key)
+  (let ((slot (find keycodes-down 0)))
+    (vector-set! keycodes-down slot keycode)
+    (vector-set! keys-for-frame slot key)))
+
+(define (press-key key)
+  (let ((keycode (lookup key)))
+    (if (procedure? keycode)
+        (keycode #t)
+        (if (modifier? keycode)
+            (begin (press-modifier (unmodify keycode) key)
+                   (if (uncombo keycode)
+                       (press-normal-key (uncombo keycode) key)
+                       #f))
+            (press-normal-key keycode key)))))
+
+(define (release-key key)
+  (let ((keycode (lookup key)))
+    (if (procedure? keycode)
+        (keycode #f)
+        (let ((slot (find keys-for-frame key)))
+          (if slot
+              (begin
+                (vector-set! keycodes-down slot 0)
+                (vector-set! keys-for-frame slot 0))
+              #f)
+          (if (modifier? keycode)
+              (release-modifier (unmodify keycode) key 0)
+              #f)))))
 
 ;;;;;;;;;;;;;;;;;;; showtime
 
+(define (set-usb-frame press/release)
+  (let ((press (car press/release))
+        (release (cdr press/release)))
+    (for-each press-key press)
+    (for-each release-key release)
+    keycodes-down))
+
 (define (init)
   (set! current-layer (vector-ref layers 0))
   (for-each-vector output row-pins)
@@ -103,15 +201,19 @@
   (call-c-func "usb_init")
   (pause 200))
 
-(define (usb-send modifiers key1 key2 key3 key4 key5 key6)
+(define (usb-send modifiers k0 k1 k2 k3 k4 k5)
-  (call-c-func "usb_send" modifiers key1 key2 key3 key4 key5 key6))
+  ;; call-c-func is a special form and cannot be applied
+  (call-c-func "usb_send"
+               (vector-ref modifiers 0) (vector-ref modifiers 1)
+               (vector-ref modifiers 2) (vector-ref modifiers 3)
+               k0 k1 k2 k3 k4 k5))
 
 (define (loop)
-  (set! momentary-layer #f)
   ;; 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)))))
+           (set-usb-frame (press/release-for keys-scanned))
+           (apply usb-send modifiers (vector->list keycodes-down))))
   (loop))
 
 (init)

test.rkt

@@ -18,9 +18,16 @@
 
 (define last-usb-frame #f) ; save this off so we can test it
 
+(define (usb-save ctrl shift alt supr . args)
+  (set! last-usb-frame (cons (filter symbol? (list (if (= 1 ctrl) 'ctrl 0)
+                                                   (if (= 1 shift) 'shift 0)
+                                                   (if (= 1 alt) 'alt 0)
+                                                   (if (= 1 supr) 'super 0)))
+                             args)))
+
 (define (call-c-func f-name . args)
-  ;; (printf "FFI ~s~n" args)
+  (when (equal? f-name "usb_send")
-  (set! last-usb-frame args))
+    (apply usb-save args)))
 
 (define (active-row)
   ;; hypothetically we could have multiple active rows but we just assume one
@@ -47,38 +54,48 @@
   ;; each test case is a pair of inputs->outputs
   ;; inputs are a list of keys (by offset), outputs are elements of a USB frame
   `(;; single key
-    ((3) . (0 ,key-r 0 0 0 0 0))
+    ((3) . (() ,key-r))
     ;; another single key
-    ((2) . (0 ,key-e 0 0 0 0 0))
+    ((2) . (() ,key-e))
     ;; multiple normal keys
-    ((2 3) . (0 ,key-r ,key-e 0 0 0 0))
+    ((2 3) . (() ,key-r ,key-e))
     ;; modifier keys (ctrl)
-    ((27) . (1 0 0 0 0 0 0))
+    ((27) . ((ctrl)))
     ;; two modifiers (shift+ctrl) get ORed together
-    ((27 36) . (3 0 0 0 0 0 0))
+    ((27 36) . ((ctrl shift)))
     ;; modifier (shift) and normal key
-    ((36 4) . (2 ,key-t 0 0 0 0 0))
+    ((36 4) . ((shift) ,key-t))
     ;; modifier and multiple normal keys
-    ((36 4 6) . (2 ,key-y ,key-t 0 0 0 0))
+    ((36 4 6) . ((shift) ,key-t ,key-y))
     ;; fn key alone
-    ((40) . (0 0 0 0 0 0 0))
+    ((40) . (()))
     ;; fn key and normal key
-    ((40 1) . (2 ,key-2 0 0 0 0 0))
+    ((40 1) . ((shift) ,key-2))
     ;; fn key and modifier and normal key
-    ((40 35 2) . (8 ,key-up 0 0 0 0 0))
+    ((40 35 2) . ((super) ,key-up))
     ;; releasing fn should leave the previously-pressed key on the fn layer!!!
-    ;; ((2) . (0 ,key-up 0 0 0 0 0))
+    ((2) . (() ,key-up))
     ;; changing to L2 (fn+esc)
-    ((40 33) . (0 0 0 0 0 0 0))
+    ((40) . (()))
+    ((40 33) . (()))
     ;; fn+esc should stay on L2 across multiple scans
-    ((40 33) . (0 0 0 0 0 0 0))
+    ((40 33) . (()))
+    ;; release fn to disable momentary
+    (() . (()))
     ;; hitting an L2 key
-    ;; ((1) . (0 ,key-home 0 0 0 0 0))
+    ((1) . (() ,key-home))
-    ;; back to base (key above esc)
+    ;; L2 two keys and mod
-    ;; ((22) . (0 0 0 0 0 0 0))
+    ((36 39 18) . ((shift) ,key-f4 ,key-space))
+    ;; back to base (fn)
+    ((40) . (()))
     ;; base layer key
-    ((2) . (0 ,key-e 0 0 0 0 0))
+    ((2) . (() ,key-e))
-    ))
+    ;; shift combo and shift key simultaneously
+    ((40) . (()))
+    ((40 1 36) . ((shift) ,key-2))
+    ((40 1) . (() ,key-2))
+    ((40) . (()))
+    (() . (()))))
 
 (define test-data (make-test-data))
 
@@ -104,9 +121,12 @@
                           (vector-set! keys i
                                        (and (member i (car test-case)) #t)))
                         body
-                        (if (equal? (cdr test-case) last-usb-frame)
+                        (let ((actual (cons (car last-usb-frame)
+                                            (remove-all
+                                             0 (cdr last-usb-frame)))))
+                          (if (equal? (cdr test-case) actual)
                               (printf ".")
-                            (fail (cdr test-case) last-usb-frame))
+                              (fail (cdr test-case) actual)))
                         (set! test-data (cdr test-data))))]))
 
 (include "menelaus.scm")

usb_keyboard.c

@@ -337,9 +337,10 @@ int8_t usb_keyboard_send(void)
 }
 
 // my own wrapper, mangled to work with the PoC microsheme FFI
-int16_t usb_send(int modifiers, int key0, int key1, int key2,
+int16_t usb_send(int ctrl, int shift, int alt, int gui,
+                 int key0, int key1, int key2,
                  int key3, int key4, int key5) {
-  keyboard_modifier_keys = (uint8_t) modifiers;
+  keyboard_modifier_keys = (uint8_t) (ctrl) | (shift<<1) | (alt<<2) | (gui<<3);
   keyboard_keys[0] = (uint8_t)key0;
   keyboard_keys[1] = (uint8_t)key1;
   keyboard_keys[2] = (uint8_t)key2;