embedded-channel/zephyr/zmk.scm

505 lines
22 KiB
Scheme
Raw Normal View History

(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"))