From e12f33abdbf817ff4431cc680f8d8293d63fdff6 Mon Sep 17 00:00:00 2001 From: Phil Hagelberg Date: Sun, 22 Mar 2020 20:27:33 -0700 Subject: [PATCH] Make the gui use mutable data structures. Making changes to nested vectors inside structs in Racket is really nasty without lenses. --- Makefile | 6 +-- gui.rkt | 127 +++++++++++++++++++++++++++---------------------------- 2 files changed, 66 insertions(+), 67 deletions(-) diff --git a/Makefile b/Makefile index f4a085f..6fb3afe 100644 --- a/Makefile +++ b/Makefile @@ -8,9 +8,9 @@ USB=/dev/ttyACM0 build: $(LAYOUT).hex upload: $(LAYOUT).hex - echo "Put your device in bootloader mode now..." - 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 "Put your device in bootloader mode now..." + @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." while [ ! -r $(USB) ]; do sleep 1; done; \ avrdude -p $(MCU) -c avr109 -U flash:w:$(LAYOUT).hex -P $(USB) diff --git a/gui.rkt b/gui.rkt index 77caeb6..4a3eeae 100644 --- a/gui.rkt +++ b/gui.rkt @@ -2,17 +2,14 @@ (require racket/match) -(define (vector-set v i o) ; =( - (vector->immutable-vector - (for/vector ([j (in-range (vector-length v))]) - (if (= i j) - o - (vector-ref v j))))) +;; TODO: +;; * enter any arbitrary key by name +;; * save/load layouts +;; * emit microscheme (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 - 8 - 8 - 11 6 0 5 8)) +(define column-offsets `(8 5 0 6 11 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,32 +55,41 @@ (define font (make-font #:size 8 #:face "Inconsolata")) (define small-font (make-font #:size 4 #:face "Inconsolata")) -(define ((draw state-box) _ canvas) - (let ((st (unbox state-box))) - (send canvas set-scale (state-scale st) (state-scale st)) - (for/list ([col (in-range cols)] - #:when true - [row (if (or (= 5 col) (= 6 col)) '(2 3) (in-range rows))]) - (send canvas set-pen (if (selected? st row col) - "red" "black") 1 'solid) - (if (and (equal? (state-mode st) 'set) (selected? st row col)) - (send canvas set-brush "black" 'solid) - (send canvas set-brush "black" 'transparent)) - (let* ((xy (draw-switch canvas row col)) - (key (vector-ref (vector-ref (state-layers st) - (state-layer st)) - (+ col (* row cols)))) - (special? (and key (< 1 (string-length key))))) - (when key - (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)))))))) +(define ((draw st) _ canvas) + (send canvas set-scale (state-scale st) (state-scale st)) + (for/list ([col (in-range cols)] + #:when true + [row (if (or (= 5 col) (= 6 col)) '(2 3) (in-range rows))]) + (send canvas set-pen (if (selected? st row col) + "red" "black") 1 'solid) + (if (and (equal? (state-mode st) 'set) (selected? st row col)) + (send canvas set-brush "black" 'solid) + (send canvas set-brush "black" 'transparent)) + (let* ((xy (draw-switch canvas row col)) + (key (vector-ref (vector-ref (state-layers st) + (state-layer st)) + (+ col (* row cols)))) + (special? (and key (< 1 (string-length key))))) + (when key + (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))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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 - (row (modulo (+ dy (state-row st)) rows)) - (col (modulo (+ dx (state-col st)) cols)))) + (set-state-row! st (modulo (+ dy (state-row st)) rows)) + (set-state-col! st (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)))] - [(#\=) (struct-copy state st (scale (* (state-scale st) 1.1)))] - ['escape (struct-copy state st (mode 'quit))] - [(#\return) (struct-copy state st (mode 'set))] + [(#\-) (set-state-scale! st (* (state-scale st) 0.9))] + [(#\=) (set-state-scale! st (* (state-scale st) 1.1))] + [(escape) (set-state-mode! st 'quit)] + [(#\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) - (vector-set (state-layers st) (state-layer st) - (vector-set (vector-ref (state-layers st) - (state-layer st)) - (selected st) (key-for keycode)))) - (define (handle-set st keycode) - (if (equal? 'release keycode) - st - (struct-copy state st - (layers (update-layout st keycode)) - (mode 'select)))) + (unless (equal? 'release keycode) + (set-state-mode! st 'select) + (vector-set! (vector-ref (state-layers st) (state-layer st)) + (selected st) (key-for keycode)))) -(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))] - ['set (set-box! state-box (handle-set st keycode))]) - (send canvas refresh))) +(define (handle-key canvas st keycode) + (case (state-mode st) + ['select (handle-select st keycode)] + ['set (handle-set st keycode)]) + (send canvas refresh)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Main (define (main) - (let ([frame (new frame% [label "Menelaus"])] - [state-box (box (state (vector (make-vector (* rows cols) #f)) - 0 0 0 'select 2.5))]) + (let ([frame (new frame% [label "Menelaus Keyboard Layout Editor"])] + [st (state (vector (make-vector (* rows cols) #f)) 0 0 0 'select 2.5)]) (new (class canvas% (define/override (on-char event) - (handle-key this state-box (send event get-key-code)) - (when (equal? 'quit (state-mode (unbox state-box))) + (handle-key this st (send event get-key-code)) + (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