Make the gui use mutable data structures.

Making changes to nested vectors inside structs in Racket is really nasty
without lenses.

Makefile

@@ -8,9 +8,9 @@ USB=/dev/ttyACM0
 build: $(LAYOUT).hex
 
 upload: $(LAYOUT).hex
-	echo "Put your device in bootloader mode now..."
+	@echo "Put your device in bootloader mode now..."
-	echo "Classic Atreus: connect GND pin to RST pin twice in under a secod."
+	@echo "Classic Atreus: connect GND pin to RST pin twice in under a secod."
-	echo "Keyboardio Atreus: press the button on the underside of the board."
+	@echo "Keyboardio Atreus: press the button on the underside of the board."
 	while [ ! -r $(USB) ]; do sleep 1; done; \
 	avrdude -p $(MCU) -c avr109 -U flash:w:$(LAYOUT).hex -P $(USB)
 

gui.rkt

@@ -2,17 +2,14 @@
 
 (require racket/match)
 
-(define (vector-set v i o) ; =(
+;; TODO:
-  (vector->immutable-vector
+;; * enter any arbitrary key by name
-   (for/vector ([j (in-range (vector-length v))])
+;; * save/load layouts
-     (if (= i j)
+;; * emit microscheme
-         o
-         (vector-ref v j)))))
 
 (define call-c-func void) ; for microscheme compatibility
 
 (include "keycodes.scm")
-(include "layout.scm")
 
 (define width 260)
 (define height 132)
@@ -21,6 +18,8 @@
 (define rows 4)
 (define angle (degrees->radians 10))
 
+;; Drawing
+
 (define alps-switch-width 15.34)
 (define alps-switch-height 12.49)
 (define cherry-switch-width 13.62)
@@ -32,10 +31,7 @@
 (define switch-spacing 19.0)
 (define bottom 95) ; outer bottom
 
-(define column-offsets `(8 5 0 6 11
+(define column-offsets `(8 5 0 6 11 8 8 11 6 0 5 8))
-                           8
-                           8
-                           11 6 0 5 8))
 
 (define (draw-switch canvas row col)
   (let* ([x (* (+ 1 col) switch-spacing)]
@@ -48,7 +44,7 @@
 (define switch-x-offset -6.5)
 (define switch-y-offset (- bottom hand-height -3.5))
 
-(struct state (layers layer row col mode scale) #:transparent)
+(struct state (layers layer row col mode scale) #:transparent #:mutable)
 
 (define (selected? st row col)
   (and (= row (state-row st)) (= col (state-col st))))
@@ -59,8 +55,7 @@
 (define font (make-font #:size 8 #:face "Inconsolata"))
 (define small-font (make-font #:size 4 #:face "Inconsolata"))
 
-(define ((draw state-box) _ canvas)
+(define ((draw st) _ canvas)
-  (let ((st (unbox state-box)))
   (send canvas set-scale (state-scale st) (state-scale st))
   (for/list ([col (in-range cols)]
              #:when true
@@ -79,12 +74,22 @@
         (send canvas set-font (if special? small-font font))
         (send canvas draw-text key
               (+ (first xy) (if special? 2 4))
-                (+ (second xy) (if special? 2 0))))))))
+              (+ (second xy) (if special? 2 0)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Output
+
+(define (write-layout filename)
+  (when (file-exists? filename) (delete-file filename))
+  (call-with-output-file filename
+    (λ (op)
+      (for ([f forms])
+        (pretty-print f op 1)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Updating
 
 (define (move st dx dy)
-  (struct-copy state st
+  (set-state-row! st (modulo (+ dy (state-row st)) rows))
-               (row (modulo (+ dy (state-row st)) rows))
+  (set-state-col! st (modulo (+ dx (state-col st)) cols)))
-               (col (modulo (+ dx (state-col st)) cols))))
 
 (define (handle-select st keycode)
   (case keycode
@@ -92,12 +97,13 @@
     [(left) (move st -1 0)]
     [(up) (move st 0 -1)]
     [(down) (move st 0 1)]
-    [(#\-) (struct-copy state st (scale (* (state-scale st) 0.9)))]
+    [(#\-) (set-state-scale! st (* (state-scale st) 0.9))]
-    [(#\=) (struct-copy state st (scale (* (state-scale st) 1.1)))]
+    [(#\=) (set-state-scale! st (* (state-scale st) 1.1))]
-    ['escape (struct-copy state st (mode 'quit))]
+    [(escape) (set-state-mode! st 'quit)]
-    [(#\return) (struct-copy state st (mode 'set))]
+    [(#\return) (set-state-mode! st 'set)]
     [(#\tab) (printf "~s~n" st) st]
-    [(release) st]
+    [(#\space) (write-layout "out.scm")]
+    [(release) #f]
     [else (printf "~s~n" keycode) st]))
 
 (define (key-for keycode)
@@ -115,38 +121,31 @@
     [(#\return) "enter"]
     [else (format "~a" keycode)]))
 
-(define (update-layout st keycode)
+(define (handle-set st keycode)
-  (vector-set (state-layers st) (state-layer st)
+  (unless (equal? 'release keycode)
-              (vector-set (vector-ref (state-layers st)
+    (set-state-mode! st 'select)
-                                      (state-layer st))
+    (vector-set! (vector-ref (state-layers st) (state-layer st))
                  (selected st) (key-for keycode))))
 
-(define (handle-set st keycode)
+(define (handle-key canvas st keycode)
-  (if (equal? 'release keycode)
-      st
-      (struct-copy state st
-                   (layers (update-layout st keycode))
-                   (mode 'select))))
-
-(define (handle-key canvas state-box keycode)
-  (let ((st (unbox state-box)))
   (case (state-mode st)
-      ['select (set-box! state-box (handle-select st keycode))]
+    ['select (handle-select st keycode)]
-      ['set (set-box! state-box (handle-set st keycode))])
+    ['set (handle-set st keycode)])
-    (send canvas refresh)))
+  (send canvas refresh))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Main
 
 (define (main)
-  (let ([frame (new frame% [label "Menelaus"])]
+  (let ([frame (new frame% [label "Menelaus Keyboard Layout Editor"])]
-        [state-box (box (state (vector (make-vector (* rows cols) #f))
+        [st (state (vector (make-vector (* rows cols) #f)) 0 0 0 'select 2.5)])
-                               0 0 0 'select 2.5))])
     (new (class canvas%
            (define/override (on-char event)
-             (handle-key this state-box (send event get-key-code))
+             (handle-key this st (send event get-key-code))
-             (when (equal? 'quit (state-mode (unbox state-box)))
+             (when (equal? 'quit (state-mode st))
                (send frame show #f)))
            (super-new))
          [parent frame]
-         [paint-callback (draw state-box)])
+         [paint-callback (draw st)])
     (send frame show #t)))
 
 (module+ main