embedded-channel/zephyr/zmk.scm

505 lines
22 KiB
Scheme
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

(define-module (zephyr zmk)
#:use-module (guix build union)
#:use-module (guix build utils)
#:use-module (guix build-system trivial)
#:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (ice-9 match)
#:use-module (ice-9 optargs)
#:use-module (srfi srfi-1)
#:use-module (zephyr)
#:use-module (zephyr apps)
#:use-module (zephyr modules))
(define zmk-config
(package
(name "zmk-config")
(version "0")
(source #f)
(build-system trivial-build-system)
(arguments (list #:builder #~(mkdir #$output)))
(native-search-paths
(list
(search-path-specification
(variable "ZMK_CONFIG")
(files '("zmk-config"))
(separator #f)
(file-type 'directory)
(file-pattern "^config$"))))
(home-page "https://zmk.dev/docs/config#config-file-locations")
(synopsis "ZMK firmware configuration")
(description "This ZMK Firmware configuration is a helper to set the
ZMK_CONFIG environment varibale during a ZMK Firmware package build to its
configuration input. Add a file-like object like a file-union or a package
containing a zmk-config/config folder as build input to a ZMK Firmare packege.")
(license license:expat)))
(define*-public (make-zmk board
#:key
(shield "")
(extra-inputs '())
(extra-name "")
(patches '())
snippet)
"Make a ZMK firmware package for a keyboard consisting of an Arm
microcontroller BOARD with a SHIELD PCB using the list of EXTRA-INPUTS. Add an
EXTRA-NAME with a trailing hyphen to customize the package name. Use PATCHES or
SNIPPET to modify the ZMK sources."
(make-zephyr-application-for-arm
(let* ((revision "1")
(commit "9d714c0b69fee2098a010d29e534051aeca26386")
(underscore->hyphen (lambda (name)
(string-map (lambda (char)
(if (char=? char #\_)
#\-
char))
name)))
(board-name (underscore->hyphen board))
(shield-name (underscore->hyphen shield))
(shield (if (string-null? shield) #f shield)))
(package
(name (string-append shield-name (if shield "-" "")
extra-name board-name "-zmk"))
(version (git-version "2023.06.12" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/zmkfirmware/zmk")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"08mihhcdlb9hh1qa0l6limggmvy98qiq6051p9qhnh6zbs8021h7"))
(patches patches)
(snippet snippet)))
(build-system #f)
(arguments
(list
#:out-of-source? #t
#:configure-flags
#~(append (list "-S../source/app"
(string-append "-DBOARD=" #$board))
(if #$shield
(list (string-append "-DSHIELD=" #$shield))
'()))))
(inputs (append extra-inputs
(list zephyr-module-cmsis
zephyr-module-lvgl
zephyr-module-tinycrypt
zmk-config)))
(home-page "https://zmk.dev")
(synopsis (if shield (format #f "ZMK Firmware for a ~a keyboard with ~a"
shield-name board-name)
(format #f "ZMK Firmware for a ~a keyboard"
board-name)))
(description "ZMK Firmware is an open source (MIT) keyboard firmware
built on the Zephyr™ Project Real Time Operating System (RTOS).")
(license license:expat)))
#:zephyr zephyr-3.2+zmk-fixes
#:source-prefix "zmk"))
(define*-public (make-nrfmicro-13-zmk shield #:key zmk-config (extra-name ""))
"Make a ZMK firmware package for a keyboard consisting of the nrfmicro 1.3/1.4
board with a SHIELD PCB. Use the ZMK-CONFIG directory containing optional
boards/ or dts/ directories, or .conf, .keypad, .overlay files prefixed with
shield or board names."
(make-zmk
"nrfmicro_13"
#:shield shield
#:extra-name extra-name
#:extra-inputs (append (list zephyr-module-hal-nordic-2.11)
(if zmk-config (list zmk-config)
'()))
#:snippet
#~(begin
(use-modules (guix build utils))
(substitute* "app/CMakeLists.txt"
;; Move combo.c and behaviour_tap_dance.c above all other behaviors.
(("^ target_sources\\(app PRIVATE src/combo.c\\)\n") "")
(("^ target_sources\\(app PRIVATE src/behaviors/behavior_tap_dance.c\\)\n")
"")
(("^ target_sources\\(app PRIVATE src/hid.c\\)\n" line)
(string-append
line
" target_sources(app PRIVATE src/combo.c)\n"
" target_sources(app PRIVATE src/behaviors/behavior_tap_dance.c)\n"))))))
(define*-public (make-zmk-union zmk-packages #:key name synopsis)
"Make a union of several ZMK Firmware packages for left and right hand or
settings-reset firmware files."
(package
(inherit (car zmk-packages))
(name (or name (package-name (car zmk-packages))))
(source #f)
(build-system trivial-build-system)
(arguments
(list #:modules '((guix build union))
#:builder
#~(begin
(use-modules ((guix build union)))
(union-build #$output (quote #$zmk-packages)))))
(synopsis (or synopsis (package-synopsis (car zmk-packages))))))
(define (hid-modifier modifier)
(define hid-modifier->zmk-macro
'(( . LS) ( . LC) ( . LA) ( . LG)
(R . RG) (R . RA) (R . RC) (R . RS)))
(or (assoc-ref hid-modifier->zmk-macro modifier) modifier))
(define-public (special-bindings key-label)
(define special-bindings->zmk-name
'(;; A whole in the keyboard matrix without meaning to ZMK.
( . "")
;; No functionality.
( . &none)
;; Fall-through to the next active lower layer.
( . &trans)
;; Keypress on sensor, requires two parameters for up and down keycodes.
( . &inc_dec_kp)
;; Reset and bootloader, on split keyboards this is side specific.
( . &sys_reset) ( . &bootloader)
;; Bluetooth, requires one or two parameters.
( . &bt)
;; Backlight, requires one parameter.
( . &bl)))
(or (assoc-ref special-bindings->zmk-name key-label) key-label))
(define-public (hid key-label)
(define hid->zmk-name
'(( . ESC) ( . PSCRN) ( . SLCK) ( . PAUSE_BREAK)
(^ . GRAVE) (- . MINUS)
(= . EQUAL) ( . BSPC)
( . TAB) ( . LBKT) ( . RBKT) ( . RET) ( . RET) ( . RET)
( . CAPS) ( . SEMI) ( . SQT) ( . NUHS)
( . LSHFT) (\ . NUBS)
( . COMMA) (· . DOT) (/ . SLASH) (R . RSHFT)
( . LCTRL) ( . LALT) ( . LGUI) ( . SPC)
(R . RGUI) (R . RALT) (R . RCTRL) ( . K_APP)
( . INS) ( . HOME) ( . HOME) ( . PG_UP)
( . DEL) ( . END) ( . END) ( . PG_DN)
( . LEFT) ( . DOWN) ( . UP) ( . RIGHT)
( . LEFT) ( . DOWN) ( . UP) ( . RIGHT)
( . KP_NUMLOCK) (NUM . KP_NUMLOCK)
( . KP_CLEAR) ( . KP_LPAR) ( . KP_RPAR) (P= . KP_EQUAL)
(÷ . KP_DIVIDE) (* . KP_MULTIPLY) ( . KP_MINUS) (+ . KP_PLUS)
(P1 . KP_N1) (P2 . KP_N2) (P3 . KP_N3) (P4 . KP_N4) (P5 . KP_N5)
(P6 . KP_N6) (P7 . KP_N7) (P8 . KP_N8) (P9 . KP_N9) (P0 . KP_N0)
(P. . KP_DOT) (P, . KP_COMMA) ( . ENTER)
( . C_AC_CUT) ( . C_AC_COPY) ( . C_AC_PASTE)
( . C_AC_UNDO) ( . C_AC_REDO)
( . C_AL_KEYBOARD_LAYOUT)))
(special-bindings (or (assoc-ref hid->zmk-name key-label) key-label)))
(define-public (de key-label)
(define de->hid
'((ß . -) (´ . =)
(Z . Y) (Ü . ) (+ . )
(Ö . ) (Ä . )
(< . \) (Y . Z) (- . /)
(P+ . +) (P, . P.) (P. . P,)))
(hid (or (assoc-ref de->hid key-label) key-label)))
(define-public (neo key-label)
(define neo->de
'((T1 . ^)
(X . Q) (V . W) (L . E) (C . R) (W . T)
(M3 . ) (U . A) (I . S) (A . D) (E . F) (O . G)
(M4 . <) (Ü . Y) (Ö . X) (Ä . C) (P . V) (Z . B)
(- . ß) (T2 . ´)
(K . Z) (H . U) (G . I) (F . O) (Q . P) ( . Ü) (T3 . +)
(S . H) (N . J) (R . K) (T . L) (D . Ö) (Y . Ä) (RM3 . )
(B . N) (J . -) (RM4 . R)
(P . )))
(de (or (assoc-ref neo->de key-label) key-label)))
(define*-public (zmk-keymap #:key (properties '())
(behaviors '())
(combos '())
(conditional_layers '())
(layers '())
(macros '()))
"Generate the content of a keymap file for ZMK. Each layer in LAYERS has a
name, a layout and multiple rows, of which each contains the key-bindings. The
last row contains the bindings for sensors. The key-bindings use symbols on
LAYOUT. The BEHAVIORS, COMBOS, MACROS and CONDITIONAL-LAYERS contain lists of
strings to inject own appropiate definitions for ZMK. PROPERTIES may contain
properties for behaviors or even C macro definitions."
(define (include file)
"Return an include statement for file"
(string-append "#include <" file ">"))
(define (include-binding file)
"Return an include statement for file defining bindings."
(include (string-append "dt-bindings/zmk/" file)))
(define (includes)
"Return all include statements offered by ZMK for keymap files."
(append (map include '("behaviors.dtsi"))
(map include-binding '("backlight.h" "bt.h" "ext_power.h"
"hid_usage.h" "hid_usage_pages.h" "keys.h"
"kscan_mock.h" "matrix_transform.h"
"modifiers.h" "outputs.h" "reset.h"
"rgb.h"))))
(define* (keymap-layer name layout rows)
"Return a string with a keymap layer definition NAME for a ZMK keymap file,
consisting of KEYS with their labels based on LAYOUT."
(define (zmk-name->string zmk-name)
"Tansform a ZMK-NAME into a string."
(cond ((string? zmk-name) zmk-name)
((number? zmk-name) (number->string zmk-name))
(else (symbol->string zmk-name))))
(define (key-label->zmk key-label)
"Tansform a key-label based on a keyboard-layout into a ZMK string."
(zmk-name->string (layout key-label)))
(define (modified-key->zmk modified-key)
"Transform a possibly MODIFIED-KEY like '(⇧ ⌥ ⎋) into the \"LS((LA(ESC))\"
respresentation of ZMK."
(match modified-key
((modifier modifier-or-key . rest)
(string-append (zmk-name->string (hid-modifier modifier))
"("
(modified-key->zmk (cdr modified-key))
")"))
((unmodified-key)
(modified-key->zmk unmodified-key))
(key-label
(key-label->zmk key-label))))
(define (behavior->zmk behavior strings-of-layers-and-modified-keys)
"Join a BEHAVIOR symbol like '&mt with STRINGS-OF-LAYERS-AND-MODIFIED-KEYS
as parameters like '(\"LALT\" \"ESC\") into the \"&mt LALT ESC\" respresentation
of ZMK."
(string-join (cons (key-label->zmk behavior)
strings-of-layers-and-modified-keys)))
(define (&-symbol? symbol)
"Predicate to identify a symbol as a ZMK behavior prefixed with &."
(string=? "&" (string-take (key-label->zmk symbol) 1)))
(define (key-binding->zmk key-binding)
"Transform the KEY-BINDING, which could be a key-label, a modified key, or
a behavior with layer and modified key parameters, into the representation of a
ZMK behavior for a keymap layer."
(match key-binding
(((? &-symbol? behavior) . parameters)
;; A list starting with an &-symbol is a behavior with parameters.
;; The parameters themselves may be layers or modified keys.
(behavior->zmk behavior (map modified-key->zmk parameters)))
(modified-key
(let ((modified-key (modified-key->zmk modified-key)))
(if (or (string-null? modified-key)
(&-symbol? modified-key))
;; There is nothing or a behavior is present, just use it.
modified-key
;; Add a key-press behavior to the modified-key and start over.
(behavior->zmk '&kp (list modified-key)))))))
(define (keys->zmk key-bindings)
"Transform a list of KEY-BINDINGS into ZMK behaviors for a keymap layer."
(string-join (map (lambda (zmk-behavior)
(string-pad-right
zmk-behavior
(max 12 (string-length zmk-behavior))))
(map key-binding->zmk key-bindings))))
(string-append " " name "_layer {"
"\n bindings = <"
(string-join (map keys->zmk (drop-right rows 1))
"\n " 'prefix)
"\n >;"
(if (null? (last rows))
""
(string-append
"\n sensor-bindings = <"
(string-join (map keys->zmk (last rows))
"\n " 'prefix)
"\n >;"))
"\n };"))
(define (layer layer)
"Return a string for a ZMK keymap file containing a layer definition."
(match layer
((name layout . rows)
(keymap-layer name layout rows))))
(string-join (append (includes)
properties
(list "/ {"
" behaviors {")
behaviors
(list " };"
" combos {"
" compatible = \"zmk,combos\";")
combos
(list " };"
" conditional_layers {"
" compatible = \"zmk,conditional_layers\";")
conditional_layers
(list " };"
" keymap {"
" compatible = \"zmk,keymap\";")
(map layer layers)
(list " };"
" macros {")
macros
(list " };"
"};"))
"\n"))
;; This is a hold-tap behavior for a key, which momentarily activates a layer,
;; if hold, or switches to that layer, if tapped.
(define-public layer-hold-tap
" /omit-if-no-ref/ lht: behavior_layer_hold_tap {
compatible = \"zmk,behavior-hold-tap\";
label = \"LAYER_HOLD_TAP\";
#binding-cells = <2>;
flavor = \"balanced\";
tapping-term-ms = <200>;
bindings = <&mo>, <&to>;
};
")
(define-public (layer-tap-dance n)
"Give a tap-dance behavior '&ltdN', which counts the taps for the layer number
and momentarily activates that layer on hold, or switches to that layer on tap.
If the parameter N is 0, then taps select the layers 1, 2, 3. If N is 1, taps
select the layers 0, 2, 3, and so on."
(let ((first (if (>= n 1) "0 0" "1 1"))
(second (if (>= n 2) "1 1" "2 2"))
(third (if (>= n 3) "2 2" "3 3"))
(n (number->string n)))
(string-append
" /omit-if-no-ref/ ltd" n ": behavior_layer_tap_dance" n " {
compatible = \"zmk,behavior-tap-dance\";
label = \"LAYER_TAP_DANCE" n "\";
#binding-cells = <0>;
tapping-term-ms = <200>;
bindings = <&lht " first ">, <&lht " second ">, <&lht " third ">;
};
")))
(define-public settings-reset-nrfmicro-13-zmk
(package
(inherit (make-nrfmicro-13-zmk "settings_reset"))
(synopsis "ZMK settings reset firmware for split-keyboards with nrfmicro
1.3/1.4 boards")
(description "Pairing issues of ZMK firmware split-keyboard halves can be
resolved by flashing this settings reset firmware to both controllers.")))
(define-public redox-left-nrfmicro-13-zmk
(make-nrfmicro-13-zmk "redox_left"))
(define-public redox-right-nrfmicro-13-zmk
(make-nrfmicro-13-zmk "redox_right"))
(define-public redox-nrfmicro-13-zmk
(make-zmk-union
(list settings-reset-nrfmicro-13-zmk
redox-left-nrfmicro-13-zmk
redox-right-nrfmicro-13-zmk)
#:name "redox-nrfmicro-13-zmk"
#:synopsis "ZMK firmware for a Redox shield with nrfmicro-1.3/1.4 board"))
(define-public redox-neo-keymap
(let* ((M3Y '(&mt RM3 Y))
(- '(&mt -))
(R '(&mt R ))
(- '(&mt -))
(. '(&mt ·))
(l1 '(&lt 1 ))
(to0 '(&to 0)) ; Switch to layer 0.
(l0 '(&ltd0)) ; Layer dancing for layer 0.
(l1 '(&ltd1)) ; Layer dancing for layer 1.
(l2 '(&ltd2)) ; Layer dancing for layer 2.
(l3 '(&ltd3)) ; Layer dancing for layer 3.
(1 '( BT_SEL 0))
(2 '( BT_SEL 1))
(3 '( BT_SEL 2))
(4 '( BT_SEL 3))
(5 '( BT_SEL 4))
( '( BT_CLR))
( '( BT_NXT))
( '( BT_PRV))
(keymap
(zmk-keymap
#:layers
`(("default" ,neo
( N1 N2 N3 N4 N5 N6 N7 N8 N9 N0 )
( X V L C W T2 K H G F Q )
( M3 U I A E O T3 S N R T D ,M3Y)
(,- Ü Ö Ä P Z R R B M · J ,R)
( T1 ,l0 M4 RM4 R ,l1 ,l0 ,- R )
())
("cursor" ,neo
( F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 )
( )
( )
(,- R R )
( ,l1 R ,l1 ,- R )
())
("keypad" ,neo
( F11 F12 F13 F14 F15 P ÷ * )
( P7 P8 P9 P+ )
( M3 P4 P5 P6 P= M3 )
(,- R R P1 P2 P3 R )
( ,l2 M4 RM4 R P0 P, ,. R )
())
("zmk" ,neo
( ,1 ,2 ,3 ,4 ,5 )
( )
( , , , )
( )
( ,l3 ,l3 )
()))
#:properties (list "&lt {quick-tap-ms = <200>;};"
"&mt {quick-tap-ms = <200>;};")
#:combos (list " combo_up {" ; G F ⇒ ↑
" key-positions = <22 23>;"
" bindings = <&kp UP>;"
" };"
" combo_left {" ; N R ⇒ ←
" key-positions = <35 36>;"
" bindings = <&kp LEFT>;"
" };"
" combo_down {" ; R T ⇒ ↓
" key-positions = <36 37>;"
" bindings = <&kp DOWN>;"
" };"
" combo_right {" ; T D ⇒ →
" key-positions = <37 38>;"
" bindings = <&kp RIGHT>;"
" };")
#:behaviors (list layer-hold-tap
(layer-tap-dance 0)
(layer-tap-dance 1)
(layer-tap-dance 2)
(layer-tap-dance 3)))))
(file-union "redox-config"
(list (list "zmk-config/config/redox.keymap"
(plain-file "redox-neo.keymap" keymap))))))
(define-public redox-left-neo-nrfmicro-13-zmk
(make-nrfmicro-13-zmk "redox_left"
#:zmk-config redox-neo-keymap
#:extra-name "neo-"))
(define-public redox-right-neo-nrfmicro-13-zmk
(make-nrfmicro-13-zmk "redox_right"
#:zmk-config redox-neo-keymap
#:extra-name "neo-"))
(define-public redox-neo-nrfmicro-13-zmk
(make-zmk-union
(list settings-reset-nrfmicro-13-zmk
redox-left-neo-nrfmicro-13-zmk
redox-right-neo-nrfmicro-13-zmk)
#:name "redox-neo-nrfmicro-13-zmk"
#:synopsis
"Neo layout ZMK firmware for a Redox shield with nrfmicro-1.3/1.4 board"))