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

Add a ton of comments.

Browse source
This commit is contained in:
Phil Hagelberg 2020-03-19 20:45:03 -07:00
parent 625fb3dc1b
commit 382d557dda
3 changed files with 230 additions and 121 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
README.md
View file

@ -8,16 +8,20 @@ See [this article about how it works](https://atreus.technomancy.us/firmware).
## Features ## Features
* 6KRO (6 simultaneous keys, plus modifiers) * 6KRO (6 simultaneous keys, plus 4 modifiers)
* Software debouncing * Software debouncing
* Multiple layers, momentary and sticky (limited only by memory) * Multiple layers, momentary and sticky (limited only by memory)
* Combo keys (a single keystroke can send a modifier and a non-modifier) * Combo keys (a single keystroke can send a modifier and a non-modifier)
* Bind arbitrary Scheme functions to a key * Bind arbitrary Microscheme functions to a key
* ~300 lines of code * ~300 lines of code
## Usage ## Usage
This requires [avrdude](https://www.nongnu.org/avrdude/) for uploading Install [microscheme](https://github.com/ryansuchocki/microscheme/)
from source; place `microscheme` executable on your `$PATH`. Version
823c5d9 from February 2020 is known to work.
Requires [avrdude](https://www.nongnu.org/avrdude/) for uploading
to the controller on the keyboard; install with your package manager to the controller on the keyboard; install with your package manager
of choice. of choice.
@ -27,14 +31,32 @@ bootloader of the microcontroller (on Mac OS X sometimes it is
$ make upload USB=/dev/ttyACM0 $ make upload USB=/dev/ttyACM0
By default you get the "multidvorak" layout, but you can also build a Once you run that, put the device in bootloader mode; sometimes this
qwerty layout: can be invoked by a key combo and sometimes a hard reset is
necessary. On the A-star Micro used in the Atreus kits, this is done
by shorting GND and RST twice in under a second, which causes the
onboard LED to pulse. The Keyboardio Atreus has a reset button you can
press with a pin to the bottom of the board.
## Known bugs
The reset function in the firmware has no effect; hard-reset must be
used to flash a new firmware once this is uploaded.
## Layout
By default you get the "multidvorak" layout which is designed to send
the right keycodes with the assumption that the OS is set to use
Dvorak, but it also includes layers for "hard Dvorak". But you can
also build a qwerty layout:
$ cp qwerty.scm layout.scm $ cp qwerty.scm layout.scm
$ make upload USB=/dev/ttyACM0 $ make upload USB=/dev/ttyACM0
Or edit `layout.scm` to your liking; you can see a list of available Or edit `layout.scm` to your liking; you can see a list of available
keycodes in `keycodes.scm`. keycodes in `keycodes.scm`. The default layout works for 42-key Atreus
kits and the 44-key Keyboardio Atreus, but you will have to uncomment
a few things for the full 44-key support.
## Development ## Development
@ -46,11 +68,6 @@ into Racket and simulates the GPIO functions with a test harness:
racket test.rkt racket test.rkt
.......................... ..........................
## Known bugs
The reset function has no effect; hard-reset (shorting the RST and GND
pins with a wire) must be used to flash the firmware.
## License ## License
Copyright © 2014-2020 Phil Hagelberg and contributors Copyright © 2014-2020 Phil Hagelberg and contributors

111
layout.scm
View file

@ -1,8 +1,8 @@
;;; this is the multidvorak layout ;;; This is the multidvorak layout.
;; it will work for the 44-key Atreus 2 or the 42-key Atreus 1. ;; It will work for the 44-key Atreus 2 or the 42-key Atreus 1.
;; we have to declare this up front and set it later because of circularity ;; We have to declare this up front and set it later because of circularity.
(define layers #f) (define layers #f)
(define current-layer #f) (define current-layer #f)
(define momentary-layer #f) (define momentary-layer #f)
@ -12,81 +12,100 @@
(define (set-layer n) (define (set-layer n)
(lambda (_) (set! current-layer (vector-ref layers n)))) (lambda (_) (set! current-layer (vector-ref layers n))))
;; this will reset the board but fails to enter the bootloader for some reason ;; This will reset the board but fails to enter the bootloader for some reason.
(define (reset _) (call-c-func "reset")) (define (reset _) (call-c-func "reset"))
;; on the Atreus 1, we need to expose backtick on the fn layer, but on ;; On the Atreus 1, we need to expose backtick on the fn layer, but on
;; the Atreus 2 it has its own key, so we put percent there instead ;; the Atreus 2 it has its own key, so we put percent there instead.
(define backtick-or-percent (define backtick-or-percent
;; (sft key-5) ;; (sft key-5)
key-backtick) key-backtick)
;;;; layers ;;;; layers
;; NB: the middle keys (ctrl and alt on the 42-key, also ~ and \ on the 44-key
;; variant) are physically in two separate columns, but electrically they are
;; both wired in to the same middle column.
;;; physical location:
;; ~ \
;; ctrl alt
;;; electrical arrangement:
;; ~
;; \
;; ctrl
;; alt
;; This is why it looks like the top two rows should have 10 columns and the
;; bottom should have 12; in reality there are electrically 11 columns.
(define base-layer (define base-layer
(vector key-q key-w key-e key-r key-t key-backtick (vector key-q key-w key-e key-r key-t key-backtick
key-y key-u key-i key-o key-p key-y key-u key-i key-o key-p
key-a key-s key-d key-f key-g key-backslash key-a key-s key-d key-f key-g key-backslash
key-h key-j key-k key-l key-semicolon key-h key-j key-k key-l key-semicolon
key-z key-x key-c key-v key-b mod-ctrl key-z key-x key-c key-v key-b mod-ctrl
key-n key-m key-comma key-period key-slash key-n key-m key-comma key-period key-slash
key-esc key-tab mod-super mod-shift key-backspace mod-alt key-esc key-tab mod-super mod-shift key-backspace mod-alt
key-space fn key-quote key-left-bracket key-enter)) key-space fn key-quote key-left-bracket key-enter))
(define fn-layer (define fn-layer
(vector (sft key-1) (sft key-2) key-up (sft key-4) backtick-or-percent (sft key-6) (vector (sft key-1) (sft key-2) key-up (sft key-4) backtick-or-percent
key-page-up key-7 key-8 key-9 key-backspace (sft key-6) key-page-up key-7 key-8 key-9 key-backspace
(sft key-9) key-left key-down key-right (sft key-0) (sft key-7) (sft key-9) key-left key-down key-right (sft key-0) (sft key-7)
key-page-down key-4 key-5 key-6 key-backslash key-page-down key-4 key-5 key-6 key-backslash
key-dash key-equal (sft key-3) (sft key-dash) (sft key-equal) mod-ctrl key-dash key-equal (sft key-3) (sft key-dash) (sft key-equal) mod-ctrl
(sft key-8) key-1 key-2 key-3 (sft key-right-bracket) (sft key-8) key-1 key-2 key-3 (sft key-right-bracket)
(set-layer 2) key-insert mod-super mod-shift key-backspace mod-alt (set-layer 2) key-insert mod-super mod-shift key-backspace mod-alt
key-space fn key-e key-0 key-right-bracket)) key-space fn key-e key-0 key-right-bracket))
(define l2-layer (define l2-layer
(vector key-insert key-home key-up key-end key-page-up 0 (vector key-insert key-home key-up key-end key-page-up 0
key-up key-f7 key-f8 key-f9 key-f10 key-up key-f7 key-f8 key-f9 key-f10
key-delete key-left key-down key-right key-page-down 0 key-delete key-left key-down key-right key-page-down 0
key-down key-f4 key-f5 key-f6 key-f11 key-down key-f4 key-f5 key-f6 key-f11
(set-layer 0) key-vol-up 0 0 reset mod-ctrl (set-layer 0) key-vol-up 0 0 reset mod-ctrl
(set-layer 4) key-f1 key-f2 key-f3 key-f12 (set-layer 4) key-f1 key-f2 key-f3 key-f12
0 key-vol-down mod-super mod-shift key-backspace mod-alt 0 key-vol-down mod-super mod-shift key-backspace mod-alt
key-space (set-layer 0) key-printscreen key-scroll-lock key-pause)) key-space (set-layer 0) key-printscreen key-scroll-lock key-pause))
(define hard-dvorak-layer (define hard-dvorak-layer
(vector key-quote key-comma key-period key-p key-y key-backslash (vector key-quote key-comma key-period key-p key-y key-backslash
key-f key-g key-c key-r key-l key-f key-g key-c key-r key-l
key-a key-o key-e key-u key-i key-backtick key-a key-o key-e key-u key-i key-backtick
key-d key-h key-t key-n key-s key-d key-h key-t key-n key-s
key-semicolon key-q key-j key-k key-x mod-ctrl key-semicolon key-q key-j key-k key-x mod-ctrl
key-b key-m key-w key-v key-z key-b key-m key-w key-v key-z
key-esc key-tab mod-super mod-shift key-backspace mod-alt key-esc key-tab mod-super mod-shift key-backspace mod-alt
key-space fn key-quote key-left-bracket key-enter)) key-space fn key-quote key-left-bracket key-enter))
(define hard-dvorak-fn-layer (define hard-dvorak-fn-layer
(vector (sft key-1) (sft key-2) key-up (sft key-4) (sft key-5) (sft key-6) (vector (sft key-1) (sft key-2) key-up (sft key-4) (sft key-5) (sft key-6)
key-page-up key-7 key-8 key-9 (sft key-backspace) key-page-up key-7 key-8 key-9 (sft key-backspace)
(sft key-3) key-left key-down key-right (sft key-4) 0 (sft key-3) key-left key-down key-right (sft key-4) 0
key-page-down key-4 key-5 key-6 (sft key-equal) key-page-down key-4 key-5 key-6 (sft key-equal)
key-left-bracket key-right-bracket (sft key-9) (sft key-0) (sft key-7) mod-ctrl key-left-bracket key-right-bracket (sft key-9) (sft key-0) (sft key-7)
key-backtick key-1 key-2 key-3 key-backslash mod-ctrl key-backtick key-1 key-2 key-3 key-backslash
(set-layer 2) key-insert mod-super mod-shift key-backspace mod-alt (set-layer 2) key-insert mod-super mod-shift key-backspace mod-alt
key-space fn key-e key-0 key-right-bracket)) key-space fn key-e key-0 key-right-bracket))
(set! layers (vector base-layer fn-layer l2-layer (set! layers (vector base-layer fn-layer l2-layer
hard-dvorak-layer hard-dvorak-fn-layer)) hard-dvorak-layer hard-dvorak-fn-layer))

201
menelaus.scm
View file

@ -1,20 +1,39 @@
;;; menelaus.scm - a USB keyboard firmware for the Atreus.
;; Note that there are a few unusual style choices made here because
;; it is written in a shared subset of Microscheme and Racket so that it
;; can be tested on a PC without uploading it to a device for every change.
;; For one example, we use `and' where `when' would be more idiomatic. We
;; are also missing the `cond' form.
;; In general when you see an -aux function, it is an internal function which
;; recursively steps thru a vector/list with the initial arguments calculated
;; by its non-aux equivalent.
(include "keycodes.scm") (include "keycodes.scm")
(define rows (list 0 1 2 3))
(define row-pins (vector 3 2 1 0))
(define columns (list 0 1 2 3 4 5 6 7 8 9 10))
(define column-pins (vector 6 5 9 8 7 4 10 19 18 12 11))
(define max-keys 10) ; single USB frame can only send 6 keycodes plus modifiers
;; pcbdown flip, comment out for normal
;; (begin (set! mod-alt (modify 1))
;; (set! mod-ctrl (modify 3))
;; (set! column-pins (vector 11 12 18 19 10 4 7 8 9 5 6)))
(include "layout.scm") (include "layout.scm")
;;;;;;;;;;;;;;;;;;; utils ;; What are the rows and columns we care about?
(define rows (list 0 1 2 3))
(define columns (list 0 1 2 3 4 5 6 7 8 9 10))
;; Which GPIO pins are responsible for each row or column?
(define row-pins (vector 3 2 1 0))
(define column-pins (vector 6 5 9 8 7 4 10 19 18 12 11))
;; If you have a kit where the PCB is installed upside-down, uncomment this:
;; (set! column-pins (vector 11 12 18 19 10 4 7 8 9 5 6))
;; ;; Upside-down PCB makes the columns backwards but also trades ctrl and alt;
;; ;; this hack only works for layouts where ctrl and alt are in standard place.
;; (set! mod-alt (modify 1))
;; (set! mod-ctrl (modify 3))
;; The above should be handled by a compile-time environment variable but that
;; isn't yet part of Microscheme:
;; https://github.com/ryansuchocki/microscheme/issues/32
;;;;;;;;;;;;;;;;;;; Utility
(define (find-aux v x n max) (define (find-aux v x n max)
(let ((y (vector-ref v n))) (let ((y (vector-ref v n)))
@ -23,31 +42,62 @@
(and (< n max) (and (< n max)
(find-aux v x (+ n 1) max))))) (find-aux v x (+ n 1) max)))))
;; Return the index for x in vector v.
(define (find v x) (define (find v x)
(find-aux v x 0 (- (vector-length v) 1))) (find-aux v x 0 (- (vector-length v) 1)))
;;;;;;;;;;;;;;;;;;; matrix (define (remove-aux v lst checked all?)
(if (null? lst)
(reverse checked)
(if (equal? v (car lst))
(if all?
(remove-aux v (cdr lst) checked all?)
(reverse (append (cdr lst) checked)))
(remove-aux v (cdr lst) (cons (car lst) checked) all?))))
;; Return a copy of lst with the first element equal to v removed.
(define (remove v lst) (remove-aux v lst (list) #f))
;; Return a copy of lst with all elements equal to v removed.
(define (remove-all v lst) (remove-aux v lst (list) #t))
;;;;;;;;;;;;;;;;;;; The Matrix
;; A scan is defined as a list containing the key positions which are currently
;; pressed for a given pass thru the key matrix. We specifically do not attempt
;; to look up what the keys are mapped to yet; we have to do that later on after
;; identifying presses and releases, otherwise we run into layer-switching bugs.
;; Each element in the list is an integer representation of the key in question.
;; Which key in a layout vector is represented by the given row and column?
(define (offset-for row col) (define (offset-for row col)
(+ col (* row (length columns)))) (+ col (* row (length columns))))
;; Update scan to include the key for the given row/col if it's pressed.
(define (scan-key scan row col) (define (scan-key scan row col)
(if (and (< (length scan) max-keys) (if (and (< (length scan) 10) ; one USB frame can only send 6 keycodes + mods
;; pullup resistors mean a closed circuit is low rather than high ;; pullup resistors mean a closed circuit is low rather than high
(low? (vector-ref column-pins col))) (low? (vector-ref column-pins col)))
(cons (offset-for row col) scan) (cons (offset-for row col) scan)
scan)) scan))
;; Step thru every column for a row and ensure it gets scanned.
(define (scan-column scan row columns-left) (define (scan-column scan row columns-left)
(if (null? columns-left) (if (null? columns-left)
scan scan
(scan-column (scan-key scan row (car columns-left)) (scan-column (scan-key scan row (car columns-left))
row (cdr columns-left)))) row (cdr columns-left))))
;; Scanning a single column tells us that the key for that column in the active
;; row has been pressed, because the key creates a circuit between the active
;; row's output pin and that column's input pin, causing the output pin's low
;; voltage to overcome the input pin's pullup resistor.
(define (activate-row row) (define (activate-row row)
(for-each-vector high row-pins) (for-each-vector high row-pins)
(low (vector-ref row-pins row))) (low (vector-ref row-pins row)))
;; For each row, ensure that only its pin is activated, then check every column
;; in that row, consing onto the scan list.
(define (scan-matrix scan rows-left) (define (scan-matrix scan rows-left)
(if (null? rows-left) (if (null? rows-left)
scan scan
@ -56,7 +106,13 @@
(scan-matrix (scan-column scan (car rows-left) columns) (scan-matrix (scan-column scan (car rows-left) columns)
(cdr rows-left))))) (cdr rows-left)))))
;;;;;;;;;;;;;;;;;;; debouncing ;;;;;;;;;;;;;;;;;;; Debouncing
;; Electrical contacts do not switch cleanly from high to low voltage; there is
;; a short period of "bounce" while the signal settles into its new position.
;; In order to counteract this effect, we scan the whole matrix several times,
;; only considering the data we get trustworthy if we get the same value three
;; times in a row.
(define debounce-passes 3) (define debounce-passes 3)
@ -71,19 +127,34 @@
(define (debounce-matrix) (define (debounce-matrix)
(debounce-matrix-aux (list) debounce-passes)) (debounce-matrix-aux (list) debounce-passes))
;;;;;;;;;;;;;;;;;;; press and release tracking ;;;;;;;;;;;;;;;;;;; Press and release tracking
;; If we didn't have layers, we'd be done now. But since we have layers, we
;; can't assume a 1:1 mapping between keys pressed and keycodes we should send.
;; If you press key 0 on layer 0 where it's bound to Q and then switch to layer
;; one where it's bound to ! then the layer switch shouldn't cause ! to be sent;
;; you should have to release and press key 0 again to trigger that.
;; Fun fact: my original firmware written in C worked around this by just adding
;; a delay to the activation of the layer, which was cringeworthy but kinda
;; sorta worked; better than you would expect anyway:
;; https://github.com/technomancy/atreus-firmware/issues/12
;; https://github.com/technomancy/atreus-firmware/issues/49
;; Because of this, it's necessary to track press and release on the level of
;; physical keys and only map it to keycodes when a new press is detected.
;; Which physical keys were pressed during the last scan?
(define last-keys-down (vector #f #f #f #f #f #f #f #f #f #f)) (define last-keys-down (vector #f #f #f #f #f #f #f #f #f #f))
;; Find an empty slot in last-keys-down to save off the given key in.
(define (add-last-down-aux key n) (define (add-last-down-aux key n)
(if (not (vector-ref last-keys-down n)) (if (not (vector-ref last-keys-down n))
(vector-set! last-keys-down n key) (vector-set! last-keys-down n key)
(if (< n 9) (and (< n 9) (add-last-down-aux key (+ n 1)))))
(add-last-down-aux key (+ n 1))
;; microscheme does not have a `when' form, so for compatibility with
;; racket, we must always include an else branch.
#f)))
;; Remove the given key from the vector of presses from last pass.
(define (remove-last-down-aux key n) (define (remove-last-down-aux key n)
(if (equal? key (vector-ref last-keys-down n)) (if (equal? key (vector-ref last-keys-down n))
(vector-set! last-keys-down n #f) (vector-set! last-keys-down n #f)
@ -92,19 +163,6 @@
(define (add-last-down key) (add-last-down-aux key 0)) (define (add-last-down key) (add-last-down-aux key 0))
(define (remove-last-down key) (remove-last-down-aux key 0)) (define (remove-last-down key) (remove-last-down-aux key 0))
(define (remove-aux v lst checked all?)
;; also missing the cond form
(if (null? lst)
(reverse checked)
(if (equal? v (car lst))
(if all?
(remove-aux v (cdr lst) checked all?)
(reverse (append (cdr lst) checked)))
(remove-aux v (cdr lst) (cons (car lst) checked) all?))))
(define (remove v lst) (remove-aux v lst (list) #f))
(define (remove-all v lst) (remove-aux v lst (list) #t))
(define (press/release-aux press release keys-scanned) (define (press/release-aux press release keys-scanned)
(if (null? keys-scanned) (if (null? keys-scanned)
(cons press release) (cons press release)
@ -113,6 +171,8 @@
(press/release-aux press (remove key release) (cdr keys-scanned)) (press/release-aux press (remove key release) (cdr keys-scanned))
(press/release-aux (cons key press) release (cdr keys-scanned)))))) (press/release-aux (cons key press) release (cdr keys-scanned))))))
;; Takes a list of keys from a scan and returns a cons where the car is a list
;; of keys just pressed and the cdr is a list of keys just released.
(define (press/release-for keys-scanned) (define (press/release-for keys-scanned)
(let ((p/r (press/release-aux (list) (let ((p/r (press/release-aux (list)
(remove-all #f (vector->list last-keys-down)) (remove-all #f (vector->list last-keys-down))
@ -122,39 +182,42 @@
(for-each remove-last-down (cdr p/r)) (for-each remove-last-down (cdr p/r))
p/r)) p/r))
;;;;;;;;;;;;;;;;;;; using press/release data to generate keycodes ;;;;;;;;;;;;;;;;;;; Generating Keycodes
;; Given keys that have been pressed, turn those into keycodes for our USB
;; frame. Given keys that are released, update the press/release tracking
;; data to reflect them.
;; Vectors to store keycodes for the USB frame we are preparing to send.
(define modifiers (vector 0 0 0 0))
(define keycodes-down (vector 0 0 0 0 0 0))
;; For each element of the keycodes-down or modifiers vector, which physical
;; key caused it to be pressed?
(define keys-for-modifiers (vector #f #f #f #f))
(define keys-for-frame (vector #f #f #f #f #f #f))
;; Given a physical key index, what keycode does it map to in the layout?
(define (lookup key-pos) (define (lookup key-pos)
(let ((layout (or momentary-layer current-layer))) (let ((layout (or momentary-layer current-layer)))
(vector-ref layout key-pos))) (vector-ref layout key-pos)))
(define modifiers (vector 0 0 0 0)) ;; Record that a given key resulted in a specific modifier press.
(define keycodes-down (vector 0 0 0 0 0 0))
;; which keys caused the keycodes/modifiers to be down?
(define keys-for-modifiers (vector #f #f #f #f))
(define keys-for-frame (vector #f #f #f #f #f #f))
(define (press-modifier keycode key) (define (press-modifier keycode key)
(vector-set! modifiers (- keycode 1) 1) (vector-set! modifiers (- keycode 1) 1)
(vector-set! keys-for-modifiers (- keycode 1) key)) (vector-set! keys-for-modifiers (- keycode 1) key))
(define (release-modifier keycode key n) ;; Record that a given key resulted in a specific non-modifier press.
(if (= (or (vector-ref keys-for-modifiers n) (- 0 1)) key)
(begin
(vector-set! modifiers n 0)
(vector-set! keys-for-modifiers n #f))
(if (< n 3)
(release-modifier keycode key (+ n 1))
#f)))
(define (press-normal-key keycode key) (define (press-normal-key keycode key)
(let ((slot (find keycodes-down 0))) (let ((slot (find keycodes-down 0)))
(and slot (vector-set! keycodes-down slot keycode)) (and slot (vector-set! keycodes-down slot keycode))
(and slot (vector-set! keys-for-frame slot key)))) (and slot (vector-set! keys-for-frame slot key))))
;; Record a key press in the modifiers/keycodes-down vectors for the layout.
(define (press-key key) (define (press-key key)
(let ((keycode (lookup key))) (let ((keycode (lookup key)))
;; Sometimes "keycodes" are procedures; in that case we call them with
;; true when the key is pressed and false when it's released.
(if (procedure? keycode) (if (procedure? keycode)
(keycode #t) (keycode #t)
(if (modifier? keycode) (if (modifier? keycode)
@ -164,6 +227,15 @@
#f)) #f))
(press-normal-key keycode key))))) (press-normal-key keycode key)))))
;; Record that a given key being released resulted in a modifier release.
(define (release-modifier keycode key n)
(if (= (or (vector-ref keys-for-modifiers n) (- 0 1)) key)
(begin
(vector-set! modifiers n 0)
(vector-set! keys-for-modifiers n #f))
(and (< n 3) (release-modifier keycode key (+ n 1)))))
;; Record a key release, clearing it out of the press tracking data.
(define (release-key key) (define (release-key key)
;; lookup here looks it up in the current layer, even if it was pressed in ;; lookup here looks it up in the current layer, even if it was pressed in
;; the momentary layer. these need to be consistent across layers or tracked ;; the momentary layer. these need to be consistent across layers or tracked
@ -182,15 +254,9 @@
(release-modifier modifier-slot key 0) (release-modifier modifier-slot key 0)
#f))))) #f)))))
;;;;;;;;;;;;;;;;;;; showtime ;;;;;;;;;;;;;;;;;;; SHOWTIME
(define (set-usb-frame press/release)
(let ((press (car press/release))
(release (cdr press/release)))
(for-each press-key press)
(for-each release-key release)
keycodes-down))
;; Prepare the GPIO pins and initialize the USB connection.
(define (init) (define (init)
(set! current-layer (vector-ref layers 0)) (set! current-layer (vector-ref layers 0))
(for-each-vector output row-pins) (for-each-vector output row-pins)
@ -201,15 +267,22 @@
(call-c-func "usb_init") (call-c-func "usb_init")
(pause 200)) (pause 200))
;; Take press/release data and set USB keycodes and modifiers.
(define (set-usb-frame press/release)
(let ((press (car press/release))
(release (cdr press/release)))
(for-each press-key press)
(for-each release-key release)))
;; Actually send the USB frame.
(define (usb-send m k0 k1 k2 k3 k4 k5) (define (usb-send m k0 k1 k2 k3 k4 k5)
;; call-c-func is a special form and cannot be applied
(let ((mods (+ (vector-ref m 0) (* (vector-ref m 1) 2)))) ; + isn't variadic (let ((mods (+ (vector-ref m 0) (* (vector-ref m 1) 2)))) ; + isn't variadic
(let ((mods (+ mods (+ (* (vector-ref m 2) 4) (* (vector-ref m 3) 8))))) (let ((mods (+ mods (+ (* (vector-ref m 2) 4) (* (vector-ref m 3) 8)))))
;; call-c-func is a special form and cannot be applied
(call-c-func "usb_send" mods k0 k1 k2 k3 k4 k5)))) (call-c-func "usb_send" mods k0 k1 k2 k3 k4 k5))))
;; Scan the matrix, determine the appropriate keycodes, and send them.
(define (loop) (define (loop)
;; scanning the matrix tells us only which physical keys were pressed and
;; how many; it doesn't tell us which keycodes to send yet.
(free! (let ((keys-scanned (debounce-matrix))) (free! (let ((keys-scanned (debounce-matrix)))
(set-usb-frame (press/release-for keys-scanned)) (set-usb-frame (press/release-for keys-scanned))
(apply usb-send (cons modifiers (vector->list keycodes-down))))) (apply usb-send (cons modifiers (vector->list keycodes-down)))))