feat(cl): metronome, quick mode, wave selector, ac-os scan/repl

+67 -1

fedac/native/ac-os

··· 6 6 # ac-os upload Upload current build as OTA release 7 7 # ac-os flash+upload Build + flash USB + upload OTA release 8 8 # ac-os pull Download latest OTA kernel + flash USB (no local build) 9 + # ac-os scan Find AC Native OS devices on local network (Swank port 4005) 10 + # ac-os repl [IP] Connect to a running device's Swank REPL 9 11 set -e 10 12 11 13 SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)" ··· 1249 1251 pull_ota 1250 1252 flash_usb 1251 1253 ;; 1254 + scan) 1255 + SWANK_PORT=4005 1256 + # Get local subnet 1257 + SUBNET=$(ip -4 -o addr show 2>/dev/null | grep -v '127.0.0.1' | head -1 | awk '{print $4}' | sed 's|\.[0-9]*/.*||') 1258 + if [ -z "$SUBNET" ]; then 1259 + err "No network interface found" 1260 + exit 1 1261 + fi 1262 + log "Scanning ${SUBNET}.0/24 for AC Native OS (Swank port ${SWANK_PORT})..." 1263 + FOUND=0 1264 + for i in $(seq 1 254); do 1265 + IP="${SUBNET}.${i}" 1266 + # Parallel TCP probe with short timeout 1267 + (timeout 0.5 bash -c "echo >/dev/tcp/${IP}/${SWANK_PORT}" 2>/dev/null && { 1268 + echo "" 1269 + log " ✦ Found: ${IP}:${SWANK_PORT}" 1270 + echo "" 1271 + echo " Connect: ac-os repl ${IP}" 1272 + echo " Emacs: M-x slime-connect → ${IP} → ${SWANK_PORT}" 1273 + echo "" 1274 + }) & 1275 + done 1276 + wait 1277 + [ "$FOUND" = "0" ] && log "No devices found. Is the CL build on WiFi?" 1278 + ;; 1279 + repl) 1280 + SWANK_IP="${2:-}" 1281 + SWANK_PORT=4005 1282 + if [ -z "$SWANK_IP" ]; then 1283 + # Auto-scan for first device 1284 + SUBNET=$(ip -4 -o addr show 2>/dev/null | grep -v '127.0.0.1' | head -1 | awk '{print $4}' | sed 's|\.[0-9]*/.*||') 1285 + if [ -n "$SUBNET" ]; then 1286 + log "Scanning for device..." 1287 + for i in $(seq 1 254); do 1288 + IP="${SUBNET}.${i}" 1289 + timeout 0.3 bash -c "echo >/dev/tcp/${IP}/${SWANK_PORT}" 2>/dev/null && { 1290 + SWANK_IP="$IP" 1291 + break 1292 + } 1293 + done 1294 + fi 1295 + if [ -z "$SWANK_IP" ]; then 1296 + err "No device found. Usage: ac-os repl <IP>" 1297 + exit 1 1298 + fi 1299 + fi 1300 + log "Connecting to Swank at ${SWANK_IP}:${SWANK_PORT}..." 1301 + # Use rlwrap + netcat for a basic REPL, or sbcl if available 1302 + if command -v sbcl &>/dev/null; then 1303 + sbcl --non-interactive \ 1304 + --eval '(require :asdf)' \ 1305 + --eval '(asdf:load-system :swank-client)' \ 1306 + --eval "(swank-client:slime-connect \"${SWANK_IP}\" ${SWANK_PORT})" \ 1307 + 2>/dev/null || { 1308 + # Fallback: raw Swank protocol via netcat 1309 + log "sbcl swank-client not available, using raw connection" 1310 + exec nc "${SWANK_IP}" "${SWANK_PORT}" 1311 + } 1312 + else 1313 + # Raw Swank protocol — can still eval forms 1314 + log "Tip: install sbcl for a proper REPL experience" 1315 + exec nc "${SWANK_IP}" "${SWANK_PORT}" 1316 + fi 1317 + ;; 1252 1318 *) 1253 - echo "Usage: ac-os {build|flash|upload|flash+upload|bfu|pull|simuflash|test|qemu}" 1319 + echo "Usage: ac-os {build|flash|upload|flash+upload|bfu|pull|scan|repl|simuflash|test|qemu}" 1254 1320 exit 1 1255 1321 ;; 1256 1322 esac

+10

fedac/native/cl/PROGRESS.md

··· 46 46 - [x] Status bar: wave type, octave, FPS counter 47 47 - [x] ESC triple-press to quit 48 48 - [x] Power button to quit 49 + - [x] Quick mode (Shift toggles short attack for staccato) 50 + - [x] Metronome (Space toggle, -/= BPM, clock-synced, pendulum visual) 51 + - [x] Arrow left/right wave switching 52 + - [x] Kill voices on octave/wave change (prevents orphaned notes) 53 + - [x] Wave type selector bar (bottom of screen) 54 + - [x] Swank REPL server (port 4005, auto-start) 55 + - [x] IP address display on screen 56 + - [x] WiFi auto-connect from init (reads saved creds from USB) 57 + - [x] `ac-os scan` and `ac-os repl` commands for remote development 49 58 50 59 ### Build System 51 60 - [x] Docker reproducible build (Dockerfile.builder) ··· 56 65 ## What's Next 57 66 58 67 ### Short Term 68 + - [ ] Audio: mixer unmute verification (silent on some boots) 59 69 - [ ] Audio: sample recording/playback (microphone capture + sample bank) 60 70 - [ ] Audio: echo/room effect 61 71 - [ ] Audio: pitch shift (trackpad or slider)

+223 -139

fedac/native/cl/main.lisp

··· 1 1 ;;; Notepat — AC Native OS musical keyboard instrument (Common Lisp) 2 - ;;; Port of fedac/native/pieces/notepat.mjs core functionality 2 + ;;; Port of fedac/native/pieces/notepat.mjs 3 3 4 4 (in-package :ac-native) 5 5 ··· 24 24 (defvar *chromatic* #("c" "c#" "d" "d#" "e" "f" "f#" "g" "g#" "a" "a#" "b")) 25 25 26 26 (defun note-to-freq (note-name octave) 27 - "Convert note name and octave to frequency in Hz. 28 - A4 = 440Hz. Uses equal temperament." 27 + "Convert note name and octave to frequency in Hz. A4 = 440Hz." 29 28 (let ((idx (position note-name *chromatic* :test #'string=))) 30 29 (if idx 31 30 (* 440.0d0 (expt 2.0d0 (+ (- octave 4) (/ (- idx 9) 12.0d0)))) 32 31 440.0d0))) 33 32 33 + (defun note-is-sharp-p (note-name) 34 + (search "#" note-name)) 35 + 34 36 ;;; ── Note colors (chromatic rainbow) ── 35 37 36 38 (defvar *note-colors* ··· 59 61 (defun init-key-note-map () 60 62 "Populate keycode → note mapping (QWERTY layout matching JS notepat)." 61 63 (clrhash *key-note-map*) 62 - ;; Lower octave naturals 63 - (setf (gethash ac-native.input:+key-c+ *key-note-map*) '("c" . 0)) 64 - (setf (gethash ac-native.input:+key-d+ *key-note-map*) '("d" . 0)) 65 - (setf (gethash ac-native.input:+key-e+ *key-note-map*) '("e" . 0)) 66 - (setf (gethash ac-native.input:+key-f+ *key-note-map*) '("f" . 0)) 67 - (setf (gethash ac-native.input:+key-g+ *key-note-map*) '("g" . 0)) 68 - (setf (gethash ac-native.input:+key-a+ *key-note-map*) '("a" . 0)) 69 - (setf (gethash ac-native.input:+key-b+ *key-note-map*) '("b" . 0)) 70 - ;; Lower octave sharps 71 - (setf (gethash ac-native.input:+key-v+ *key-note-map*) '("c#" . 0)) 72 - (setf (gethash ac-native.input:+key-s+ *key-note-map*) '("d#" . 0)) 73 - (setf (gethash ac-native.input:+key-w+ *key-note-map*) '("f#" . 0)) 74 - (setf (gethash ac-native.input:+key-r+ *key-note-map*) '("g#" . 0)) 75 - (setf (gethash ac-native.input:+key-q+ *key-note-map*) '("a#" . 0)) 76 - ;; Upper octave naturals 77 - (setf (gethash ac-native.input:+key-h+ *key-note-map*) '("c" . 1)) 78 - (setf (gethash ac-native.input:+key-i+ *key-note-map*) '("d" . 1)) 79 - (setf (gethash ac-native.input:+key-j+ *key-note-map*) '("e" . 1)) 80 - (setf (gethash ac-native.input:+key-k+ *key-note-map*) '("f" . 1)) 81 - (setf (gethash ac-native.input:+key-l+ *key-note-map*) '("g" . 1)) 82 - (setf (gethash ac-native.input:+key-m+ *key-note-map*) '("a" . 1)) 83 - (setf (gethash ac-native.input:+key-n+ *key-note-map*) '("b" . 1)) 84 - ;; Upper octave sharps 85 - (setf (gethash ac-native.input:+key-t+ *key-note-map*) '("c#" . 1)) 86 - (setf (gethash ac-native.input:+key-y+ *key-note-map*) '("d#" . 1)) 87 - (setf (gethash ac-native.input:+key-u+ *key-note-map*) '("f#" . 1)) 88 - (setf (gethash ac-native.input:+key-o+ *key-note-map*) '("g#" . 1)) 89 - (setf (gethash ac-native.input:+key-p+ *key-note-map*) '("a#" . 1)) 90 - ;; Extension: +2 octave 91 - (setf (gethash ac-native.input:+key-semicolon+ *key-note-map*) '("c" . 2)) 92 - (setf (gethash ac-native.input:+key-apostrophe+ *key-note-map*) '("c#" . 2)) 93 - (setf (gethash ac-native.input:+key-rightbrace+ *key-note-map*) '("d" . 2)) 94 - ;; Sub-octave 95 - (setf (gethash ac-native.input:+key-z+ *key-note-map*) '("a#" . -1)) 96 - (setf (gethash ac-native.input:+key-x+ *key-note-map*) '("b" . -1))) 64 + (flet ((m (key note off) (setf (gethash key *key-note-map*) (cons note off)))) 65 + ;; Lower octave naturals 66 + (m ac-native.input:+key-c+ "c" 0) (m ac-native.input:+key-d+ "d" 0) 67 + (m ac-native.input:+key-e+ "e" 0) (m ac-native.input:+key-f+ "f" 0) 68 + (m ac-native.input:+key-g+ "g" 0) (m ac-native.input:+key-a+ "a" 0) 69 + (m ac-native.input:+key-b+ "b" 0) 70 + ;; Lower octave sharps 71 + (m ac-native.input:+key-v+ "c#" 0) (m ac-native.input:+key-s+ "d#" 0) 72 + (m ac-native.input:+key-w+ "f#" 0) (m ac-native.input:+key-r+ "g#" 0) 73 + (m ac-native.input:+key-q+ "a#" 0) 74 + ;; Upper octave naturals 75 + (m ac-native.input:+key-h+ "c" 1) (m ac-native.input:+key-i+ "d" 1) 76 + (m ac-native.input:+key-j+ "e" 1) (m ac-native.input:+key-k+ "f" 1) 77 + (m ac-native.input:+key-l+ "g" 1) (m ac-native.input:+key-m+ "a" 1) 78 + (m ac-native.input:+key-n+ "b" 1) 79 + ;; Upper octave sharps 80 + (m ac-native.input:+key-t+ "c#" 1) (m ac-native.input:+key-y+ "d#" 1) 81 + (m ac-native.input:+key-u+ "f#" 1) (m ac-native.input:+key-o+ "g#" 1) 82 + (m ac-native.input:+key-p+ "a#" 1) 83 + ;; Extension +2 84 + (m ac-native.input:+key-semicolon+ "c" 2) 85 + (m ac-native.input:+key-apostrophe+ "c#" 2) 86 + (m ac-native.input:+key-rightbrace+ "d" 2) 87 + ;; Sub-octave 88 + (m ac-native.input:+key-z+ "a#" -1) (m ac-native.input:+key-x+ "b" -1))) 97 89 98 - ;;; ── Wave types ── 90 + ;;; ── State ── 99 91 100 92 (defvar *wave-names* #("sine" "triangle" "sawtooth" "square" "noise")) 101 93 (defvar *wave-index* 0) 102 94 (defvar *octave* 4) 103 - 104 - ;;; ── Active voices and trails ── 95 + (defvar *quick-mode* nil "Short attack/release for staccato play.") 105 96 106 - (defvar *active-voices* (make-hash-table :test 'eql) 107 - "Keycode → voice-id for currently held keys.") 108 - 109 - (defvar *active-notes* (make-hash-table :test 'eql) 110 - "Keycode → (note-name . actual-octave) for currently held keys.") 111 - 112 - (defvar *trails* (make-hash-table :test 'equal) 113 - "note-name → brightness (1.0 → 0.0) for recently released notes.") 97 + ;; Active voices and trails 98 + (defvar *active-voices* (make-hash-table :test 'eql)) 99 + (defvar *active-notes* (make-hash-table :test 'eql)) 100 + (defvar *trails* (make-hash-table :test 'equal)) 114 101 115 - ;;; ── Background color state ── 102 + ;; Background color 103 + (defvar *bg-r* 20) (defvar *bg-g* 20) (defvar *bg-b* 25) 116 104 117 - (defvar *bg-r* 20) 118 - (defvar *bg-g* 20) 119 - (defvar *bg-b* 25) 120 - 121 - ;;; ── FPS tracking ── 122 - 105 + ;; FPS 123 106 (defvar *fps-display* 0) 124 107 (defvar *fps-accum* 0.0d0) 125 108 (defvar *fps-samples* 0) 126 109 (defvar *fps-last-time* 0.0d0) 127 110 128 - ;;; ── ESC triple-press ── 129 - 111 + ;; ESC triple-press 130 112 (defvar *esc-count* 0) 131 113 (defvar *esc-last-frame* 0) 132 114 133 - ;;; ── Network info ── 115 + ;; Metronome 116 + (defvar *metronome-on* nil) 117 + (defvar *metronome-bpm* 120) 118 + (defvar *metronome-last-beat* -1) 119 + (defvar *metronome-flash* 0.0 "Visual flash intensity 0-1, decays per frame.") 120 + (defvar *metronome-phase* 0.0 "Pendulum swing -1..1.") 134 121 135 - (defvar *ip-address* "" "Current IP address for Swank display.") 122 + ;; Network 123 + (defvar *ip-address* "") 136 124 137 125 (defun refresh-ip () 138 - "Read current IP address from system." 139 126 (handler-case 140 127 (let ((output (with-output-to-string (s) 141 128 (sb-ext:run-program "/sbin/ip" '("-4" "-o" "addr" "show") 142 129 :output s :error nil)))) 143 130 (dolist (line (uiop:split-string output :separator '(#\Newline))) 144 - (when (and (search "inet " line) 145 - (not (search "127.0.0.1" line))) 146 - ;; Extract IP from "X: wlan0 inet 192.168.1.x/24 ..." 131 + (when (and (search "inet " line) (not (search "127.0.0.1" line))) 147 132 (let* ((inet-pos (search "inet " line)) 148 133 (ip-start (+ inet-pos 5)) 149 134 (slash-pos (position #\/ line :start ip-start))) ··· 152 137 (return)))))) 153 138 (error () nil))) 154 139 140 + ;;; ── Helpers ── 141 + 142 + (defun kill-all-voices (audio) 143 + "Kill all active voices (on octave/wave change)." 144 + (when audio 145 + (maphash (lambda (code voice-id) 146 + (declare (ignore code)) 147 + (audio-synth-kill audio voice-id)) 148 + *active-voices*)) 149 + (clrhash *active-voices*) 150 + (clrhash *active-notes*)) 151 + 155 152 ;;; ── Main ── 156 153 157 154 (defun main () ··· 162 159 (format *error-output* "════════════════════════════════════~%~%") 163 160 (force-output *error-output*) 164 161 165 - ;; Init key map 166 162 (init-key-note-map) 167 163 168 - ;; Init display 169 164 (let ((display (handler-case (ac-native.drm:drm-init) 170 165 (error (e) 171 166 (format *error-output* "[notepat] DRM error: ~A~%" e) 172 - (force-output *error-output*) 173 - nil)))) 167 + (force-output *error-output*) nil)))) 174 168 (unless display 175 169 (format *error-output* "[notepat] FATAL: no display~%") 176 - (force-output *error-output*) 177 - (sleep 30) 178 - (return-from main 1)) 170 + (force-output *error-output*) (sleep 30) (return-from main 1)) 179 171 180 172 (let* ((dw (ac-native.drm:display-width display)) 181 173 (dh (ac-native.drm:display-height display)) ··· 194 186 (if audio "OK" "FAILED")) 195 187 (force-output *error-output*) 196 188 197 - ;; Font init 198 189 (font-init) 199 190 200 - ;; Start Swank server for remote REPL (port 4005) 191 + ;; Start Swank server for remote REPL 201 192 (handler-case 202 193 (progn 203 194 (setf swank::*communication-style* :spawn) 204 195 (swank:create-server :port 4005 :dont-close t) 205 - (format *error-output* "[notepat] Swank server on port 4005~%") 206 - ;; Log IP address for connection 207 - (handler-case 208 - (let ((output (with-output-to-string (s) 209 - (sb-ext:run-program "/sbin/ip" '("-4" "addr" "show") 210 - :output s :error nil)))) 211 - (dolist (line (uiop:split-string output :separator '(#\Newline))) 212 - (when (search "inet " line) 213 - (format *error-output* "[notepat] ~A~%" (string-trim '(#\Space) line))))) 214 - (error () nil)) 196 + (format *error-output* "[notepat] Swank on :4005~%") 215 197 (force-output *error-output*)) 216 198 (error (e) 217 199 (format *error-output* "[notepat] Swank failed: ~A~%" e) ··· 223 205 (loop while *running* do 224 206 (incf frame) 225 207 226 - ;; FPS tracking 208 + ;; FPS 227 209 (let ((now (monotonic-time-ms))) 228 210 (when (> *fps-last-time* 0.0d0) 229 211 (incf *fps-accum* (- now *fps-last-time*)) ··· 233 215 (setf *fps-accum* 0.0d0 *fps-samples* 0))) 234 216 (setf *fps-last-time* now)) 235 217 218 + ;; ── Metronome tick ── 219 + (when (and *metronome-on* (> *metronome-bpm* 0) audio) 220 + (let* ((now-ms (monotonic-time-ms)) 221 + (ms-per-beat (/ 60000.0d0 *metronome-bpm*)) 222 + (beat-number (floor now-ms ms-per-beat)) 223 + ;; Pendulum: sinusoidal swing over 2-beat period 224 + (beat-phase (/ (mod now-ms (* ms-per-beat 2)) (* ms-per-beat 2)))) 225 + (setf *metronome-phase* (sin (* beat-phase pi 2.0d0))) 226 + (when (/= beat-number *metronome-last-beat*) 227 + (setf *metronome-last-beat* beat-number) 228 + (setf *metronome-flash* 1.0) 229 + (let ((downbeat (zerop (mod beat-number 4)))) 230 + (audio-synth audio :type 3 ; square 231 + :tone (if downbeat 1200.0d0 800.0d0) 232 + :duration 0.03d0 233 + :volume (if downbeat 0.4d0 0.25d0) 234 + :attack 0.001d0 :decay 0.02d0))))) 235 + 236 + ;; Decay metronome flash 237 + (when (> *metronome-flash* 0.0) 238 + (decf *metronome-flash* 0.15) 239 + (when (< *metronome-flash* 0.0) (setf *metronome-flash* 0.0))) 240 + 236 241 ;; ── Input ── 237 242 (dolist (ev (ac-native.input:input-poll input)) 238 243 (let ((type (ac-native.input:event-type ev)) 239 244 (code (ac-native.input:event-code ev))) 240 245 241 - ;; ── Key down ── 242 246 (when (eq type :key-down) 243 247 ;; ESC: triple-press to quit 244 248 (when (= code ac-native.input:+key-esc+) 245 - (if (> (- frame *esc-last-frame*) 90) 246 - (setf *esc-count* 0)) 249 + (when (> (- frame *esc-last-frame*) 90) (setf *esc-count* 0)) 247 250 (incf *esc-count*) 248 251 (setf *esc-last-frame* frame) 249 252 (when (and audio (< *esc-count* 3)) 250 - (audio-synth audio :type 3 ; square 253 + (audio-synth audio :type 3 251 254 :tone (if (= *esc-count* 1) 440.0d0 660.0d0) 252 255 :duration 0.08d0 :volume 0.15d0 253 256 :attack 0.002d0 :decay 0.06d0)) 254 - (when (>= *esc-count* 3) 255 - (setf *running* nil))) 257 + (when (>= *esc-count* 3) (setf *running* nil))) 256 258 257 - ;; Power button 258 - (when (= code ac-native.input:+key-power+) 259 - (setf *running* nil)) 259 + ;; Power 260 + (when (= code ac-native.input:+key-power+) (setf *running* nil)) 261 + 262 + ;; Shift: toggle quick mode 263 + (when (= code 42) ; KEY_LEFTSHIFT 264 + (setf *quick-mode* (not *quick-mode*))) 265 + 266 + ;; Space: toggle metronome 267 + (when (= code ac-native.input:+key-space+) 268 + (setf *metronome-on* (not *metronome-on*)) 269 + (when *metronome-on* 270 + (setf *metronome-last-beat* -1))) 271 + 272 + ;; Minus / Equal: BPM control 273 + (when (= code ac-native.input:+key-minus+) 274 + (setf *metronome-bpm* (max 20 (- *metronome-bpm* 5)))) 275 + (when (= code ac-native.input:+key-equal+) 276 + (setf *metronome-bpm* (min 300 (+ *metronome-bpm* 5)))) 260 277 261 - ;; Number keys: set octave 278 + ;; Number keys: set octave (kills active voices) 262 279 (when (and (>= code ac-native.input:+key-1+) 263 280 (<= code ac-native.input:+key-9+)) 264 - (setf *octave* (1+ (- code ac-native.input:+key-1+)))) 281 + (let ((new-oct (1+ (- code ac-native.input:+key-1+)))) 282 + (unless (= new-oct *octave*) 283 + (kill-all-voices audio) 284 + (setf *octave* new-oct)))) 265 285 266 286 ;; Arrow up/down: octave 267 287 (when (= code ac-native.input:+key-up+) 268 - (setf *octave* (min 9 (1+ *octave*)))) 288 + (when (< *octave* 9) 289 + (kill-all-voices audio) 290 + (incf *octave*))) 269 291 (when (= code ac-native.input:+key-down+) 270 - (setf *octave* (max 1 (1- *octave*)))) 292 + (when (> *octave* 1) 293 + (kill-all-voices audio) 294 + (decf *octave*))) 271 295 272 - ;; Tab: cycle wave type 273 - (when (= code ac-native.input:+key-tab+) 296 + ;; Tab / Arrow left/right: cycle wave type 297 + (when (or (= code ac-native.input:+key-tab+) 298 + (= code ac-native.input:+key-right+)) 299 + (kill-all-voices audio) 274 300 (setf *wave-index* (mod (1+ *wave-index*) 5)) 275 - ;; Confirmation blip 301 + (when audio 302 + (let ((tones #(660.0d0 550.0d0 440.0d0 330.0d0 220.0d0))) 303 + (audio-synth audio :type *wave-index* 304 + :tone (aref tones *wave-index*) 305 + :duration 0.07d0 :volume 0.18d0 306 + :attack 0.002d0 :decay 0.06d0)))) 307 + (when (= code ac-native.input:+key-left+) 308 + (kill-all-voices audio) 309 + (setf *wave-index* (mod (+ *wave-index* 4) 5)) 276 310 (when audio 277 311 (let ((tones #(660.0d0 550.0d0 440.0d0 330.0d0 220.0d0))) 278 312 (audio-synth audio :type *wave-index* ··· 282 316 283 317 ;; Note keys 284 318 (let ((mapping (gethash code *key-note-map*))) 285 - (when (and mapping 286 - (not (gethash code *active-voices*)) 287 - audio) 319 + (when (and mapping (not (gethash code *active-voices*)) audio) 288 320 (let* ((note-name (car mapping)) 289 321 (oct-delta (cdr mapping)) 290 322 (actual-octave (+ *octave* oct-delta)) 291 323 (freq (note-to-freq note-name actual-octave)) 292 - ;; Pan: lower notes left, higher notes right 293 324 (idx (position note-name *chromatic* :test #'string=)) 294 325 (semitones (+ (* (- actual-octave 4) 12) (or idx 0))) 295 326 (pan (max -0.8d0 (min 0.8d0 (/ (- semitones 12) 15.0d0)))) 327 + (attack (if *quick-mode* 0.002d0 0.005d0)) 296 328 (voice-id (audio-synth audio 297 329 :type *wave-index* 298 330 :tone freq 299 331 :volume 0.7d0 300 - :duration 0 ; sustain 301 - :attack 0.005d0 332 + :duration 0 333 + :attack attack 302 334 :decay 0.1d0 303 335 :pan pan))) 304 336 (setf (gethash code *active-voices*) voice-id) 305 337 (setf (gethash code *active-notes*) 306 338 (cons note-name actual-octave)))))) 307 339 308 - ;; ── Key up ── 340 + ;; Key up 309 341 (when (eq type :key-up) 310 342 (let ((voice-id (gethash code *active-voices*))) 311 343 (when (and voice-id audio) 312 344 (audio-synth-kill audio voice-id) 313 345 (remhash code *active-voices*) 314 - ;; Start trail 315 346 (let ((note-info (gethash code *active-notes*))) 316 347 (when note-info 317 348 (setf (gethash note-info *trails*) 1.0) ··· 327 358 *trails*) 328 359 (dolist (n dead) (remhash n *trails*))) 329 360 330 - ;; ── Compute background color from active notes ── 361 + ;; ── Background color from active notes ── 331 362 (let ((n (hash-table-count *active-notes*))) 332 363 (if (> n 0) 333 364 (let ((tr 0) (tg 0) (tb 0)) ··· 338 369 (incf tg (second rgb)) 339 370 (incf tb (third rgb)))) 340 371 *active-notes*) 341 - ;; Lerp toward target (darkened) 342 372 (let ((target-r (floor (* (floor tr n) 35) 100)) 343 373 (target-g (floor (* (floor tg n) 35) 100)) 344 374 (target-b (floor (* (floor tb n) 35) 100))) 345 375 (setf *bg-r* (+ *bg-r* (floor (- target-r *bg-r*) 4))) 346 376 (setf *bg-g* (+ *bg-g* (floor (- target-g *bg-g*) 4))) 347 377 (setf *bg-b* (+ *bg-b* (floor (- target-b *bg-b*) 4))))) 348 - ;; Decay to dark 349 378 (progn 350 379 (setf *bg-r* (+ *bg-r* (floor (- 20 *bg-r*) 8))) 351 380 (setf *bg-g* (+ *bg-g* (floor (- 20 *bg-g*) 8))) 352 381 (setf *bg-b* (+ *bg-b* (floor (- 25 *bg-b*) 8)))))) 353 382 354 - ;; ── Paint ── 383 + ;; Metronome flash brightens background 384 + (when (> *metronome-flash* 0.0) 385 + (let ((boost (floor (* *metronome-flash* 40)))) 386 + (setf *bg-r* (min 255 (+ *bg-r* boost))) 387 + (setf *bg-g* (min 255 (+ *bg-g* boost))) 388 + (setf *bg-b* (min 255 (+ *bg-b* boost))))) 389 + 390 + ;; ══════════════ PAINT ══════════════ 355 391 (graph-wipe graph (make-color :r *bg-r* :g *bg-g* :b *bg-b*)) 356 392 357 - ;; Draw trails — horizontal bars per note+octave 393 + ;; ── Trails ── 358 394 (maphash (lambda (trail-key val) 359 - ;; trail-key is (note-name . octave) 360 395 (let* ((note-name (car trail-key)) 361 396 (oct (cdr trail-key)) 362 397 (rgb (note-color-rgb note-name)) 363 398 (note-idx (or (position note-name *chromatic* :test #'string=) 0)) 364 - ;; Unique Y per note+octave: semitone index relative to octave 1 365 399 (semi (+ (* (- oct 1) 12) note-idx)) 366 - (total-semitones (* 9 12)) ; octaves 1-9 400 + (total-semitones (* 9 12)) 367 401 (bar-h (max 2 (floor (- sh 30) total-semitones))) 368 402 (bar-y (+ 14 (floor (* semi (- sh 30)) total-semitones))) 369 403 (bar-w (max 1 (floor (* val sw)))) ··· 376 410 (graph-box graph bar-x bar-y bar-w bar-h))) 377 411 *trails*) 378 412 379 - ;; Draw active note indicators — bright bars 413 + ;; ── Active note bars ── 380 414 (maphash (lambda (code note-info) 381 415 (declare (ignore code)) 382 416 (let* ((note-name (car note-info)) ··· 394 428 (graph-box graph 0 bar-y sw bar-h))) 395 429 *active-notes*) 396 430 397 - ;; Status bar (bottom) 398 - (let ((status (format nil "~A OCT:~D ~Dfps" 399 - (aref *wave-names* *wave-index*) 400 - *octave* 401 - *fps-display*))) 402 - (graph-ink graph (make-color :r 180 :g 180 :b 180 :a 200)) 403 - (font-draw graph status 3 (- sh 12))) 431 + ;; ── Metronome pendulum ── 432 + (when *metronome-on* 433 + (let* ((cx (floor sw 2)) 434 + (cy (- sh 24)) 435 + (arm-len (min 20 (floor sh 8))) 436 + (bx (+ cx (floor (* *metronome-phase* arm-len)))) 437 + (bright (floor (* *metronome-flash* 255)))) 438 + ;; Arm line 439 + (graph-ink graph (make-color :r 180 :g 180 :b 180 :a 120)) 440 + (graph-line graph cx cy bx (- cy arm-len)) 441 + ;; Bob 442 + (graph-ink graph (make-color :r (min 255 (+ 180 bright)) 443 + :g (min 255 (+ 100 bright)) 444 + :b 60 :a 220)) 445 + (graph-circle graph bx (- cy arm-len) 3))) 404 446 405 - ;; "notepat" title (top-left, dim) 447 + ;; ── Wave type indicators (bottom bar) ── 448 + (let* ((bar-y (- sh 14)) 449 + (btn-w (max 12 (floor sw 6))) 450 + (gap 2) 451 + (total-w (+ (* 5 btn-w) (* 4 gap))) 452 + (start-x (floor (- sw total-w) 2))) 453 + (dotimes (i 5) 454 + (let* ((bx (+ start-x (* i (+ btn-w gap)))) 455 + (selected (= i *wave-index*)) 456 + (col (if selected 457 + (make-color :r 255 :g 255 :b 255 :a 200) 458 + (make-color :r 100 :g 100 :b 110 :a 140)))) 459 + ;; Button background 460 + (if selected 461 + (progn 462 + (graph-ink graph (make-color :r 60 :g 50 :b 80 :a 200)) 463 + (graph-box graph bx bar-y btn-w 12)) 464 + (progn 465 + (graph-ink graph (make-color :r 30 :g 28 :b 35 :a 150)) 466 + (graph-box graph bx bar-y btn-w 12))) 467 + ;; Wave name (abbreviated to 3 chars) 468 + (graph-ink graph col) 469 + (let ((abbr (subseq (aref *wave-names* i) 0 (min 3 (length (aref *wave-names* i)))))) 470 + (font-draw graph abbr 471 + (+ bx (floor (- btn-w (* (length abbr) 6)) 2)) 472 + (+ bar-y 2)))))) 473 + 474 + ;; ── Status text ── 475 + ;; Top-left: piece name + mode indicators 406 476 (graph-ink graph (make-color :r 100 :g 100 :b 110 :a 150)) 407 477 (font-draw graph "notepat" 3 3) 408 478 409 - ;; Active voice count (top-right) 479 + ;; Quick mode indicator 480 + (when *quick-mode* 481 + (graph-ink graph (make-color :r 255 :g 200 :b 50 :a 200)) 482 + (font-draw graph "Q" (+ 3 (* 8 6)) 3)) 483 + 484 + ;; Octave (top-left, below title) 485 + (graph-ink graph (make-color :r 160 :g 160 :b 170 :a 180)) 486 + (font-draw graph (format nil "OCT ~D" *octave*) 3 14) 487 + 488 + ;; Metronome BPM (if on) 489 + (when *metronome-on* 490 + (graph-ink graph (make-color :r 180 :g 140 :b 60 :a 200)) 491 + (font-draw graph (format nil "~DBPM" *metronome-bpm*) 492 + (+ 3 (* 7 6)) 14)) 493 + 494 + ;; FPS (top-right) 495 + (let ((fps-txt (format nil "~D" *fps-display*))) 496 + (graph-ink graph (make-color :r 80 :g 80 :b 90 :a 120)) 497 + (font-draw graph fps-txt (- sw (* (length fps-txt) 6) 3) 3)) 498 + 499 + ;; Voice count (top-right, below FPS) 410 500 (let ((vc (hash-table-count *active-voices*))) 411 501 (when (> vc 0) 412 - (let ((txt (format nil "~D" vc))) 502 + (let ((txt (format nil "~Dv" vc))) 413 503 (graph-ink graph (make-color :r 200 :g 200 :b 200 :a 180)) 414 - (font-draw graph txt (- sw (* (length txt) 6) 3) 3)))) 504 + (font-draw graph txt (- sw (* (length txt) 6) 3) 14)))) 415 505 416 - ;; IP + Swank indicator (top, centered) 506 + ;; IP + Swank (top center) 417 507 (when (> (length *ip-address*) 0) 418 508 (let ((txt (format nil "~A:4005" *ip-address*))) 419 509 (graph-ink graph (make-color :r 60 :g 180 :b 60 :a 160)) 420 510 (font-draw graph txt (- (floor sw 2) (floor (font-measure txt) 2)) 3))) 421 511 422 - ;; Refresh IP every ~5 seconds (300 frames) 423 - (when (zerop (mod frame 300)) 424 - (refresh-ip)) 512 + ;; Refresh IP every ~5 seconds 513 + (when (zerop (mod frame 300)) (refresh-ip)) 425 514 426 515 ;; ── Present ── 427 516 (ac-native.drm:drm-present display screen scale) 428 517 (frame-sync-60fps)) 429 518 430 519 ;; ── Cleanup ── 431 - ;; Kill all active voices 432 - (when audio 433 - (maphash (lambda (code voice-id) 434 - (declare (ignore code)) 435 - (audio-synth-kill audio voice-id)) 436 - *active-voices*) 437 - (audio-destroy audio)) 520 + (kill-all-voices audio) 521 + (when audio (audio-destroy audio)) 438 522 (ac-native.input:input-destroy input) 439 523 (fb-destroy screen) 440 524 (ac-native.drm:drm-destroy display)

Configure Feed

Configure Feed