Something went wrong. Try again.
Monorepo for Aesthetic.Computer aesthetic.computer
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866;;; Notepat — AC Native OS musical keyboard instrument (Common Lisp);;; Port of fedac/native/pieces/notepat.mjs
(in-package :ac-native)
(defvar *running* t "Main loop flag.")
;;; ── Pixel scale ──
(defun compute-pixel-scale (display-w) "Compute pixel scale targeting ~200px wide (bigger pixels)." (let ((target (max 1 (min 16 (floor display-w 200))))) (loop for delta from 0 to 3 do (let ((s (+ target delta))) (when (and (>= s 1) (<= s 16) (zerop (mod display-w s))) (return-from compute-pixel-scale s))) (let ((s (- target delta))) (when (and (>= s 1) (zerop (mod display-w s))) (return-from compute-pixel-scale s)))) target))
;;; ── Music theory ──
(defvar *chromatic* #("c" "c#" "d" "d#" "e" "f" "f#" "g" "g#" "a" "a#" "b"))
(defun note-to-freq (note-name octave) "Convert note name and octave to frequency in Hz. A4 = 440Hz." (let ((idx (position note-name *chromatic* :test #'string=))) (if idx (* 440.0d0 (expt 2.0d0 (+ (- octave 4) (/ (- idx 9) 12.0d0)))) 440.0d0)))
(defun note-is-sharp-p (note-name) (search "#" note-name))
;;; ── Note colors (chromatic rainbow) ──
(defvar *note-colors* '(("c" 255 30 30) ; red ("c#" 255 80 0) ; red-orange ("d" 255 150 0) ; orange ("d#" 200 200 0) ; yellow-green ("e" 230 220 0) ; yellow ("f" 30 200 30) ; green ("f#" 0 200 180) ; teal ("g" 30 100 255) ; blue ("g#" 80 50 255) ; indigo ("a" 140 30 220) ; purple ("a#" 200 30 150) ; magenta ("b" 200 50 255))) ; violet
(defun note-color-rgb (note-name) "Return (r g b) list for a note name." (let ((entry (assoc note-name *note-colors* :test #'string=))) (if entry (cdr entry) '(80 80 80))))
;;; ── Keyboard mapping: evdev keycode → (note-name . octave-offset) ──
(defvar *key-note-map* (make-hash-table :test 'eql))
(defun init-key-note-map () "Populate keycode → note mapping (QWERTY layout matching JS notepat)." (clrhash *key-note-map*) (flet ((m (key note off) (setf (gethash key *key-note-map*) (cons note off)))) ;; Lower octave naturals (m ac-native.input:+key-c+ "c" 0) (m ac-native.input:+key-d+ "d" 0) (m ac-native.input:+key-e+ "e" 0) (m ac-native.input:+key-f+ "f" 0) (m ac-native.input:+key-g+ "g" 0) (m ac-native.input:+key-a+ "a" 0) (m ac-native.input:+key-b+ "b" 0) ;; Lower octave sharps (m ac-native.input:+key-v+ "c#" 0) (m ac-native.input:+key-s+ "d#" 0) (m ac-native.input:+key-w+ "f#" 0) (m ac-native.input:+key-r+ "g#" 0) (m ac-native.input:+key-q+ "a#" 0) ;; Upper octave naturals (m ac-native.input:+key-h+ "c" 1) (m ac-native.input:+key-i+ "d" 1) (m ac-native.input:+key-j+ "e" 1) (m ac-native.input:+key-k+ "f" 1) (m ac-native.input:+key-l+ "g" 1) (m ac-native.input:+key-m+ "a" 1) (m ac-native.input:+key-n+ "b" 1) ;; Upper octave sharps (m ac-native.input:+key-t+ "c#" 1) (m ac-native.input:+key-y+ "d#" 1) (m ac-native.input:+key-u+ "f#" 1) (m ac-native.input:+key-o+ "g#" 1) (m ac-native.input:+key-p+ "a#" 1) ;; Extension +2 (m ac-native.input:+key-semicolon+ "c" 2) (m ac-native.input:+key-apostrophe+ "c#" 2) (m ac-native.input:+key-rightbrace+ "d" 2) ;; Sub-octave (m ac-native.input:+key-z+ "a#" -1) (m ac-native.input:+key-x+ "b" -1)))
;;; ── State ──
(defvar *wave-names* #("sine" "triangle" "sawtooth" "square" "noise"))(defvar *wave-index* 0)(defvar *octave* 4)(defvar *quick-mode* nil "Short attack/release for staccato play.")
;; Active voices and trails(defvar *active-voices* (make-hash-table :test 'eql))(defvar *active-notes* (make-hash-table :test 'eql))(defvar *trails* (make-hash-table :test 'equal))
;; Background color(defvar *bg-r* 20) (defvar *bg-g* 20) (defvar *bg-b* 25)
;; FPS(defvar *fps-display* 0)(defvar *fps-accum* 0.0d0)(defvar *fps-samples* 0)(defvar *fps-last-time* 0.0d0)
;; ESC triple-press(defvar *esc-count* 0)(defvar *esc-last-frame* 0)
;; Metronome(defvar *metronome-on* nil)(defvar *metronome-bpm* 120)(defvar *metronome-last-beat* -1)(defvar *metronome-flash* 0.0 "Visual flash intensity 0-1, decays per frame.")(defvar *metronome-phase* 0.0 "Pendulum swing -1..1.")
;; Identity(defvar *boot-handle* nil "Handle from config, set during boot splash.")
;; Native notepat runtime state (defvar — SBCL standalone loses let* locals)(defvar *np-dw* 0)(defvar *np-dh* 0)(defvar *np-scale* 1)(defvar *np-sw* 0)(defvar *np-sh* 0)(defvar *np-screen* nil)(defvar *np-graph* nil)(defvar *np-input* nil)(defvar *np-audio* nil)(defvar *np-frame* 0)(defvar *np-display* nil)
;; Network(defvar *ip-address* "")
(defun refresh-ip () (handler-case (let ((output (with-output-to-string (s) (sb-ext:run-program "/sbin/ip" '("-4" "-o" "addr" "show") :output s :error nil)))) (dolist (line (uiop:split-string output :separator '(#\Newline))) (when (and (search "inet " line) (not (search "127.0.0.1" line))) (let* ((inet-pos (search "inet " line)) (ip-start (+ inet-pos 5)) (slash-pos (position #\/ line :start ip-start))) (when slash-pos (setf *ip-address* (subseq line ip-start slash-pos)) (return)))))) (error () nil)))
;;; ── Helpers ──
(defun kill-all-voices (audio) "Kill all active voices (on octave/wave change)." (when audio (maphash (lambda (code voice-id) (declare (ignore code)) (audio-synth-kill audio voice-id)) *active-voices*)) (clrhash *active-voices*) (clrhash *active-notes*))
;;; ── Build metadata ──
(defvar *build-name* "dev" "Build name from /etc/ac-build.")(defvar *build-variant* "c" "Build variant: c or cl.")
(defun load-build-metadata () "Read /etc/ac-build: line 1=name, 2=hash, 3=timestamp, 4=variant." (handler-case (when (probe-file "/etc/ac-build") (with-open-file (s "/etc/ac-build" :direction :input) (let ((name (read-line s nil nil)) (hash (read-line s nil nil)) (ts (read-line s nil nil)) (variant (read-line s nil nil))) (declare (ignore hash ts)) (when name (setf *build-name* name)) (when variant (setf *build-variant* variant))))) (error () nil)))
;;; ── Boot splash ──
(defun time-greeting () "Return time-of-day greeting string." (let ((hour (nth-value 2 (get-decoded-time)))) (cond ((and (>= hour 5) (< hour 12)) "good morning") ((and (>= hour 12) (< hour 17)) "good afternoon") (t "good evening"))))
;;; ── JS Piece Runner ──
(defun main-js (piece-path) "Run a .mjs piece via the QuickJS bridge." (format *error-output* "~%════════════════════════════════════~%") (format *error-output* " AC Native OS (Common Lisp + QuickJS)~%") (format *error-output* " SBCL ~A~%" (lisp-implementation-version)) (format *error-output* " piece: ~A~%" piece-path) (format *error-output* "════════════════════════════════════~%~%") (force-output *error-output*)
(let ((display (handler-case (ac-native.drm:drm-init) (error (e) (format *error-output* "[js] DRM error: ~A~%" e) (force-output *error-output*) nil)))) (unless display (format *error-output* "[js] FATAL: no display~%") (force-output *error-output*) (sleep 30) (return-from main-js 1))
(let* ((dw (ac-native.drm:display-width display)) (dh (ac-native.drm:display-height display)) (scale (compute-pixel-scale dw)) (sw (floor dw scale)) (sh (floor dh scale)) (screen (fb-create sw sh)) (graph (make-graph :fb screen :screen screen)) (input (ac-native.input:input-init dw dh scale)) (audio (ac-native.audio:audio-init)) (frame 0))
(font-init)
;; Initialize QuickJS bridge (handler-case (js-init graph screen audio sw sh) (error (e) (format *error-output* "[js] JS-INIT ERROR: ~A~%" e) (force-output *error-output*) (when audio (audio-destroy audio)) (ac-native.input:input-destroy input) (fb-destroy screen) (ac-native.drm:drm-destroy display) (setf *js-fallback* t) (return-from main-js (main))))
;; Load the piece (unless (js-load-piece piece-path) (format *error-output* "[js] Failed to load piece, falling back to native notepat~%") (force-output *error-output*) (js-destroy) ;; Cleanup and fall through to native (when audio (audio-destroy audio)) (ac-native.input:input-destroy input) (fb-destroy screen) (ac-native.drm:drm-destroy display) (setf *js-fallback* t) (return-from main-js (main)))
;; Call boot (js-boot)
;; Start Swank (handler-case (progn (setf swank::*communication-style* :spawn) (swank:create-server :port 4005 :dont-close t) (format *error-output* "[js] Swank on :4005~%") (force-output *error-output*)) (error (e) (format *error-output* "[js] Swank failed: ~A~%" e) (force-output *error-output*)))
;; Main loop (setf *running* t) (unwind-protect (loop while *running* do (incf frame)
;; Input → act (dolist (ev (ac-native.input:input-poll input)) (let ((type (ac-native.input:event-type ev)) (code (ac-native.input:event-code ev)) (key (ac-native.input:event-key ev))) ;; ESC triple-press to quit (when (and (eq type :key-down) (= code ac-native.input:+key-esc+)) (when (> (- frame *esc-last-frame*) 90) (setf *esc-count* 0)) (incf *esc-count*) (setf *esc-last-frame* frame) (when (>= *esc-count* 3) (setf *running* nil))) ;; Power button (when (and (eq type :key-down) (= code ac-native.input:+key-power+)) (setf *running* nil)) ;; Pass to JS (js-act (if (eq type :key-down) 1 0) (or key "") code)))
;; sim (js-sim)
;; paint (js-paint frame)
;; Check for jump or poweroff from JS (when ac-native.js-bridge::*poweroff-requested* (setf *running* nil)) (when ac-native.js-bridge::*jump-target* ;; TODO: reload piece (format *error-output* "[js] jump to ~A (not yet implemented)~%" ac-native.js-bridge::*jump-target*) (force-output *error-output*) (setf ac-native.js-bridge::*jump-target* nil))
;; Present (ac-native.drm:drm-present display screen scale) (frame-sync-60fps))
;; Cleanup (js-destroy) (when audio (audio-destroy audio)) (ac-native.input:input-destroy input) (fb-destroy screen) (ac-native.drm:drm-destroy display) (format *error-output* "[js] shutdown~%") (force-output *error-output*)))))
;;; ── Main ──
(defvar *js-fallback* nil "Set to T when falling back from JS to prevent re-entry loop.")
(defun run-cl-piece (paint-fn piece-name) "Run a CL piece with DRM graphics, audio, and input. PAINT-FN is called each frame." (format *error-output* "~%════════════════════════════════════~%") (format *error-output* " ~A (Common Lisp)~%" piece-name) (format *error-output* "════════════════════════════════════~%~%") (force-output *error-output*) (let ((display (ac-native.drm:drm-init))) (unless display (return-from run-cl-piece)) (let* ((dw (ac-native.drm:display-width display)) (dh (ac-native.drm:display-height display)) (scale (cond ((>= (min dw dh) 1440) 6) ((>= (min dw dh) 1080) 4) ((>= (min dw dh) 720) 3) (t 2))) (sw (floor dw scale)) (sh (floor dh scale)) (screen (ac-native.framebuffer:fb-create sw sh)) (graph (ac-native.graph:graph-create screen)) (input (ac-native.input:input-init dw dh scale)) (audio (ac-native.audio:audio-init))) (unwind-protect (loop ;; Input (ac-native.input:input-poll input) (dotimes (i (ac-native.input:input-event-count input)) (let ((ev (ac-native.input:input-event input i))) (when (and (= (ac-native.input:event-type ev) 1) (= (ac-native.input:event-code ev) 1)) (return)))) ; ESC ;; Paint (handler-case (funcall paint-fn graph sw sh audio) (error (e) (format *error-output* "[piece] error: ~A~%" e) (force-output *error-output*))) ;; Present (ac-native.drm:drm-present display screen scale) (sleep 1/60)) ;; Cleanup (when audio (ac-native.audio:audio-destroy audio)) (ac-native.input:input-destroy input) (ac-native.framebuffer:fb-destroy screen) (ac-native.drm:drm-destroy display)))))
(defun main () "AC Native OS entry point. Runs .mjs pieces via QuickJS or native CL notepat.When called with --swank-only, starts Swank server and blocks (no graphics)." ;; Swank-only mode: just start the REPL server and sleep forever (when (member "--swank-only" (uiop:command-line-arguments) :test #'string=) (format *error-output* "[swank] Starting Swank server on port 4005...~%") (force-output *error-output*) (handler-case (progn (setf swank::*communication-style* :spawn) (swank:create-server :port 4005 :dont-close t) (format *error-output* "[swank] Swank ready on port 4005~%") (force-output *error-output*) ;; Block forever — Swank handles connections in its own threads (loop (sleep 3600))) (error (e) (format *error-output* "[swank] Failed: ~A~%" e) (force-output *error-output*) (return-from main))))
;; --piece MODE: run a specific CL piece with graphics (launched by C binary) (let ((piece-arg (second (member "--piece" (uiop:command-line-arguments) :test #'string=)))) (when piece-arg (format *error-output* "[cl] Running CL piece: ~A~%" piece-arg) (force-output *error-output*) ;; Try to load the piece file and run its paint function (let ((piece-path (format nil "/pieces/~A.lisp" piece-arg))) (when (probe-file piece-path) (handler-case (progn (load piece-path) (let ((paint-fn (find-symbol "PAINT" (find-package (intern (string-upcase (format nil "PIECE.~A" piece-arg)) :keyword))))) (when (and paint-fn (fboundp paint-fn)) (return-from main (run-cl-piece paint-fn piece-arg))))) (error (e) (format *error-output* "[cl] Error loading ~A: ~A~%" piece-path e) (force-output *error-output*))))) ;; Fallback to native CL notepat (setf *js-fallback* t)))
;; Determine piece: config.json > command-line arg > default (unless *js-fallback* (let* ((cfg (handler-case (ac-native.config:load-config) (error () (ac-native.config:make-config)))) (config-piece (ac-native.config:config-piece cfg)) (args (uiop:command-line-arguments)) (piece-name (or config-piece (when args (first args)) "notepat")) (piece-path (if (search "/" piece-name) piece-name ; already a path (format nil "/pieces/~A.mjs" piece-name)))) (when (probe-file piece-path) (return-from main (main-js piece-path))))) (setf *js-fallback* nil)
;; No .mjs piece specified — fall back to native CL notepat (format *error-output* "~%════════════════════════════════════~%") (format *error-output* " notepat (Common Lisp)~%") (format *error-output* " SBCL ~A~%" (lisp-implementation-version)) (format *error-output* "════════════════════════════════════~%~%") (force-output *error-output*)
(init-key-note-map)
(setf *np-display* (handler-case (ac-native.drm:drm-init) (error (e) (format *error-output* "[notepat] DRM error: ~A~%" e) (force-output *error-output*) nil))) (unless *np-display* (format *error-output* "[notepat] FATAL: no display~%") (force-output *error-output*) (sleep 30) (return-from main 1))
(setf *np-dw* (ac-native.drm:display-width *np-display*) *np-dh* (ac-native.drm:display-height *np-display*) *np-scale* (compute-pixel-scale *np-dw*) *np-sw* (floor *np-dw* *np-scale*) *np-sh* (floor *np-dh* *np-scale*) *np-screen* (fb-create *np-sw* *np-sh*) *np-graph* (make-graph :fb *np-screen* :screen *np-screen*) *np-input* (ac-native.input:input-init *np-dw* *np-dh* *np-scale*) *np-audio* (ac-native.audio:audio-init) *np-frame* 0) (progn
(format *error-output* "[notepat] ~Dx~D scale:~D → ~Dx~D~%" *np-dw* *np-dh* *np-scale* *np-sw* *np-sh*) (format *error-output* "[notepat] audio: ~A~%" (if *np-audio* "OK" "FAILED")) (force-output *error-output*)
(font-init) (load-build-metadata)
;; ── Boot splash ── (let* ((cfg (ac-native.config:load-config)) (handle (ac-native.config:config-handle cfg)) (has-handle (and handle (string/= handle "") (string/= handle "unknown"))) (greeting (time-greeting)) (splash-start (monotonic-time-ms))) ;; Write tokens (handler-case (ac-native.config:write-device-tokens cfg) (error (e) (format *error-output* "[notepat] token write error: ~A~%" e) (force-output *error-output*))) ;; Store handle for status display (setf *boot-handle* (if has-handle handle nil)) ;; Show splash for 3 seconds or until keypress (loop while (< (- (monotonic-time-ms) splash-start) 3000) do (let ((events (ac-native.input:input-poll *np-input*))) (when (some (lambda (ev) (eq (ac-native.input:event-type ev) :key-down)) events) (return))) ;; Paint splash (graph-wipe *np-graph* (make-color :r 10 :g 12 :b 18)) (let ((cy (floor *np-sh* 3))) (if has-handle (progn ;; Greeting (graph-ink *np-graph* (make-color :r 140 :g 160 :b 200 :a 220)) (font-draw *np-graph* greeting (- (floor *np-sw* 2) (floor (font-measure greeting) 2)) cy) ;; @handle (let ((htxt (format nil "@~A" handle))) (graph-ink *np-graph* (make-color :r 80 :g 255 :b 140 :a 255)) (font-draw *np-graph* htxt (- (floor *np-sw* 2) (floor (font-measure htxt) 2)) (+ cy 14))) ;; Subtitle (graph-ink *np-graph* (make-color :r 80 :g 80 :b 100 :a 160)) (font-draw *np-graph* "aesthetic.computer" (- (floor *np-sw* 2) (floor (font-measure "aesthetic.computer") 2)) (+ cy 32))) (progn ;; No handle: just show name (graph-ink *np-graph* (make-color :r 80 :g 255 :b 140 :a 255)) (font-draw *np-graph* "aesthetic.computer" (- (floor *np-sw* 2) (floor (font-measure "aesthetic.computer") 2)) cy) (graph-ink *np-graph* (make-color :r 140 :g 160 :b 200 :a 180)) (font-draw *np-graph* "notepat" (- (floor *np-sw* 2) (floor (font-measure "notepat") 2)) (+ cy 18))))) ;; Build name (bottom center) (graph-ink *np-graph* (make-color :r 60 :g 60 :b 80 :a 120)) (font-draw *np-graph* *build-name* (- (floor *np-sw* 2) (floor (font-measure *build-name*) 2)) (- *np-sh* 20)) ;; LISP tag (top right) when CL variant (when (string= *build-variant* "cl") (graph-ink *np-graph* (make-color :r 255 :g 200 :b 80 :a 200)) (font-draw *np-graph* "LISP" (- *np-sw* (font-measure "LISP") 6) 6))) (ac-native.drm:drm-present *np-display* *np-screen* *np-scale*) (frame-sync-60fps)))
;; Start Swank server for remote REPL (handler-case (progn (setf swank::*communication-style* :spawn) (swank:create-server :port 4005 :dont-close t) (format *error-output* "[notepat] Swank on :4005~%") (force-output *error-output*)) (error (e) (format *error-output* "[notepat] Swank failed: ~A~%" e) (force-output *error-output*)))
;; Main loop (setf *running* t) (unwind-protect (loop while *running* do (incf *np-frame*)
;; FPS (let ((now (monotonic-time-ms))) (when (> *fps-last-time* 0.0d0) (incf *fps-accum* (- now *fps-last-time*)) (incf *fps-samples*) (when (>= *fps-samples* 30) (setf *fps-display* (round (/ 30000.0d0 *fps-accum*))) (setf *fps-accum* 0.0d0 *fps-samples* 0))) (setf *fps-last-time* now))
;; ── Metronome tick ── (when (and *metronome-on* (> *metronome-bpm* 0) *np-audio*) (let* ((now-ms (monotonic-time-ms)) (ms-per-beat (/ 60000.0d0 *metronome-bpm*)) (beat-number (floor now-ms ms-per-beat)) ;; Pendulum: sinusoidal swing over 2-beat period (beat-phase (/ (mod now-ms (* ms-per-beat 2)) (* ms-per-beat 2)))) (setf *metronome-phase* (sin (* beat-phase pi 2.0d0))) (when (/= beat-number *metronome-last-beat*) (setf *metronome-last-beat* beat-number) (setf *metronome-flash* 1.0) (let ((downbeat (zerop (mod beat-number 4)))) (audio-synth *np-audio* :type 3 ; square :tone (if downbeat 1200.0d0 800.0d0) :duration 0.03d0 :volume (if downbeat 0.4d0 0.25d0) :attack 0.001d0 :decay 0.02d0)))))
;; Decay metronome flash (when (> *metronome-flash* 0.0) (decf *metronome-flash* 0.15) (when (< *metronome-flash* 0.0) (setf *metronome-flash* 0.0)))
;; ── Input ── (dolist (ev (ac-native.input:input-poll *np-input*)) (let ((type (ac-native.input:event-type ev)) (code (ac-native.input:event-code ev)))
(when (eq type :key-down) ;; ESC: triple-press to quit (when (= code ac-native.input:+key-esc+) (when (> (- *np-frame* *esc-last-frame*) 90) (setf *esc-count* 0)) (incf *esc-count*) (setf *esc-last-frame* *np-frame*) (when (and *np-audio* (< *esc-count* 3)) (audio-synth *np-audio* :type 3 :tone (if (= *esc-count* 1) 440.0d0 660.0d0) :duration 0.08d0 :volume 0.15d0 :attack 0.002d0 :decay 0.06d0)) (when (>= *esc-count* 3) (setf *running* nil)))
;; Power (when (= code ac-native.input:+key-power+) (setf *running* nil))
;; Shift: toggle quick mode (when (= code 42) ; KEY_LEFTSHIFT (setf *quick-mode* (not *quick-mode*)))
;; Space: toggle metronome (when (= code ac-native.input:+key-space+) (setf *metronome-on* (not *metronome-on*)) (when *metronome-on* (setf *metronome-last-beat* -1)))
;; Minus / Equal: BPM control (when (= code ac-native.input:+key-minus+) (setf *metronome-bpm* (max 20 (- *metronome-bpm* 5)))) (when (= code ac-native.input:+key-equal+) (setf *metronome-bpm* (min 300 (+ *metronome-bpm* 5))))
;; Number keys: set octave (kills active voices) (when (and (>= code ac-native.input:+key-1+) (<= code ac-native.input:+key-9+)) (let ((new-oct (1+ (- code ac-native.input:+key-1+)))) (unless (= new-oct *octave*) (kill-all-voices *np-audio*) (setf *octave* new-oct))))
;; Arrow up/down: octave (when (= code ac-native.input:+key-up+) (when (< *octave* 9) (kill-all-voices *np-audio*) (incf *octave*))) (when (= code ac-native.input:+key-down+) (when (> *octave* 1) (kill-all-voices *np-audio*) (decf *octave*)))
;; Tab / Arrow left/right: cycle wave type (when (or (= code ac-native.input:+key-tab+) (= code ac-native.input:+key-right+)) (kill-all-voices *np-audio*) (setf *wave-index* (mod (1+ *wave-index*) 5)) (when *np-audio* (let ((tones #(660.0d0 550.0d0 440.0d0 330.0d0 220.0d0))) (audio-synth *np-audio* :type *wave-index* :tone (aref tones *wave-index*) :duration 0.07d0 :volume 0.18d0 :attack 0.002d0 :decay 0.06d0)))) (when (= code ac-native.input:+key-left+) (kill-all-voices *np-audio*) (setf *wave-index* (mod (+ *wave-index* 4) 5)) (when *np-audio* (let ((tones #(660.0d0 550.0d0 440.0d0 330.0d0 220.0d0))) (audio-synth *np-audio* :type *wave-index* :tone (aref tones *wave-index*) :duration 0.07d0 :volume 0.18d0 :attack 0.002d0 :decay 0.06d0))))
;; Note keys (let ((mapping (gethash code *key-note-map*))) (when (and mapping (not (gethash code *active-voices*)) *np-audio*) (let* ((note-name (car mapping)) (oct-delta (cdr mapping)) (actual-octave (+ *octave* oct-delta)) (freq (note-to-freq note-name actual-octave)) (idx (position note-name *chromatic* :test #'string=)) (semitones (+ (* (- actual-octave 4) 12) (or idx 0))) (pan (max -0.8d0 (min 0.8d0 (/ (- semitones 12) 15.0d0)))) (attack (if *quick-mode* 0.002d0 0.005d0)) (voice-id (audio-synth *np-audio* :type *wave-index* :tone freq :volume 0.7d0 :duration 0 :attack attack :decay 0.1d0 :pan pan))) (setf (gethash code *active-voices*) voice-id) (setf (gethash code *active-notes*) (cons note-name actual-octave))))))
;; Key up (when (eq type :key-up) (let ((voice-id (gethash code *active-voices*))) (when (and voice-id *np-audio*) (audio-synth-kill *np-audio* voice-id) (remhash code *active-voices*) (let ((note-info (gethash code *active-notes*))) (when note-info (setf (gethash note-info *trails*) 1.0) (remhash code *active-notes*))))))))
;; ── Trail decay ── (let ((dead nil)) (maphash (lambda (note val) (let ((new-val (- val 0.025))) (if (<= new-val 0.0) (push note dead) (setf (gethash note *trails*) new-val)))) *trails*) (dolist (n dead) (remhash n *trails*)))
;; ── Background color from active notes ── (let ((n (hash-table-count *active-notes*))) (if (> n 0) (let ((tr 0) (tg 0) (tb 0)) (maphash (lambda (code note-info) (declare (ignore code)) (let ((rgb (note-color-rgb (car note-info)))) (incf tr (first rgb)) (incf tg (second rgb)) (incf tb (third rgb)))) *active-notes*) (let ((target-r (floor (* (floor tr n) 35) 100)) (target-g (floor (* (floor tg n) 35) 100)) (target-b (floor (* (floor tb n) 35) 100))) (setf *bg-r* (+ *bg-r* (floor (- target-r *bg-r*) 4))) (setf *bg-g* (+ *bg-g* (floor (- target-g *bg-g*) 4))) (setf *bg-b* (+ *bg-b* (floor (- target-b *bg-b*) 4))))) (progn (setf *bg-r* (+ *bg-r* (floor (- 20 *bg-r*) 8))) (setf *bg-g* (+ *bg-g* (floor (- 20 *bg-g*) 8))) (setf *bg-b* (+ *bg-b* (floor (- 25 *bg-b*) 8))))))
;; Metronome flash brightens background (when (> *metronome-flash* 0.0) (let ((boost (floor (* *metronome-flash* 40)))) (setf *bg-r* (min 255 (+ *bg-r* boost))) (setf *bg-g* (min 255 (+ *bg-g* boost))) (setf *bg-b* (min 255 (+ *bg-b* boost)))))
;; ══════════════ PAINT ══════════════ (graph-wipe *np-graph* (make-color :r *bg-r* :g *bg-g* :b *bg-b*))
;; ── Trails ── (maphash (lambda (trail-key val) (let* ((note-name (car trail-key)) (oct (cdr trail-key)) (rgb (note-color-rgb note-name)) (note-idx (or (position note-name *chromatic* :test #'string=) 0)) (semi (+ (* (- oct 1) 12) note-idx)) (total-semitones (* 9 12)) (bar-h (max 2 (floor (- *np-sh* 30) total-semitones))) (bar-y (+ 14 (floor (* semi (- *np-sh* 30)) total-semitones))) (bar-w (max 1 (floor (* val *np-sw*)))) (bar-x (floor (- *np-sw* bar-w) 2)) (alpha (max 1 (min 255 (floor (* val 200)))))) (graph-ink *np-graph* (make-color :r (first rgb) :g (second rgb) :b (third rgb) :a alpha)) (graph-box *np-graph* bar-x bar-y bar-w bar-h))) *trails*)
;; ── Active note bars ── (maphash (lambda (code note-info) (declare (ignore code)) (let* ((note-name (car note-info)) (oct (cdr note-info)) (rgb (note-color-rgb note-name)) (note-idx (or (position note-name *chromatic* :test #'string=) 0)) (semi (+ (* (- oct 1) 12) note-idx)) (total-semitones (* 9 12)) (bar-h (max 2 (floor (- *np-sh* 30) total-semitones))) (bar-y (+ 14 (floor (* semi (- *np-sh* 30)) total-semitones)))) (graph-ink *np-graph* (make-color :r (min 255 (+ (first rgb) 40)) :g (min 255 (+ (second rgb) 40)) :b (min 255 (+ (third rgb) 40)) :a 220)) (graph-box *np-graph* 0 bar-y *np-sw* bar-h))) *active-notes*)
;; ── Metronome pendulum ── (when *metronome-on* (let* ((cx (floor *np-sw* 2)) (cy (- *np-sh* 24)) (arm-len (min 20 (floor *np-sh* 8))) (bx (+ cx (floor (* *metronome-phase* arm-len)))) (bright (floor (* *metronome-flash* 255)))) ;; Arm line (graph-ink *np-graph* (make-color :r 180 :g 180 :b 180 :a 120)) (graph-line *np-graph* cx cy bx (- cy arm-len)) ;; Bob (graph-ink *np-graph* (make-color :r (min 255 (+ 180 bright)) :g (min 255 (+ 100 bright)) :b 60 :a 220)) (graph-circle *np-graph* bx (- cy arm-len) 3)))
;; ── Wave type indicators (bottom bar) ── (let* ((bar-y (- *np-sh* 14)) (btn-w (max 12 (floor *np-sw* 6))) (gap 2) (total-w (+ (* 5 btn-w) (* 4 gap))) (start-x (floor (- *np-sw* total-w) 2))) (dotimes (i 5) (let* ((bx (+ start-x (* i (+ btn-w gap)))) (selected (= i *wave-index*)) (col (if selected (make-color :r 255 :g 255 :b 255 :a 200) (make-color :r 100 :g 100 :b 110 :a 140)))) ;; Button background (if selected (progn (graph-ink *np-graph* (make-color :r 60 :g 50 :b 80 :a 200)) (graph-box *np-graph* bx bar-y btn-w 12)) (progn (graph-ink *np-graph* (make-color :r 30 :g 28 :b 35 :a 150)) (graph-box *np-graph* bx bar-y btn-w 12))) ;; Wave name (abbreviated to 3 chars) (graph-ink *np-graph* col) (let ((abbr (subseq (aref *wave-names* i) 0 (min 3 (length (aref *wave-names* i)))))) (font-draw *np-graph* abbr (+ bx (floor (- btn-w (* (length abbr) 6)) 2)) (+ bar-y 2))))))
;; ── Status text ── ;; Top-left: piece name + mode indicators (graph-ink *np-graph* (make-color :r 100 :g 100 :b 110 :a 150)) (font-draw *np-graph* "notepat" 3 3)
;; Quick mode indicator (when *quick-mode* (graph-ink *np-graph* (make-color :r 255 :g 200 :b 50 :a 200)) (font-draw *np-graph* "Q" (+ 3 (* 8 6)) 3))
;; Handle (top-left, after piece name) (when *boot-handle* (let ((htxt (format nil "@~A" *boot-handle*))) (graph-ink *np-graph* (make-color :r 80 :g 255 :b 140 :a 140)) (font-draw *np-graph* htxt (+ 3 (* (if *quick-mode* 10 8) 6)) 3)))
;; Octave (top-left, below title) (graph-ink *np-graph* (make-color :r 160 :g 160 :b 170 :a 180)) (font-draw *np-graph* (format nil "OCT ~D" *octave*) 3 14)
;; Metronome BPM (if on) (when *metronome-on* (graph-ink *np-graph* (make-color :r 180 :g 140 :b 60 :a 200)) (font-draw *np-graph* (format nil "~DBPM" *metronome-bpm*) (+ 3 (* 7 6)) 14))
;; FPS (top-right) (let ((fps-txt (format nil "~D" *fps-display*))) (graph-ink *np-graph* (make-color :r 80 :g 80 :b 90 :a 120)) (font-draw *np-graph* fps-txt (- *np-sw* (* (length fps-txt) 6) 3) 3))
;; Voice count (top-right, below FPS) (let ((vc (hash-table-count *active-voices*))) (when (> vc 0) (let ((txt (format nil "~Dv" vc))) (graph-ink *np-graph* (make-color :r 200 :g 200 :b 200 :a 180)) (font-draw *np-graph* txt (- *np-sw* (* (length txt) 6) 3) 14))))
;; IP + Swank (top center) (when (> (length *ip-address*) 0) (let ((txt (format nil "~A:4005" *ip-address*))) (graph-ink *np-graph* (make-color :r 60 :g 180 :b 60 :a 160)) (font-draw *np-graph* txt (- (floor *np-sw* 2) (floor (font-measure txt) 2)) 3)))
;; Refresh IP every ~5 seconds (when (zerop (mod *np-frame* 300)) (refresh-ip))
;; LISP tag (top right) — always visible in CL variant (when (string= *build-variant* "cl") (graph-ink *np-graph* (make-color :r 255 :g 200 :b 80 :a 160)) (font-draw *np-graph* "LISP" (- *np-sw* (font-measure "LISP") 4) 3))
;; ── Present ── (ac-native.drm:drm-present *np-display* *np-screen* *np-scale*) (frame-sync-60fps))
;; ── Cleanup ── (when *np-audio* (ignore-errors (kill-all-voices *np-audio*))) (when *np-audio* (ignore-errors (audio-destroy *np-audio*))) (when *np-input* (ignore-errors (ac-native.input:input-destroy *np-input*))) (when *np-screen* (ignore-errors (fb-destroy *np-screen*))) (ignore-errors (ac-native.drm:drm-destroy *np-display*)) (format *error-output* "[notepat] shutdown~%") (force-output *error-output*)))