Nulo/menelaus
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Make the gui use mutable data structures.

Browse source 
Making changes to nested vectors inside structs in Racket is really nasty
without lenses.
This commit is contained in:
Phil Hagelberg 2020-03-22 20:27:33 -07:00
parent 7703babd99
commit e12f33abdb
2 changed files with 66 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
Makefile
View file

@ -8,9 +8,9 @@ USB=/dev/ttyACM0
build: $(LAYOUT).hex build: $(LAYOUT).hex
upload: $(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; \ while [ ! -r $(USB) ]; do sleep 1; done; \
avrdude -p $(MCU) -c avr109 -U flash:w:$(LAYOUT).hex -P $(USB) avrdude -p $(MCU) -c avr109 -U flash:w:$(LAYOUT).hex -P $(USB)

127
gui.rkt
View file

@ -2,17 +2,14 @@
(require racket/match) (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 (define call-c-func void) ; for microscheme compatibility
(include "keycodes.scm") (include "keycodes.scm")
(include "layout.scm")
(define width 260) (define width 260)
(define height 132) (define height 132)
@ -21,6 +18,8 @@
(define rows 4) (define rows 4)
(define angle (degrees->radians 10)) (define angle (degrees->radians 10))
;; Drawing
(define alps-switch-width 15.34) (define alps-switch-width 15.34)
(define alps-switch-height 12.49) (define alps-switch-height 12.49)
(define cherry-switch-width 13.62) (define cherry-switch-width 13.62)
@ -32,10 +31,7 @@
(define switch-spacing 19.0) (define switch-spacing 19.0)
(define bottom 95) ; outer bottom (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) (define (draw-switch canvas row col)
(let* ([x (* (+ 1 col) switch-spacing)] (let* ([x (* (+ 1 col) switch-spacing)]
@ -48,7 +44,7 @@
(define switch-x-offset -6.5) (define switch-x-offset -6.5)
(define switch-y-offset (- bottom hand-height -3.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) (define (selected? st row col)
(and (= row (state-row st)) (= col (state-col st)))) (and (= row (state-row st)) (= col (state-col st))))
@ -59,32 +55,41 @@
(define font (make-font #:size 8 #:face "Inconsolata")) (define font (make-font #:size 8 #:face "Inconsolata"))
(define small-font (make-font #:size 4 #: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))
(send canvas set-scale (state-scale st) (state-scale st)) (for/list ([col (in-range cols)]
(for/list ([col (in-range cols)] #:when true
#:when true [row (if (or (= 5 col) (= 6 col)) '(2 3) (in-range rows))])
[row (if (or (= 5 col) (= 6 col)) '(2 3) (in-range rows))]) (send canvas set-pen (if (selected? st row col)
(send canvas set-pen (if (selected? st row col) "red" "black") 1 'solid)
"red" "black") 1 'solid) (if (and (equal? (state-mode st) 'set) (selected? st row col))
(if (and (equal? (state-mode st) 'set) (selected? st row col)) (send canvas set-brush "black" 'solid)
(send canvas set-brush "black" 'solid) (send canvas set-brush "black" 'transparent))
(send canvas set-brush "black" 'transparent)) (let* ((xy (draw-switch canvas row col))
(let* ((xy (draw-switch canvas row col)) (key (vector-ref (vector-ref (state-layers st)
(key (vector-ref (vector-ref (state-layers st) (state-layer st))
(state-layer st)) (+ col (* row cols))))
(+ col (* row cols)))) (special? (and key (< 1 (string-length key)))))
(special? (and key (< 1 (string-length key))))) (when key
(when key (send canvas set-font (if special? small-font font))
(send canvas set-font (if special? small-font font)) (send canvas draw-text key
(send canvas draw-text key (+ (first xy) (if special? 2 4))
(+ (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) (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) (define (handle-select st keycode)
(case keycode (case keycode
@ -92,12 +97,13 @@
[(left) (move st -1 0)] [(left) (move st -1 0)]
[(up) (move st 0 -1)] [(up) (move st 0 -1)]
[(down) (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] [(#\tab) (printf "~s~n" st) st]
[(release) st] [(#\space) (write-layout "out.scm")]
[(release) #f]
[else (printf "~s~n" keycode) st])) [else (printf "~s~n" keycode) st]))
(define (key-for keycode) (define (key-for keycode)
@ -115,38 +121,31 @@
[(#\return) "enter"] [(#\return) "enter"]
[else (format "~a" keycode)])) [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) (define (handle-set st keycode)
(if (equal? 'release keycode) (unless (equal? 'release keycode)
st (set-state-mode! st 'select)
(struct-copy state st (vector-set! (vector-ref (state-layers st) (state-layer st))
(layers (update-layout st keycode)) (selected st) (key-for keycode))))
(mode 'select))))
(define (handle-key canvas state-box keycode) (define (handle-key canvas st keycode)
(let ((st (unbox state-box))) (case (state-mode st)
(case (state-mode st) ['select (handle-select st keycode)]
['select (set-box! state-box (handle-select st keycode))] ['set (handle-set st keycode)])
['set (set-box! state-box (handle-set st keycode))]) (send canvas refresh))
(send canvas refresh)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Main
(define (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% (new (class canvas%
(define/override (on-char event) (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))) (send frame show #f)))
(super-new)) (super-new))
[parent frame] [parent frame]
[paint-callback (draw state-box)]) [paint-callback (draw st)])
(send frame show #t))) (send frame show #t)))
(module+ main (module+ main