~technomancy/menelaus

bcbb9013c00af3605e36ed6223ae36a16bb520bc — Phil Hagelberg 8 months ago e12f33a
Emitting microscheme layouts (of all A) from gui works!
1 files changed, 34 insertions(+), 9 deletions(-)

M gui.rkt
M gui.rkt => gui.rkt +34 -9
@@ 5,9 5,7 @@
;; TODO:
;; * enter any arbitrary key by name
;; * save/load layouts
;; * emit microscheme

(define call-c-func void) ; for microscheme compatibility
;; * keycode translation

(include "keycodes.scm")



@@ 18,7 16,7 @@
(define rows 4)
(define angle (degrees->radians 10))

;; Drawing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Drawing

(define alps-switch-width 15.34)
(define alps-switch-height 12.49)


@@ 78,11 76,37 @@

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Output

(define (write-layout filename)
(define prelude
  '((include "keycodes.scm")
    (define rows (list 0 1 2 3))
    (define columns (list 0 1 2 3 4 5 6 7 8 9 10))
    (define row-pins (vector 3 2 1 0))
    (define column-pins (vector 6 5 9 8 7 4 10 19 18 12 11))
    (define layers #f)
    (define current-layer #f)
    (define momentary-layer #f)

    (define (fn on?) (set! momentary-layer (and on? (vector-ref layers 1))))
    (define (set-layer n)
      (lambda (_) (set! current-layer (vector-ref layers n))))))

(define postlude
  '((set! current-layer (vector-ref layers 0))
    (include "menelaus.scm")))

(define (racket-key->ms-key key)
  'key-a)

(define (layers-form layers)
  `((set! layers (vector ,@(for/list ([layer layers])
                             `(vector ,@(for/list ([key layer])
                                          (racket-key->ms-key key))))))))

(define (write-layout filename layers)
  (when (file-exists? filename) (delete-file filename))
  (call-with-output-file filename
    (λ (op)
      (for ([f forms])
      (for ([f (append prelude (layers-form layers) postlude)])
        (pretty-print f op 1)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Updating


@@ 100,9 124,9 @@
    [(#\-) (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)]
    [(#\space) (set-state-mode! st 'set)]
    [(#\tab) (printf "~s~n" st) st]
    [(#\space) (write-layout "out.scm")]
    [(#\return) (write-layout "out.scm" (state-layers st))]
    [(release) #f]
    [else (printf "~s~n" keycode) st]))



@@ 137,7 161,8 @@

(define (main)
  (let ([frame (new frame% [label "Menelaus Keyboard Layout Editor"])]
        [st (state (vector (make-vector (* rows cols) #f)) 0 0 0 'select 2.5)])
        [st (state (vector (make-vector (* rows cols) #f)
                           (make-vector (* rows cols) #f)) 0 0 0 'select 2.5)])
    (new (class canvas%
           (define/override (on-char event)
             (handle-key this st (send event get-key-code))