From b8886121322be8545d5dbd3cbbcdd1479f36d048 Mon Sep 17 00:00:00 2001
From: Phil Hagelberg <phil@hagelb.org>
Date: Mon, 1 Jul 2019 22:00:43 -0700
Subject: [PATCH] Modifier keys.

---
 keycodes.scm | 14 +++++++++-----
 menelaus.scm | 16 +++++++++++++---
 test.rkt     |  5 ++++-
 3 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/keycodes.scm b/keycodes.scm
index 7b70f9e..b88ee24 100644
--- a/keycodes.scm
+++ b/keycodes.scm
@@ -40,8 +40,12 @@
 (define key-tab 43)
 (define key-enter 40)
 
-(define mod-ctrl #x01)
-(define mod-shift #x02)
-(define mod-alt #x04)
-(define mod-gui #x08)
-(define mod-fn #x16)
+(define (modifier? keycode) (list? keycode))
+(define (modify keycode) (list keycode))
+(define (unmodify keycode) (car keycode))
+
+(define mod-ctrl (modify #x01))
+(define mod-shift (modify #x02))
+(define mod-alt (modify #x04))
+(define mod-gui (modify #x08))
+(define mod-fn (modify #x16))
diff --git a/menelaus.scm b/menelaus.scm
index d656907..0713ba1 100644
--- a/menelaus.scm
+++ b/menelaus.scm
@@ -54,12 +54,22 @@
 (define (layout-lookup key-position)
   (vector-ref layout key-position))
 
+(define (keycode-for keys-pressed key-count keycodes)
+  (let ((code (vector-ref layout (vector-ref keys-pressed key-count))))
+    ;; (printf "keycode ~s ~s~n" code key-count)
+    (if (modifier? code)
+        (begin (vector-set! keycodes 0 (+ (vector-ref keycodes 0)
+                                          (unmodify code)))
+               #f)
+        code)))
+
 (define (keycodes-for keys-pressed key-count keycodes)
   (if (= 0 key-count)
       (vector->list keycodes)
-      (let ((keycode (vector-ref layout (vector-ref keys-pressed key-count))))
-        ;; (printf "keycode ~s ~s~n" keycode key-count)
-        (vector-set! keycodes key-count keycode)
+      (let ((keycode (keycode-for keys-pressed key-count keycodes)))
+        (if keycode
+            (vector-set! keycodes key-count keycode)
+            #f)
         (keycodes-for keys-pressed (- key-count 1) keycodes))))
 
 (define (loop)
diff --git a/test.rkt b/test.rkt
index e8a267e..b0f8233 100644
--- a/test.rkt
+++ b/test.rkt
@@ -41,7 +41,10 @@
   (include "keycodes.scm")
   ;; pair of pins/keycodes
   `(((1) . (0 ,key-w 0 0 0 0 0))
-    ((2) . (0 ,key-e 0 0 0 0 0))))
+    ((2) . (0 ,key-e 0 0 0 0 0))
+    ((27) . (4 0 0 0 0 0 0))
+    ((36 4) . (2 ,key-t 0 0 0 0 0))
+    ((36 4 6) . (2 ,key-t ,key-y 0 0 0 0))))
 
 (define test-data (make-test-data))