Compare commits
6 Commits
2aab912b5d
...
3e6b496340
| Author | SHA1 | Date |
|---|---|---|
|
|
3e6b496340 | |
|
|
8d9d2b33b1 | |
|
|
2e86dc4a88 | |
|
|
b7266e3ac2 | |
|
|
c79cebcfa7 | |
|
|
37a3b761db |
|
|
@ -0,0 +1,4 @@
|
|||
[submodule "cl-streamer"]
|
||||
path = cl-streamer
|
||||
url = git@github.com:glenneth1/cl-streamer.git
|
||||
branch = master
|
||||
|
|
@ -1438,7 +1438,7 @@
|
|||
|
||||
;;; Listener Statistics API Endpoints
|
||||
|
||||
(define-api-with-limit asteroid/stats/current () ()
|
||||
(define-api-with-limit asteroid/stats/current () (:limit 120 :timeout 60)
|
||||
"Get current listener count from recent snapshots"
|
||||
(with-error-handling
|
||||
(let ((listeners (get-current-listeners)))
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Subproject commit c0f9c0e161e2076f7dde8fdcbcb0f701d02cc35b
|
||||
|
|
@ -1,295 +0,0 @@
|
|||
#+TITLE: CL-Streamer
|
||||
#+AUTHOR: Glenn Thompson
|
||||
#+DATE: 2026-02-03
|
||||
|
||||
* Overview
|
||||
|
||||
CL-Streamer is a native Common Lisp audio streaming server built to replace
|
||||
the Icecast + Liquidsoap stack in [[https://asteroid.radio][Asteroid Radio]]. It provides HTTP audio
|
||||
streaming with ICY metadata, multi-format encoding (MP3 and AAC), and
|
||||
real-time audio processing via [[https://shirakumo.github.io/harmony/][Harmony]] and [[https://shirakumo.github.io/cl-mixed/][cl-mixed]] — all in a single Lisp
|
||||
process.
|
||||
|
||||
The goal is to eliminate the Docker/C service dependencies (Icecast, Liquidsoap)
|
||||
and bring the entire audio pipeline under the control of the Lisp application.
|
||||
This means playlist management, stream encoding, metadata, listener stats, and
|
||||
the web frontend all live in one process and can interact directly.
|
||||
|
||||
* Why Replace Icecast + Liquidsoap?
|
||||
|
||||
The current Asteroid Radio stack runs three separate services in Docker:
|
||||
|
||||
- *Liquidsoap* — reads the playlist, decodes audio, applies crossfade,
|
||||
encodes to MP3/AAC, pushes to Icecast
|
||||
- *Icecast* — receives encoded streams, serves them to listeners over HTTP
|
||||
with ICY metadata
|
||||
- *PostgreSQL* — stores playlist state, listener stats, etc.
|
||||
|
||||
This works, but has significant friction:
|
||||
|
||||
- *Operational complexity* — three Docker containers to manage, with
|
||||
inter-service communication over HTTP and Telnet
|
||||
- *Playlist control* — Liquidsoap reads an M3U file; the Lisp app writes it
|
||||
and pokes Liquidsoap via Telnet to reload. Clunky round-trip for
|
||||
something that should be a function call
|
||||
- *Metadata* — requires polling Icecast's admin XML endpoint to get
|
||||
listener stats, then correlating with our own data
|
||||
- *Crossfade/transitions* — configured in Liquidsoap's DSL, not
|
||||
accessible to the application logic
|
||||
- *No live mixing* — adding DJ input or live mixing requires more
|
||||
Liquidsoap configuration and another audio path
|
||||
|
||||
With CL-Streamer, the Lisp process *is* the streaming server:
|
||||
|
||||
- =play-list= and =play-file= are function calls, not Telnet commands
|
||||
- ICY metadata updates are immediate — =(set-now-playing mount title)=
|
||||
- Listener connections are tracked in-process, no XML polling needed
|
||||
- Crossfade parameters can be changed at runtime
|
||||
- Future: live DJ input via Harmony's mixer, with the same encoder pipeline
|
||||
|
||||
* Architecture
|
||||
|
||||
#+begin_example
|
||||
┌──────────────────────────────────────────────────────────┐
|
||||
│ Lisp Process │
|
||||
│ │
|
||||
│ ┌─────────┐ ┌──────────────┐ ┌─────────────────┐ │
|
||||
│ │ Harmony │───▶│ streaming- │───▶│ MP3 Encoder │ │
|
||||
│ │ (decode, │ │ drain │ │ (LAME FFI) │─┼──▶ /stream.mp3
|
||||
│ │ mix, │ │ (float→s16 │ └─────────────────┘ │
|
||||
│ │ effects)│ │ conversion) │ ┌─────────────────┐ │
|
||||
│ └─────────┘ └──────────────┘───▶│ AAC Encoder │ │
|
||||
│ ▲ │ (FDK-AAC shim) │─┼──▶ /stream.aac
|
||||
│ │ └─────────────────┘ │
|
||||
│ ┌─────────┐ ┌─────────────────┐ │
|
||||
│ │ Playlist │ ICY metadata ──────▶│ HTTP Server │ │
|
||||
│ │ Manager │ Listener stats ◀────│ (usocket) │ │
|
||||
│ └─────────┘ └─────────────────┘ │
|
||||
└──────────────────────────────────────────────────────────┘
|
||||
#+end_example
|
||||
|
||||
** Harmony Integration
|
||||
|
||||
[[https://shirakumo.github.io/harmony/][Harmony]] is Shinmera's Common Lisp audio framework built on top of cl-mixed.
|
||||
It handles audio decoding (FLAC, MP3, OGG, etc.), sample rate conversion,
|
||||
mixing, and effects processing.
|
||||
|
||||
CL-Streamer connects to Harmony by replacing the default audio output drain
|
||||
with a custom =streaming-drain= that intercepts the mixed audio data.
|
||||
Instead of sending PCM to a sound card, we:
|
||||
|
||||
1. Read interleaved IEEE 754 single-float samples from Harmony's pack buffer
|
||||
2. Convert to signed 16-bit PCM
|
||||
3. Feed to all registered encoders (MP3 via LAME, AAC via FDK-AAC)
|
||||
4. Write encoded bytes to per-mount broadcast ring buffers
|
||||
5. HTTP clients read from these buffers with burst-on-connect
|
||||
|
||||
Both voices (e.g., during crossfade) play through the same Harmony mixer
|
||||
and are automatically summed before reaching the drain — the encoders see
|
||||
a single mixed signal.
|
||||
|
||||
** The FDK-AAC C Shim
|
||||
|
||||
SBCL's signal handlers conflict with FDK-AAC's internal memory access patterns.
|
||||
When FDK-AAC touches certain memory during =aacEncOpen= or =aacEncEncode=,
|
||||
SBCL's SIGSEGV handler intercepts it before FDK-AAC's own handler can run,
|
||||
causing a recursive signal fault.
|
||||
|
||||
The solution is a thin C shim (=fdkaac-shim.c=, compiled to =libfdkaac-shim.so=)
|
||||
that wraps all FDK-AAC calls:
|
||||
|
||||
- =fdkaac_open_and_init= — opens the encoder, sets all parameters (AOT,
|
||||
sample rate, channels, bitrate, transport format, afterburner), and
|
||||
runs the initialisation call, all from C
|
||||
- =fdkaac_encode= — sets up the buffer descriptors (=AACENC_BufDesc=) and
|
||||
calls =aacEncEncode=, returning encoded ADTS frames
|
||||
- =fdkaac_close= — closes the encoder handle
|
||||
|
||||
The Lisp side calls these via CFFI and never touches FDK-AAC directly.
|
||||
This avoids the signal handler conflict entirely.
|
||||
|
||||
Note: one subtle bug was that FDK-AAC's =OUT_BITSTREAM_DATA= constant is
|
||||
=3=, not =1=. Getting this wrong causes =aacEncEncode= to return error 96
|
||||
with no useful error message. The fix was to use the proper enum constants
|
||||
from =aacenc_lib.h= rather than hardcoded integers.
|
||||
|
||||
Additionally, the AAC encoder uses a PCM accumulation buffer to feed
|
||||
FDK-AAC exact =frameLength=-sized chunks (1024 frames for AAC-LC). Feeding
|
||||
arbitrary chunk sizes from Harmony's real-time callback produces audio
|
||||
artefacts.
|
||||
|
||||
To rebuild the shim:
|
||||
|
||||
#+begin_src sh
|
||||
gcc -shared -fPIC -o libfdkaac-shim.so fdkaac-shim.c -lfdk-aac
|
||||
#+end_src
|
||||
|
||||
** Broadcast Buffer
|
||||
|
||||
Each mount point has a ring buffer (=broadcast-buffer=) that acts as a
|
||||
single-producer, multi-consumer queue. The encoder writes encoded audio
|
||||
in, and each connected client reads from its own position.
|
||||
|
||||
- Never blocks the producer — slow clients lose data rather than stalling
|
||||
the encoder
|
||||
- Burst-on-connect — new clients receive ~4 seconds of recent audio
|
||||
immediately for fast playback start
|
||||
- Condition variable signalling for efficient client wakeup
|
||||
|
||||
** ICY Metadata Protocol
|
||||
|
||||
The server implements the SHOUTcast/Icecast ICY metadata protocol:
|
||||
|
||||
- Responds to =Icy-MetaData: 1= requests with metadata-interleaved streams
|
||||
- Injects metadata blocks at the configured =metaint= byte interval
|
||||
- =set-now-playing= updates the metadata for a mount, picked up by all
|
||||
connected clients on their next metadata interval
|
||||
|
||||
* Current Status
|
||||
|
||||
*Working and tested:*
|
||||
|
||||
- [X] HTTP streaming server with multiple mount points
|
||||
- [X] MP3 encoding via LAME (128kbps, configurable)
|
||||
- [X] AAC encoding via FDK-AAC with C shim (128kbps ADTS, configurable)
|
||||
- [X] Harmony audio backend with custom streaming drain
|
||||
- [X] Real-time float→s16 PCM conversion and dual-encoder output
|
||||
- [X] ICY metadata protocol (set-now-playing on track change)
|
||||
- [X] Broadcast ring buffer with burst-on-connect
|
||||
- [X] Sequential playlist playback with reliable track-end detection
|
||||
- [X] Crossfade between tracks (3s overlap, 2s fade-in/out)
|
||||
- [X] Multi-format simultaneous output (MP3 + AAC from same source)
|
||||
|
||||
*Remaining work:*
|
||||
|
||||
- [ ] Read file metadata (artist, title, album) from FLAC/MP3 tags via
|
||||
cl-taglib and feed to ICY metadata (currently uses filename)
|
||||
- [ ] Flush AAC accumulation buffer at track boundaries for clean transitions
|
||||
- [ ] Integration with Asteroid Radio's playlist/queue system (replace
|
||||
Liquidsoap Telnet control with direct function calls)
|
||||
- [ ] Integration with Asteroid Radio's listener statistics (replace
|
||||
Icecast admin XML polling with in-process tracking)
|
||||
- [ ] Live DJ input via Harmony mixer (replace Liquidsoap's input sources)
|
||||
- [ ] Stream quality variants (low bitrate MP3, shuffle stream, etc.)
|
||||
- [ ] Robustness: auto-restart on encoder errors, watchdog, graceful
|
||||
degradation
|
||||
|
||||
* Integration with Asteroid Radio
|
||||
|
||||
The plan is to load CL-Streamer as an ASDF system within the main Asteroid
|
||||
Radio Lisp image. The web application (Radiance) and the streaming server
|
||||
share the same process:
|
||||
|
||||
- *Playlist control* — the web app's queue management calls =play-list=
|
||||
and =play-file= directly, no IPC needed
|
||||
- *Now playing* — track changes call =set-now-playing=, which is
|
||||
immediately visible to all connected ICY-metadata clients
|
||||
- *Listener stats* — the stream server tracks connections in-process;
|
||||
the web app reads them directly for the admin dashboard
|
||||
- *Tag metadata* — cl-taglib (already a dependency of Asteroid) reads
|
||||
FLAC/MP3 tags and passes artist/title/album to ICY metadata
|
||||
|
||||
This eliminates the Docker containers for Icecast and Liquidsoap entirely.
|
||||
The only external service is PostgreSQL for persistent data.
|
||||
|
||||
* File Structure
|
||||
|
||||
| File | Purpose |
|
||||
|----------------------+--------------------------------------------------|
|
||||
| =cl-streamer.asd= | ASDF system definition |
|
||||
| =package.lisp= | Package and exports |
|
||||
| =cl-streamer.lisp= | Top-level API (start, stop, add-mount, etc.) |
|
||||
| =stream-server.lisp=| HTTP server, client connections, ICY responses |
|
||||
| =buffer.lisp= | Broadcast ring buffer (single-producer, multi-consumer) |
|
||||
| =icy-protocol.lisp= | ICY metadata encoding and injection |
|
||||
| =conditions.lisp= | Error condition types |
|
||||
| =encoder.lisp= | MP3 encoder (LAME wrapper) |
|
||||
| =lame-ffi.lisp= | CFFI bindings for libmp3lame |
|
||||
| =aac-encoder.lisp= | AAC encoder with frame accumulation buffer |
|
||||
| =fdkaac-ffi.lisp= | CFFI bindings for FDK-AAC (via shim) |
|
||||
| =fdkaac-shim.c= | C shim for FDK-AAC (avoids SBCL signal conflicts)|
|
||||
| =libfdkaac-shim.so= | Compiled shim shared library |
|
||||
| =harmony-backend.lisp= | Harmony integration: streaming-drain, crossfade, playlist |
|
||||
| =test-stream.lisp= | End-to-end test: playlist with MP3 + AAC output |
|
||||
|
||||
* Dependencies
|
||||
|
||||
** Lisp Libraries
|
||||
|
||||
- [[https://github.com/Shinmera/harmony][harmony]] — audio framework (decode, mix, effects)
|
||||
- [[https://github.com/Shinmera/cl-mixed][cl-mixed]] — low-level audio mixing
|
||||
- [[https://github.com/Shinmera/cl-mixed-flac][cl-mixed-flac]] — FLAC decoding
|
||||
- [[https://github.com/Shinmera/cl-mixed-mpg123][cl-mixed-mpg123]] — MP3 decoding
|
||||
- [[https://common-lisp.net/project/cffi/][cffi]] — C foreign function interface
|
||||
- [[https://github.com/usocket/usocket][usocket]] — socket networking
|
||||
- [[https://edicl.github.io/flexi-streams/][flexi-streams]] — flexible stream types
|
||||
- [[https://github.com/sharplispers/log4cl][log4cl]] — logging
|
||||
- [[https://gitlab.common-lisp.net/alexandria/alexandria][alexandria]] — utility library
|
||||
- [[https://sionescu.github.io/bordeaux-threads/][bordeaux-threads]] — portable threading
|
||||
|
||||
** C Libraries
|
||||
|
||||
- [[https://lame.sourceforge.io/][libmp3lame]] — MP3 encoding
|
||||
- [[https://github.com/mstorsjo/fdk-aac][libfdk-aac]] — AAC encoding (via C shim)
|
||||
|
||||
* Quick Start
|
||||
|
||||
#+begin_src common-lisp
|
||||
;; Load the systems
|
||||
(ql:quickload '(:cl-streamer :cl-streamer/encoder
|
||||
:cl-streamer/aac-encoder :cl-streamer/harmony))
|
||||
|
||||
;; Start the HTTP server
|
||||
(cl-streamer:start :port 8000)
|
||||
|
||||
;; Add mount points
|
||||
(cl-streamer:add-mount cl-streamer:*server* "/stream.mp3"
|
||||
:content-type "audio/mpeg"
|
||||
:bitrate 128
|
||||
:name "Asteroid Radio MP3")
|
||||
(cl-streamer:add-mount cl-streamer:*server* "/stream.aac"
|
||||
:content-type "audio/aac"
|
||||
:bitrate 128
|
||||
:name "Asteroid Radio AAC")
|
||||
|
||||
;; Create encoders
|
||||
(defvar *mp3* (cl-streamer:make-mp3-encoder :sample-rate 44100
|
||||
:channels 2
|
||||
:bitrate 128))
|
||||
(defvar *aac* (cl-streamer:make-aac-encoder :sample-rate 44100
|
||||
:channels 2
|
||||
:bitrate 128000))
|
||||
|
||||
;; Create pipeline with both outputs
|
||||
(defvar *pipeline* (cl-streamer/harmony:make-audio-pipeline
|
||||
:encoder *mp3*
|
||||
:stream-server cl-streamer:*server*
|
||||
:mount-path "/stream.mp3"))
|
||||
(cl-streamer/harmony:add-pipeline-output *pipeline* *aac* "/stream.aac")
|
||||
(cl-streamer/harmony:start-pipeline *pipeline*)
|
||||
|
||||
;; Play a playlist with crossfade
|
||||
(cl-streamer/harmony:play-list *pipeline* '("/path/to/track1.flac"
|
||||
"/path/to/track2.flac")
|
||||
:crossfade-duration 3.0
|
||||
:fade-in 2.0
|
||||
:fade-out 2.0)
|
||||
|
||||
;; Or play individual files
|
||||
(cl-streamer/harmony:play-file *pipeline* "/path/to/track.flac"
|
||||
:title "Artist - Track Name")
|
||||
|
||||
;; Update now-playing metadata
|
||||
(cl-streamer:set-now-playing "/stream.mp3" "Artist - Track Title")
|
||||
|
||||
;; Check listeners
|
||||
(cl-streamer:get-listener-count)
|
||||
|
||||
;; Stop everything
|
||||
(cl-streamer/harmony:stop-pipeline *pipeline*)
|
||||
(cl-streamer:stop)
|
||||
#+end_src
|
||||
|
||||
* License
|
||||
|
||||
AGPL-3.0
|
||||
|
|
@ -1,137 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
(defclass aac-encoder ()
|
||||
((handle :initform nil :accessor encoder-handle)
|
||||
(sample-rate :initarg :sample-rate :accessor aac-encoder-sample-rate :initform 44100)
|
||||
(channels :initarg :channels :accessor aac-encoder-channels :initform 2)
|
||||
(bitrate :initarg :bitrate :accessor aac-encoder-bitrate :initform 128000)
|
||||
(aot :initarg :aot :accessor aac-encoder-aot :initform :aot-aac-lc)
|
||||
(out-buffer :initform nil :accessor aac-encoder-out-buffer)
|
||||
(out-buffer-size :initform (* 1024 8) :accessor aac-encoder-out-buffer-size)
|
||||
(frame-length :initform 1024 :accessor aac-encoder-frame-length)
|
||||
(pcm-accum :initform nil :accessor aac-encoder-pcm-accum
|
||||
:documentation "Accumulation buffer for PCM samples (signed-byte 16), frame-length * channels elements.")
|
||||
(pcm-accum-pos :initform 0 :accessor aac-encoder-pcm-accum-pos
|
||||
:documentation "Number of samples currently accumulated.")))
|
||||
|
||||
(defun make-aac-encoder (&key (sample-rate 44100) (channels 2) (bitrate 128000))
|
||||
"Create an AAC encoder with the specified parameters.
|
||||
BITRATE is in bits per second (e.g., 128000 for 128kbps)."
|
||||
(let ((encoder (make-instance 'aac-encoder
|
||||
:sample-rate sample-rate
|
||||
:channels channels
|
||||
:bitrate bitrate)))
|
||||
(initialize-aac-encoder encoder)
|
||||
encoder))
|
||||
|
||||
(defun initialize-aac-encoder (encoder)
|
||||
"Initialize the FDK-AAC encoder with current settings.
|
||||
Uses C shim to avoid SBCL signal handler conflicts with FDK-AAC."
|
||||
(cffi:with-foreign-objects ((handle-ptr :pointer)
|
||||
(frame-length-ptr :int)
|
||||
(max-out-bytes-ptr :int))
|
||||
(let ((result (fdkaac-open-and-init handle-ptr
|
||||
(aac-encoder-sample-rate encoder)
|
||||
(aac-encoder-channels encoder)
|
||||
(aac-encoder-bitrate encoder)
|
||||
2 ; AOT: AAC-LC
|
||||
2 ; TRANSMUX: ADTS
|
||||
1 ; AFTERBURNER: on
|
||||
frame-length-ptr
|
||||
max-out-bytes-ptr)))
|
||||
(unless (zerop result)
|
||||
(error 'encoding-error :format :aac
|
||||
:message (format nil "fdkaac_open_and_init failed: ~A" result)))
|
||||
(setf (encoder-handle encoder) (cffi:mem-ref handle-ptr :pointer))
|
||||
(setf (aac-encoder-frame-length encoder) (cffi:mem-ref frame-length-ptr :int))
|
||||
(setf (aac-encoder-out-buffer-size encoder) (cffi:mem-ref max-out-bytes-ptr :int))))
|
||||
(setf (aac-encoder-out-buffer encoder)
|
||||
(cffi:foreign-alloc :unsigned-char :count (aac-encoder-out-buffer-size encoder)))
|
||||
;; Initialize PCM accumulation buffer (frame-length * channels samples)
|
||||
(let ((accum-size (* (aac-encoder-frame-length encoder)
|
||||
(aac-encoder-channels encoder))))
|
||||
(setf (aac-encoder-pcm-accum encoder)
|
||||
(make-array accum-size :element-type '(signed-byte 16) :initial-element 0))
|
||||
(setf (aac-encoder-pcm-accum-pos encoder) 0))
|
||||
(log:info "AAC encoder initialized: ~Akbps, ~AHz, ~A channels, frame-length=~A"
|
||||
(floor (aac-encoder-bitrate encoder) 1000)
|
||||
(aac-encoder-sample-rate encoder)
|
||||
(aac-encoder-channels encoder)
|
||||
(aac-encoder-frame-length encoder))
|
||||
encoder)
|
||||
|
||||
(defun close-aac-encoder (encoder)
|
||||
"Close the AAC encoder and free resources."
|
||||
(when (encoder-handle encoder)
|
||||
(cffi:with-foreign-object (handle-ptr :pointer)
|
||||
(setf (cffi:mem-ref handle-ptr :pointer) (encoder-handle encoder))
|
||||
(fdkaac-close handle-ptr))
|
||||
(setf (encoder-handle encoder) nil))
|
||||
(when (aac-encoder-out-buffer encoder)
|
||||
(cffi:foreign-free (aac-encoder-out-buffer encoder))
|
||||
(setf (aac-encoder-out-buffer encoder) nil)))
|
||||
|
||||
(defun encode-one-aac-frame (encoder)
|
||||
"Encode a single frame from the accumulation buffer.
|
||||
Returns a byte vector of AAC data, or an empty vector."
|
||||
(let* ((handle (encoder-handle encoder))
|
||||
(channels (aac-encoder-channels encoder))
|
||||
(frame-length (aac-encoder-frame-length encoder))
|
||||
(accum (aac-encoder-pcm-accum encoder))
|
||||
(out-buf (aac-encoder-out-buffer encoder))
|
||||
(out-buf-size (aac-encoder-out-buffer-size encoder))
|
||||
(total-samples (* frame-length channels))
|
||||
(pcm-bytes (* total-samples 2)))
|
||||
(cffi:with-pointer-to-vector-data (pcm-ptr accum)
|
||||
(cffi:with-foreign-object (bytes-written-ptr :int)
|
||||
(let ((result (fdkaac-encode handle pcm-ptr pcm-bytes total-samples
|
||||
out-buf out-buf-size bytes-written-ptr)))
|
||||
(unless (zerop result)
|
||||
(error 'encoding-error :format :aac
|
||||
:message (format nil "aacEncEncode failed: ~A" result)))
|
||||
(let ((bytes-written (cffi:mem-ref bytes-written-ptr :int)))
|
||||
(if (> bytes-written 0)
|
||||
(let ((result-vec (make-array bytes-written :element-type '(unsigned-byte 8))))
|
||||
(loop for i below bytes-written
|
||||
do (setf (aref result-vec i) (cffi:mem-aref out-buf :unsigned-char i)))
|
||||
result-vec)
|
||||
(make-array 0 :element-type '(unsigned-byte 8)))))))))
|
||||
|
||||
(defun encode-aac-pcm (encoder pcm-samples num-samples)
|
||||
"Encode PCM samples (16-bit signed interleaved) to AAC.
|
||||
Accumulates samples and encodes in exact frame-length chunks.
|
||||
Returns a byte vector of AAC data (ADTS frames).
|
||||
Uses C shim to avoid SBCL signal handler conflicts."
|
||||
(let* ((channels (aac-encoder-channels encoder))
|
||||
(frame-samples (* (aac-encoder-frame-length encoder) channels))
|
||||
(accum (aac-encoder-pcm-accum encoder))
|
||||
(input-total (* num-samples channels))
|
||||
(input-pos 0)
|
||||
(output-chunks nil))
|
||||
;; Copy input samples into accumulation buffer, encoding whenever full
|
||||
(loop while (< input-pos input-total)
|
||||
for space-left = (- frame-samples (aac-encoder-pcm-accum-pos encoder))
|
||||
for copy-count = (min space-left (- input-total input-pos))
|
||||
do (replace accum pcm-samples
|
||||
:start1 (aac-encoder-pcm-accum-pos encoder)
|
||||
:end1 (+ (aac-encoder-pcm-accum-pos encoder) copy-count)
|
||||
:start2 input-pos
|
||||
:end2 (+ input-pos copy-count))
|
||||
(incf (aac-encoder-pcm-accum-pos encoder) copy-count)
|
||||
(incf input-pos copy-count)
|
||||
;; When accumulation buffer is full, encode one frame
|
||||
(when (= (aac-encoder-pcm-accum-pos encoder) frame-samples)
|
||||
(let ((encoded (encode-one-aac-frame encoder)))
|
||||
(when (> (length encoded) 0)
|
||||
(push encoded output-chunks)))
|
||||
(setf (aac-encoder-pcm-accum-pos encoder) 0)))
|
||||
;; Concatenate all encoded chunks into one result vector
|
||||
(if (null output-chunks)
|
||||
(make-array 0 :element-type '(unsigned-byte 8))
|
||||
(let* ((total-bytes (reduce #'+ output-chunks :key #'length))
|
||||
(result (make-array total-bytes :element-type '(unsigned-byte 8)))
|
||||
(pos 0))
|
||||
(dolist (chunk (nreverse output-chunks))
|
||||
(replace result chunk :start1 pos)
|
||||
(incf pos (length chunk)))
|
||||
result))))
|
||||
|
|
@ -1,87 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
;;; ---- Broadcast Ring Buffer ----
|
||||
;;; Single-producer, multi-consumer circular buffer.
|
||||
;;; The writer advances write-pos; each client has its own read cursor.
|
||||
;;; Old data is overwritten when the buffer wraps — slow clients lose data
|
||||
;;; rather than blocking the producer (appropriate for live streaming).
|
||||
|
||||
(defclass broadcast-buffer ()
|
||||
((data :initarg :data :accessor buffer-data)
|
||||
(size :initarg :size :reader buffer-size)
|
||||
(write-pos :initform 0 :accessor buffer-write-pos)
|
||||
(lock :initform (bt:make-lock "broadcast-buffer-lock") :reader buffer-lock)
|
||||
(not-empty :initform (bt:make-condition-variable :name "buffer-not-empty")
|
||||
:reader buffer-not-empty)
|
||||
(burst-size :initarg :burst-size :reader buffer-burst-size
|
||||
:initform (* 64 1024)
|
||||
:documentation "Bytes of recent data to send on new client connect")))
|
||||
|
||||
(defun make-ring-buffer (size)
|
||||
"Create a broadcast ring buffer with SIZE bytes capacity."
|
||||
(make-instance 'broadcast-buffer
|
||||
:data (make-array size :element-type '(unsigned-byte 8))
|
||||
:size size))
|
||||
|
||||
(defun buffer-write (buffer data &key (start 0) (end (length data)))
|
||||
"Write bytes into the broadcast buffer. Never blocks; overwrites old data."
|
||||
(let ((len (- end start)))
|
||||
(when (> len 0)
|
||||
(bt:with-lock-held ((buffer-lock buffer))
|
||||
(let ((write-pos (buffer-write-pos buffer))
|
||||
(size (buffer-size buffer))
|
||||
(buf-data (buffer-data buffer)))
|
||||
(loop for i from start below end
|
||||
for j = (mod write-pos size) then (mod (1+ j) size)
|
||||
do (setf (aref buf-data j) (aref data i))
|
||||
finally (setf (buffer-write-pos buffer) (+ write-pos len))))
|
||||
(bt:condition-notify (buffer-not-empty buffer))))
|
||||
len))
|
||||
|
||||
(defun buffer-read-from (buffer read-pos output &key (start 0) (end (length output)))
|
||||
"Read bytes from BUFFER starting at READ-POS into OUTPUT.
|
||||
Returns (values bytes-read new-read-pos).
|
||||
READ-POS is the client's absolute position in the stream."
|
||||
(let ((requested (- end start)))
|
||||
(bt:with-lock-held ((buffer-lock buffer))
|
||||
(let* ((write-pos (buffer-write-pos buffer))
|
||||
(size (buffer-size buffer))
|
||||
(buf-data (buffer-data buffer))
|
||||
;; Clamp read-pos: if client is too far behind, skip ahead
|
||||
(oldest-available (max 0 (- write-pos size)))
|
||||
(effective-read (max read-pos oldest-available))
|
||||
(available (- write-pos effective-read))
|
||||
(to-read (min requested available)))
|
||||
(if (> to-read 0)
|
||||
(progn
|
||||
(loop for i from start below (+ start to-read)
|
||||
for j = (mod effective-read size) then (mod (1+ j) size)
|
||||
do (setf (aref output i) (aref buf-data j)))
|
||||
(values to-read (+ effective-read to-read)))
|
||||
(values 0 effective-read))))))
|
||||
|
||||
(defun buffer-wait-for-data (buffer read-pos)
|
||||
"Block until new data is available past READ-POS."
|
||||
(bt:with-lock-held ((buffer-lock buffer))
|
||||
(loop while (<= (buffer-write-pos buffer) read-pos)
|
||||
do (bt:condition-wait (buffer-not-empty buffer) (buffer-lock buffer)))))
|
||||
|
||||
(defun buffer-current-pos (buffer)
|
||||
"Return the current write position (for new client burst start)."
|
||||
(bt:with-lock-held ((buffer-lock buffer))
|
||||
(buffer-write-pos buffer)))
|
||||
|
||||
(defun buffer-burst-start (buffer)
|
||||
"Return a read position that gives BURST-SIZE bytes of recent data.
|
||||
This lets new clients start playing immediately."
|
||||
(bt:with-lock-held ((buffer-lock buffer))
|
||||
(let* ((write-pos (buffer-write-pos buffer))
|
||||
(size (buffer-size buffer))
|
||||
(oldest (max 0 (- write-pos size)))
|
||||
(burst-start (max oldest (- write-pos (buffer-burst-size buffer)))))
|
||||
burst-start)))
|
||||
|
||||
(defun buffer-clear (buffer)
|
||||
"Clear the buffer."
|
||||
(bt:with-lock-held ((buffer-lock buffer))
|
||||
(setf (buffer-write-pos buffer) 0)))
|
||||
|
|
@ -1,44 +0,0 @@
|
|||
(asdf:defsystem #:cl-streamer
|
||||
:description "Common Lisp audio streaming server for Asteroid Radio"
|
||||
:author "Glenn Thompson <glenn@asteroid.radio>"
|
||||
:license "AGPL-3.0"
|
||||
:version "0.1.0"
|
||||
:serial t
|
||||
:depends-on (#:alexandria
|
||||
#:bordeaux-threads
|
||||
#:usocket
|
||||
#:flexi-streams
|
||||
#:chunga
|
||||
#:trivial-gray-streams
|
||||
#:split-sequence
|
||||
#:log4cl)
|
||||
:components ((:file "package")
|
||||
(:file "conditions")
|
||||
(:file "buffer")
|
||||
(:file "icy-protocol")
|
||||
(:file "stream-server")
|
||||
(:file "cl-streamer")))
|
||||
|
||||
(asdf:defsystem #:cl-streamer/harmony
|
||||
:description "Harmony audio backend for cl-streamer"
|
||||
:depends-on (#:cl-streamer
|
||||
#:harmony
|
||||
#:cl-mixed
|
||||
#:cl-mixed-mpg123
|
||||
#:cl-mixed-flac
|
||||
#:taglib)
|
||||
:components ((:file "harmony-backend")))
|
||||
|
||||
(asdf:defsystem #:cl-streamer/encoder
|
||||
:description "Audio encoding for cl-streamer (LAME MP3)"
|
||||
:depends-on (#:cl-streamer
|
||||
#:cffi)
|
||||
:components ((:file "lame-ffi")
|
||||
(:file "encoder")))
|
||||
|
||||
(asdf:defsystem #:cl-streamer/aac-encoder
|
||||
:description "AAC encoding for cl-streamer (FDK-AAC)"
|
||||
:depends-on (#:cl-streamer
|
||||
#:cffi)
|
||||
:components ((:file "fdkaac-ffi")
|
||||
(:file "aac-encoder")))
|
||||
|
|
@ -1,38 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
(defvar *server* nil
|
||||
"The global stream server instance.")
|
||||
|
||||
(defun ensure-server (&key (port *default-port*))
|
||||
"Ensure a server instance exists, creating one if needed."
|
||||
(unless *server*
|
||||
(setf *server* (make-stream-server :port port)))
|
||||
*server*)
|
||||
|
||||
(defun start (&key (port *default-port*))
|
||||
"Start the streaming server with default configuration."
|
||||
(let ((server (ensure-server :port port)))
|
||||
(start-server server)))
|
||||
|
||||
(defun stop ()
|
||||
"Stop the streaming server."
|
||||
(when *server*
|
||||
(stop-server *server*)))
|
||||
|
||||
(defun write-audio-data (mount-path data &key (start 0) (end (length data)))
|
||||
"Write audio data to a mount point's buffer.
|
||||
This is called by the audio pipeline to feed encoded audio."
|
||||
(let* ((server (ensure-server))
|
||||
(mount (gethash mount-path (server-mounts server))))
|
||||
(when mount
|
||||
(buffer-write (mount-buffer mount) data :start start :end end))))
|
||||
|
||||
(defun set-now-playing (mount-path title &optional url)
|
||||
"Update the now-playing metadata for a mount point."
|
||||
(let ((server (ensure-server)))
|
||||
(update-metadata server mount-path :title title :url url)))
|
||||
|
||||
(defun get-listener-count (&optional mount-path)
|
||||
"Get the current listener count."
|
||||
(let ((server (ensure-server)))
|
||||
(listener-count server mount-path)))
|
||||
|
|
@ -1,20 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
(define-condition streamer-error (error)
|
||||
((message :initarg :message :reader streamer-error-message))
|
||||
(:report (lambda (c stream)
|
||||
(format stream "Streamer error: ~A" (streamer-error-message c)))))
|
||||
|
||||
(define-condition connection-error (streamer-error)
|
||||
((client :initarg :client :reader connection-error-client))
|
||||
(:report (lambda (c stream)
|
||||
(format stream "Connection error for ~A: ~A"
|
||||
(connection-error-client c)
|
||||
(streamer-error-message c)))))
|
||||
|
||||
(define-condition encoding-error (streamer-error)
|
||||
((format :initarg :format :reader encoding-error-format))
|
||||
(:report (lambda (c stream)
|
||||
(format stream "Encoding error (~A): ~A"
|
||||
(encoding-error-format c)
|
||||
(streamer-error-message c)))))
|
||||
|
|
@ -1,96 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
(defclass mp3-encoder ()
|
||||
((lame :initform nil :accessor encoder-lame)
|
||||
(sample-rate :initarg :sample-rate :accessor encoder-sample-rate :initform 44100)
|
||||
(channels :initarg :channels :accessor encoder-channels :initform 2)
|
||||
(bitrate :initarg :bitrate :accessor encoder-bitrate :initform 128)
|
||||
(quality :initarg :quality :accessor encoder-quality :initform 5)
|
||||
(mp3-buffer :initform nil :accessor encoder-mp3-buffer)
|
||||
(mp3-buffer-size :initform (* 1024 8) :accessor encoder-mp3-buffer-size)))
|
||||
|
||||
(defun make-mp3-encoder (&key (sample-rate 44100) (channels 2) (bitrate 128) (quality 5))
|
||||
"Create an MP3 encoder with the specified parameters.
|
||||
QUALITY: 0=best/slowest, 9=worst/fastest. 5 is good default."
|
||||
(let ((encoder (make-instance 'mp3-encoder
|
||||
:sample-rate sample-rate
|
||||
:channels channels
|
||||
:bitrate bitrate
|
||||
:quality quality)))
|
||||
(initialize-encoder encoder)
|
||||
encoder))
|
||||
|
||||
(defun initialize-encoder (encoder)
|
||||
"Initialize the LAME encoder with current settings."
|
||||
(let ((lame (lame-init)))
|
||||
(when (cffi:null-pointer-p lame)
|
||||
(error 'encoding-error :format :mp3 :message "Failed to initialize LAME"))
|
||||
(setf (encoder-lame encoder) lame)
|
||||
(lame-set-in-samplerate lame (encoder-sample-rate encoder))
|
||||
(lame-set-out-samplerate lame (encoder-sample-rate encoder))
|
||||
(lame-set-num-channels lame (encoder-channels encoder))
|
||||
(lame-set-mode lame (if (= (encoder-channels encoder) 1) :mono :joint-stereo))
|
||||
(lame-set-brate lame (encoder-bitrate encoder))
|
||||
(lame-set-quality lame (encoder-quality encoder))
|
||||
(lame-set-vbr lame :vbr-off)
|
||||
(let ((result (lame-init-params lame)))
|
||||
(when (< result 0)
|
||||
(lame-close lame)
|
||||
(error 'encoding-error :format :mp3
|
||||
:message (format nil "LAME init-params failed: ~A" result))))
|
||||
(setf (encoder-mp3-buffer encoder)
|
||||
(cffi:foreign-alloc :unsigned-char :count (encoder-mp3-buffer-size encoder)))
|
||||
(log:info "MP3 encoder initialized: ~Akbps, ~AHz, ~A channels"
|
||||
(encoder-bitrate encoder)
|
||||
(encoder-sample-rate encoder)
|
||||
(encoder-channels encoder))
|
||||
encoder))
|
||||
|
||||
(defun close-encoder (encoder)
|
||||
"Close the encoder and free resources."
|
||||
(when (encoder-lame encoder)
|
||||
(lame-close (encoder-lame encoder))
|
||||
(setf (encoder-lame encoder) nil))
|
||||
(when (encoder-mp3-buffer encoder)
|
||||
(cffi:foreign-free (encoder-mp3-buffer encoder))
|
||||
(setf (encoder-mp3-buffer encoder) nil)))
|
||||
|
||||
(defun encode-pcm-interleaved (encoder pcm-samples num-samples)
|
||||
"Encode interleaved PCM samples (16-bit signed) to MP3.
|
||||
PCM-SAMPLES should be a (simple-array (signed-byte 16) (*)).
|
||||
Returns a byte vector of MP3 data."
|
||||
(let* ((lame (encoder-lame encoder))
|
||||
(mp3-buf (encoder-mp3-buffer encoder))
|
||||
(mp3-buf-size (encoder-mp3-buffer-size encoder)))
|
||||
(cffi:with-pointer-to-vector-data (pcm-ptr pcm-samples)
|
||||
(let ((bytes-written (lame-encode-buffer-interleaved
|
||||
lame pcm-ptr num-samples mp3-buf mp3-buf-size)))
|
||||
(cond
|
||||
((< bytes-written 0)
|
||||
(error 'encoding-error :format :mp3
|
||||
:message (format nil "Encode failed: ~A" bytes-written)))
|
||||
((= bytes-written 0)
|
||||
(make-array 0 :element-type '(unsigned-byte 8)))
|
||||
(t
|
||||
(let ((result (make-array bytes-written :element-type '(unsigned-byte 8))))
|
||||
(loop for i below bytes-written
|
||||
do (setf (aref result i) (cffi:mem-aref mp3-buf :unsigned-char i)))
|
||||
result)))))))
|
||||
|
||||
(defun encode-flush (encoder)
|
||||
"Flush any remaining MP3 data from the encoder.
|
||||
Call this when done encoding to get final frames."
|
||||
(let* ((lame (encoder-lame encoder))
|
||||
(mp3-buf (encoder-mp3-buffer encoder))
|
||||
(mp3-buf-size (encoder-mp3-buffer-size encoder)))
|
||||
(let ((bytes-written (lame-encode-flush lame mp3-buf mp3-buf-size)))
|
||||
(if (> bytes-written 0)
|
||||
(let ((result (make-array bytes-written :element-type '(unsigned-byte 8))))
|
||||
(loop for i below bytes-written
|
||||
do (setf (aref result i) (cffi:mem-aref mp3-buf :unsigned-char i)))
|
||||
result)
|
||||
(make-array 0 :element-type '(unsigned-byte 8))))))
|
||||
|
||||
(defun lame-version ()
|
||||
"Return the LAME library version string."
|
||||
(get-lame-version))
|
||||
|
|
@ -1,165 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
(cffi:define-foreign-library libfdkaac
|
||||
(:unix (:or "libfdk-aac.so.2" "libfdk-aac.so"))
|
||||
(:darwin "libfdk-aac.dylib")
|
||||
(:windows "libfdk-aac.dll")
|
||||
(t (:default "libfdk-aac")))
|
||||
|
||||
(cffi:use-foreign-library libfdkaac)
|
||||
|
||||
;; Shim library for safe NULL-pointer init call (SBCL/CFFI crashes on NULL args to aacEncEncode)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(let ((shim-path (merge-pathnames "libfdkaac-shim.so"
|
||||
(asdf:system-source-directory :cl-streamer/aac-encoder))))
|
||||
(cffi:load-foreign-library shim-path)))
|
||||
|
||||
(cffi:defctype aac-encoder-handle :pointer)
|
||||
|
||||
(cffi:defcenum aac-encoder-param
|
||||
(:aacenc-aot #x0100)
|
||||
(:aacenc-bitrate #x0101)
|
||||
(:aacenc-bitratemode #x0102)
|
||||
(:aacenc-samplerate #x0103)
|
||||
(:aacenc-sbr-mode #x0104)
|
||||
(:aacenc-granule-length #x0105)
|
||||
(:aacenc-channelmode #x0106)
|
||||
(:aacenc-channelorder #x0107)
|
||||
(:aacenc-sbr-ratio #x0108)
|
||||
(:aacenc-afterburner #x0200)
|
||||
(:aacenc-bandwidth #x0203)
|
||||
(:aacenc-transmux #x0300)
|
||||
(:aacenc-header-period #x0301)
|
||||
(:aacenc-signaling-mode #x0302)
|
||||
(:aacenc-tpsubframes #x0303)
|
||||
(:aacenc-protection #x0306)
|
||||
(:aacenc-ancillary-bitrate #x0500)
|
||||
(:aacenc-metadata-mode #x0600))
|
||||
|
||||
(cffi:defcenum aac-encoder-error
|
||||
(:aacenc-ok #x0000)
|
||||
(:aacenc-invalid-handle #x0020)
|
||||
(:aacenc-memory-error #x0021)
|
||||
(:aacenc-unsupported-parameter #x0022)
|
||||
(:aacenc-invalid-config #x0023)
|
||||
(:aacenc-init-error #x0040)
|
||||
(:aacenc-init-aac-error #x0041)
|
||||
(:aacenc-init-sbr-error #x0042)
|
||||
(:aacenc-init-tp-error #x0043)
|
||||
(:aacenc-init-meta-error #x0044)
|
||||
(:aacenc-encode-error #x0060)
|
||||
(:aacenc-encode-eof #x0080))
|
||||
|
||||
(cffi:defcenum aac-channel-mode
|
||||
(:mode-invalid -1)
|
||||
(:mode-unknown 0)
|
||||
(:mode-1 1)
|
||||
(:mode-2 2)
|
||||
(:mode-1-2 3)
|
||||
(:mode-1-2-1 4)
|
||||
(:mode-1-2-2 5)
|
||||
(:mode-1-2-2-1 6)
|
||||
(:mode-1-2-2-2-1 7))
|
||||
|
||||
(cffi:defcenum aac-transmux
|
||||
(:tt-unknown -1)
|
||||
(:tt-raw 0)
|
||||
(:tt-adif 1)
|
||||
(:tt-adts 2)
|
||||
(:tt-latm-mcp1 6)
|
||||
(:tt-latm-mcp0 7)
|
||||
(:tt-loas 10))
|
||||
|
||||
(cffi:defcenum aac-aot
|
||||
(:aot-none -1)
|
||||
(:aot-null 0)
|
||||
(:aot-aac-main 1)
|
||||
(:aot-aac-lc 2)
|
||||
(:aot-aac-ssr 3)
|
||||
(:aot-aac-ltp 4)
|
||||
(:aot-sbr 5)
|
||||
(:aot-aac-scal 6)
|
||||
(:aot-er-aac-lc 17)
|
||||
(:aot-er-aac-ld 23)
|
||||
(:aot-er-aac-eld 39)
|
||||
(:aot-ps 29)
|
||||
(:aot-mp2-aac-lc 129)
|
||||
(:aot-mp2-sbr 132))
|
||||
|
||||
(cffi:defcstruct aacenc-buf-desc
|
||||
(num-bufs :int)
|
||||
(bufs :pointer)
|
||||
(buf-ids :pointer)
|
||||
(buf-sizes :pointer)
|
||||
(buf-el-sizes :pointer))
|
||||
|
||||
(cffi:defcstruct aacenc-in-args
|
||||
(num-in-samples :int)
|
||||
(num-ancillary-bytes :int))
|
||||
|
||||
(cffi:defcstruct aacenc-out-args
|
||||
(num-out-bytes :int)
|
||||
(num-in-samples :int)
|
||||
(num-ancillary-bytes :int))
|
||||
|
||||
(cffi:defcstruct aacenc-info-struct
|
||||
(max-out-buf-bytes :uint)
|
||||
(max-ancillary-bytes :uint)
|
||||
(in-buf-fill-level :uint)
|
||||
(input-channels :uint)
|
||||
(frame-length :uint)
|
||||
(encoder-delay :uint)
|
||||
(conf-buf :pointer)
|
||||
(conf-size :uint))
|
||||
|
||||
(cffi:defcfun ("aacEncOpen" aac-enc-open) :int
|
||||
(ph-aac-encoder :pointer)
|
||||
(enc-modules :uint)
|
||||
(max-channels :uint))
|
||||
|
||||
(cffi:defcfun ("aacEncClose" aac-enc-close) :int
|
||||
(ph-aac-encoder :pointer))
|
||||
|
||||
(cffi:defcfun ("aacEncEncode" aac-enc-encode) :int
|
||||
(h-aac-encoder aac-encoder-handle)
|
||||
(in-buf-desc :pointer)
|
||||
(out-buf-desc :pointer)
|
||||
(in-args :pointer)
|
||||
(out-args :pointer))
|
||||
|
||||
(cffi:defcfun ("aacEncInfo" aac-enc-info) :int
|
||||
(h-aac-encoder aac-encoder-handle)
|
||||
(p-info :pointer))
|
||||
|
||||
(cffi:defcfun ("aacEncoder_SetParam" aac-encoder-set-param) :int
|
||||
(h-aac-encoder aac-encoder-handle)
|
||||
(param aac-encoder-param)
|
||||
(value :uint))
|
||||
|
||||
(cffi:defcfun ("aacEncoder_GetParam" aac-encoder-get-param) :uint
|
||||
(h-aac-encoder aac-encoder-handle)
|
||||
(param aac-encoder-param))
|
||||
|
||||
;; Shim: all FDK-AAC calls go through C to avoid SBCL signal handler conflicts
|
||||
(cffi:defcfun ("fdkaac_open_and_init" fdkaac-open-and-init) :int
|
||||
(out-handle :pointer)
|
||||
(sample-rate :int)
|
||||
(channels :int)
|
||||
(bitrate :int)
|
||||
(aot :int)
|
||||
(transmux :int)
|
||||
(afterburner :int)
|
||||
(out-frame-length :pointer)
|
||||
(out-max-out-bytes :pointer))
|
||||
|
||||
(cffi:defcfun ("fdkaac_encode" fdkaac-encode) :int
|
||||
(handle :pointer)
|
||||
(pcm-buf :pointer)
|
||||
(pcm-bytes :int)
|
||||
(num-samples :int)
|
||||
(out-buf :pointer)
|
||||
(out-buf-size :int)
|
||||
(out-bytes-written :pointer))
|
||||
|
||||
(cffi:defcfun ("fdkaac_close" fdkaac-close) :void
|
||||
(ph :pointer))
|
||||
|
|
@ -1,101 +0,0 @@
|
|||
/* Shim for FDK-AAC encoder initialization.
|
||||
SBCL's signal handlers conflict with FDK-AAC's internal memory access,
|
||||
causing recursive SIGSEGV when calling aacEncEncode or aacEncOpen from
|
||||
CFFI. This shim does the entire open+configure+init from C. */
|
||||
|
||||
#include <fdk-aac/aacenc_lib.h>
|
||||
#include <string.h>
|
||||
|
||||
/* Open, configure, and initialize an AAC encoder entirely from C.
|
||||
Returns 0 on success, or the FDK-AAC error code on failure.
|
||||
On success, *out_handle is set, and *out_frame_length / *out_max_out_bytes
|
||||
are filled from aacEncInfo. */
|
||||
int fdkaac_open_and_init(HANDLE_AACENCODER *out_handle,
|
||||
int sample_rate, int channels, int bitrate,
|
||||
int aot, int transmux, int afterburner,
|
||||
int *out_frame_length, int *out_max_out_bytes) {
|
||||
HANDLE_AACENCODER handle = NULL;
|
||||
AACENC_ERROR err;
|
||||
AACENC_InfoStruct info;
|
||||
|
||||
err = aacEncOpen(&handle, 0, channels);
|
||||
if (err != AACENC_OK) return (int)err;
|
||||
|
||||
if ((err = aacEncoder_SetParam(handle, AACENC_AOT, aot)) != AACENC_OK) goto fail;
|
||||
if ((err = aacEncoder_SetParam(handle, AACENC_SAMPLERATE, sample_rate)) != AACENC_OK) goto fail;
|
||||
if ((err = aacEncoder_SetParam(handle, AACENC_CHANNELMODE, channels == 1 ? MODE_1 : MODE_2)) != AACENC_OK) goto fail;
|
||||
if ((err = aacEncoder_SetParam(handle, AACENC_CHANNELORDER, 1)) != AACENC_OK) goto fail;
|
||||
if ((err = aacEncoder_SetParam(handle, AACENC_BITRATE, bitrate)) != AACENC_OK) goto fail;
|
||||
if ((err = aacEncoder_SetParam(handle, AACENC_TRANSMUX, transmux)) != AACENC_OK) goto fail;
|
||||
if ((err = aacEncoder_SetParam(handle, AACENC_AFTERBURNER, afterburner)) != AACENC_OK) goto fail;
|
||||
|
||||
err = aacEncEncode(handle, NULL, NULL, NULL, NULL);
|
||||
if (err != AACENC_OK) goto fail;
|
||||
|
||||
memset(&info, 0, sizeof(info));
|
||||
err = aacEncInfo(handle, &info);
|
||||
if (err != AACENC_OK) goto fail;
|
||||
|
||||
*out_handle = handle;
|
||||
*out_frame_length = info.frameLength;
|
||||
*out_max_out_bytes = info.maxOutBufBytes;
|
||||
return 0;
|
||||
|
||||
fail:
|
||||
aacEncClose(&handle);
|
||||
return (int)err;
|
||||
}
|
||||
|
||||
/* Encode PCM samples to AAC.
|
||||
pcm_buf: interleaved signed 16-bit PCM
|
||||
pcm_bytes: size of pcm_buf in bytes
|
||||
out_buf: output buffer for AAC data
|
||||
out_buf_size: size of out_buf in bytes
|
||||
out_bytes_written: set to actual bytes written on success
|
||||
Returns 0 on success, FDK-AAC error code on failure. */
|
||||
int fdkaac_encode(HANDLE_AACENCODER handle,
|
||||
void *pcm_buf, int pcm_bytes,
|
||||
int num_samples,
|
||||
void *out_buf, int out_buf_size,
|
||||
int *out_bytes_written) {
|
||||
AACENC_BufDesc in_desc = {0}, out_desc = {0};
|
||||
AACENC_InArgs in_args = {0};
|
||||
AACENC_OutArgs out_args = {0};
|
||||
AACENC_ERROR err;
|
||||
|
||||
void *in_ptr = pcm_buf;
|
||||
INT in_id = IN_AUDIO_DATA;
|
||||
INT in_size = pcm_bytes;
|
||||
INT in_el_size = sizeof(INT_PCM);
|
||||
|
||||
in_desc.numBufs = 1;
|
||||
in_desc.bufs = &in_ptr;
|
||||
in_desc.bufferIdentifiers = &in_id;
|
||||
in_desc.bufSizes = &in_size;
|
||||
in_desc.bufElSizes = &in_el_size;
|
||||
|
||||
void *out_ptr = out_buf;
|
||||
INT out_id = OUT_BITSTREAM_DATA;
|
||||
INT out_size = out_buf_size;
|
||||
INT out_el_size = 1;
|
||||
|
||||
out_desc.numBufs = 1;
|
||||
out_desc.bufs = &out_ptr;
|
||||
out_desc.bufferIdentifiers = &out_id;
|
||||
out_desc.bufSizes = &out_size;
|
||||
out_desc.bufElSizes = &out_el_size;
|
||||
|
||||
in_args.numInSamples = num_samples;
|
||||
in_args.numAncBytes = 0;
|
||||
|
||||
err = aacEncEncode(handle, &in_desc, &out_desc, &in_args, &out_args);
|
||||
if (err != AACENC_OK) return (int)err;
|
||||
|
||||
*out_bytes_written = out_args.numOutBytes;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Close an encoder handle. */
|
||||
void fdkaac_close(HANDLE_AACENCODER *ph) {
|
||||
aacEncClose(ph);
|
||||
}
|
||||
|
|
@ -1,516 +0,0 @@
|
|||
(defpackage #:cl-streamer/harmony
|
||||
(:use #:cl #:alexandria)
|
||||
(:local-nicknames (#:harmony #:org.shirakumo.fraf.harmony)
|
||||
(#:mixed #:org.shirakumo.fraf.mixed))
|
||||
(:export #:audio-pipeline
|
||||
#:make-audio-pipeline
|
||||
#:add-pipeline-output
|
||||
#:start-pipeline
|
||||
#:stop-pipeline
|
||||
#:play-file
|
||||
#:play-list
|
||||
#:pipeline-server
|
||||
#:make-streaming-server
|
||||
;; Track state & control
|
||||
#:pipeline-current-track
|
||||
#:pipeline-on-track-change
|
||||
#:pipeline-running-p
|
||||
#:pipeline-skip
|
||||
#:pipeline-queue-files
|
||||
#:pipeline-get-queue
|
||||
#:pipeline-clear-queue
|
||||
#:pipeline-pending-playlist-path
|
||||
#:pipeline-on-playlist-change
|
||||
;; Metadata helpers
|
||||
#:read-audio-metadata
|
||||
#:format-display-title
|
||||
#:update-all-mounts-metadata
|
||||
;; DJ support
|
||||
#:pipeline-harmony-server
|
||||
#:volume-ramp
|
||||
#:pipeline-stop-all-voices))
|
||||
|
||||
(in-package #:cl-streamer/harmony)
|
||||
|
||||
;;; ---- Streaming Drain ----
|
||||
;;; Custom drain that captures PCM from Harmony's pack buffer
|
||||
;;; and feeds it to the encoder/stream server, replacing the
|
||||
;;; dummy drain which just discards audio data.
|
||||
|
||||
(defclass streaming-drain (mixed:drain)
|
||||
((outputs :initarg :outputs :accessor drain-outputs :initform nil
|
||||
:documentation "List of (encoder . mount-path) pairs")
|
||||
(channels :initarg :channels :accessor drain-channels :initform 2)))
|
||||
|
||||
(defun drain-add-output (drain encoder mount-path)
|
||||
"Add an encoder/mount pair to the drain."
|
||||
(push (cons encoder mount-path) (drain-outputs drain)))
|
||||
|
||||
(defun drain-remove-output (drain mount-path)
|
||||
"Remove an encoder/mount pair by mount path."
|
||||
(setf (drain-outputs drain)
|
||||
(remove mount-path (drain-outputs drain) :key #'cdr :test #'string=)))
|
||||
|
||||
(defmethod mixed:free ((drain streaming-drain)))
|
||||
|
||||
(defmethod mixed:start ((drain streaming-drain)))
|
||||
|
||||
(defmethod mixed:mix ((drain streaming-drain))
|
||||
"Read interleaved s16 PCM from the pack buffer, encode to all outputs.
|
||||
The pack is created with :encoding :int16, so cl-mixed converts float→s16 in C.
|
||||
Layout: L0lo L0hi R0lo R0hi L1lo L1hi R1lo R1hi ... (interleaved stereo, 2 bytes/sample)"
|
||||
(mixed:with-buffer-tx (data start size (mixed:pack drain))
|
||||
(when (> size 0)
|
||||
(let* ((channels (drain-channels drain))
|
||||
(bytes-per-sample 2) ; int16 = 2 bytes
|
||||
(total-samples (floor size bytes-per-sample))
|
||||
(num-samples (floor total-samples channels))
|
||||
(pcm-buffer (make-array (* num-samples channels)
|
||||
:element-type '(signed-byte 16))))
|
||||
;; Read s16 PCM directly — no conversion needed, cl-mixed did it
|
||||
(cffi:with-pointer-to-vector-data (ptr data)
|
||||
(loop for i below (* num-samples channels)
|
||||
for byte-offset = (+ start (* i bytes-per-sample))
|
||||
do (setf (aref pcm-buffer i) (cffi:mem-ref ptr :int16 byte-offset))))
|
||||
;; Feed PCM to all encoder/mount pairs
|
||||
(dolist (output (drain-outputs drain))
|
||||
(let ((encoder (car output))
|
||||
(mount-path (cdr output)))
|
||||
(handler-case
|
||||
(let ((encoded (encode-for-output encoder pcm-buffer num-samples)))
|
||||
(when (> (length encoded) 0)
|
||||
(cl-streamer:write-audio-data mount-path encoded)))
|
||||
(error (e)
|
||||
(log:warn "Encode error for ~A: ~A" mount-path e)))))))
|
||||
;; Sleep for most of the audio duration (leave headroom for encoding)
|
||||
(let* ((channels (drain-channels drain))
|
||||
(bytes-per-frame (* channels 2)) ; 2 bytes per sample (int16)
|
||||
(frames (floor size bytes-per-frame))
|
||||
(samplerate (mixed:samplerate (mixed:pack drain))))
|
||||
(when (> frames 0)
|
||||
(sleep (* 0.9 (/ frames samplerate)))))
|
||||
(mixed:finish size)))
|
||||
|
||||
(defgeneric encode-for-output (encoder pcm-buffer num-samples)
|
||||
(:documentation "Encode PCM samples using the given encoder. Returns byte vector."))
|
||||
|
||||
(defmethod encode-for-output ((encoder cl-streamer::mp3-encoder) pcm-buffer num-samples)
|
||||
(cl-streamer:encode-pcm-interleaved encoder pcm-buffer num-samples))
|
||||
|
||||
(defmethod encode-for-output ((encoder cl-streamer::aac-encoder) pcm-buffer num-samples)
|
||||
(cl-streamer:encode-aac-pcm encoder pcm-buffer num-samples))
|
||||
|
||||
(defmethod mixed:end ((drain streaming-drain)))
|
||||
|
||||
;;; ---- Audio Pipeline ----
|
||||
|
||||
(defclass audio-pipeline ()
|
||||
((harmony-server :initform nil :accessor pipeline-harmony-server)
|
||||
(drain :initform nil :accessor pipeline-drain)
|
||||
(stream-server :initarg :stream-server :accessor pipeline-server)
|
||||
(mount-path :initarg :mount-path :accessor pipeline-mount-path :initform "/stream.mp3")
|
||||
(sample-rate :initarg :sample-rate :accessor pipeline-sample-rate :initform 44100)
|
||||
(channels :initarg :channels :accessor pipeline-channels :initform 2)
|
||||
(running :initform nil :accessor pipeline-running-p)
|
||||
;; Track state
|
||||
(current-track :initform nil :accessor pipeline-current-track
|
||||
:documentation "Plist of current track: (:title :artist :album :file :display-title)")
|
||||
(on-track-change :initarg :on-track-change :initform nil
|
||||
:accessor pipeline-on-track-change
|
||||
:documentation "Callback (lambda (pipeline track-info)) called on track change")
|
||||
;; Playlist queue & skip control
|
||||
(file-queue :initform nil :accessor pipeline-file-queue
|
||||
:documentation "List of file entries to play after current playlist")
|
||||
(queue-lock :initform (bt:make-lock "pipeline-queue-lock")
|
||||
:reader pipeline-queue-lock)
|
||||
(skip-flag :initform nil :accessor pipeline-skip-flag
|
||||
:documentation "Set to T to skip the current track")
|
||||
(pending-playlist-path :initform nil :accessor pipeline-pending-playlist-path
|
||||
:documentation "Playlist path queued by scheduler, applied when tracks start playing")
|
||||
(on-playlist-change :initarg :on-playlist-change :initform nil
|
||||
:accessor pipeline-on-playlist-change
|
||||
:documentation "Callback (lambda (pipeline playlist-path)) called when scheduler playlist starts")))
|
||||
|
||||
(defun make-audio-pipeline (&key encoder stream-server (mount-path "/stream.mp3")
|
||||
(sample-rate 44100) (channels 2))
|
||||
"Create an audio pipeline connecting Harmony to the stream server via an encoder.
|
||||
The initial encoder/mount-path pair is added as the first output.
|
||||
Additional outputs can be added with add-pipeline-output."
|
||||
(let ((pipeline (make-instance 'audio-pipeline
|
||||
:stream-server stream-server
|
||||
:mount-path mount-path
|
||||
:sample-rate sample-rate
|
||||
:channels channels)))
|
||||
(when encoder
|
||||
(setf (slot-value pipeline 'drain)
|
||||
(make-instance 'streaming-drain :channels channels))
|
||||
(drain-add-output (pipeline-drain pipeline) encoder mount-path))
|
||||
pipeline))
|
||||
|
||||
(defun add-pipeline-output (pipeline encoder mount-path)
|
||||
"Add an additional encoder/mount output to the pipeline.
|
||||
Can be called before or after start-pipeline."
|
||||
(unless (pipeline-drain pipeline)
|
||||
(setf (pipeline-drain pipeline)
|
||||
(make-instance 'streaming-drain :channels (pipeline-channels pipeline))))
|
||||
(drain-add-output (pipeline-drain pipeline) encoder mount-path))
|
||||
|
||||
(defun start-pipeline (pipeline)
|
||||
"Start the audio pipeline - initializes Harmony with our streaming drain."
|
||||
(when (pipeline-running-p pipeline)
|
||||
(error "Pipeline already running"))
|
||||
(mixed:init)
|
||||
(let* ((server (harmony:make-simple-server
|
||||
:name "CL-Streamer"
|
||||
:samplerate (pipeline-sample-rate pipeline)
|
||||
:latency 0.05
|
||||
:drain :dummy
|
||||
:output-channels (pipeline-channels pipeline)))
|
||||
(output (harmony:segment :output server))
|
||||
(old-drain (harmony:segment :drain output))
|
||||
(drain (pipeline-drain pipeline)))
|
||||
;; Replace the default float packer with an int16 packer.
|
||||
;; cl-mixed handles float→s16 conversion in C (faster than our Lisp loop).
|
||||
(let* ((old-packer (harmony:segment :packer output))
|
||||
(new-packer (mixed:make-packer
|
||||
:encoding :int16
|
||||
:channels (pipeline-channels pipeline)
|
||||
:samplerate (pipeline-sample-rate pipeline)
|
||||
:frames (* 2 (harmony::buffersize server)))))
|
||||
;; Connect upmix → new packer (same wiring as old)
|
||||
(harmony:connect (harmony:segment :upmix output) T new-packer T)
|
||||
;; Withdraw old packer and float drain, add new int16 packer and our drain
|
||||
(mixed:withdraw old-drain output)
|
||||
(mixed:withdraw old-packer output)
|
||||
(mixed:add new-packer output)
|
||||
(setf (mixed:pack drain) (mixed:pack new-packer))
|
||||
(mixed:add drain output))
|
||||
(setf (pipeline-harmony-server pipeline) server)
|
||||
(mixed:start server))
|
||||
(setf (pipeline-running-p pipeline) t)
|
||||
(log:info "Audio pipeline started with streaming drain (~A outputs)"
|
||||
(length (drain-outputs (pipeline-drain pipeline))))
|
||||
pipeline)
|
||||
|
||||
(defun stop-pipeline (pipeline)
|
||||
"Stop the audio pipeline."
|
||||
(setf (pipeline-running-p pipeline) nil)
|
||||
(when (pipeline-harmony-server pipeline)
|
||||
(mixed:end (pipeline-harmony-server pipeline))
|
||||
(setf (pipeline-harmony-server pipeline) nil))
|
||||
(log:info "Audio pipeline stopped")
|
||||
pipeline)
|
||||
|
||||
;;; ---- Pipeline Control ----
|
||||
|
||||
(defun pipeline-skip (pipeline)
|
||||
"Skip the current track. The play-list loop will detect this and advance."
|
||||
(setf (pipeline-skip-flag pipeline) t)
|
||||
(log:info "Skip requested"))
|
||||
|
||||
(defun pipeline-queue-files (pipeline file-entries &key (position :end))
|
||||
"Add file entries to the pipeline queue.
|
||||
Each entry is a string (path) or plist (:file path :title title).
|
||||
POSITION is :end (append) or :next (prepend)."
|
||||
(bt:with-lock-held ((pipeline-queue-lock pipeline))
|
||||
(case position
|
||||
(:next (setf (pipeline-file-queue pipeline)
|
||||
(append file-entries (pipeline-file-queue pipeline))))
|
||||
(t (setf (pipeline-file-queue pipeline)
|
||||
(append (pipeline-file-queue pipeline) file-entries)))))
|
||||
(log:info "Queued ~A files (~A)" (length file-entries) position))
|
||||
|
||||
(defun pipeline-get-queue (pipeline)
|
||||
"Get the current file queue (copy)."
|
||||
(bt:with-lock-held ((pipeline-queue-lock pipeline))
|
||||
(copy-list (pipeline-file-queue pipeline))))
|
||||
|
||||
(defun pipeline-clear-queue (pipeline)
|
||||
"Clear the file queue."
|
||||
(bt:with-lock-held ((pipeline-queue-lock pipeline))
|
||||
(setf (pipeline-file-queue pipeline) nil))
|
||||
(log:info "Queue cleared"))
|
||||
|
||||
(defun pipeline-stop-all-voices (pipeline)
|
||||
"Immediately stop all active voices on the Harmony mixer.
|
||||
Used by DJ session to silence the auto-playlist before mixing."
|
||||
(let ((server (pipeline-harmony-server pipeline)))
|
||||
(when server
|
||||
(let ((harmony:*server* server))
|
||||
(dolist (voice (harmony:voices server))
|
||||
(handler-case
|
||||
(progn
|
||||
(setf (mixed:volume voice) 0.0)
|
||||
(harmony:stop voice))
|
||||
(error (e)
|
||||
(log:debug "Error stopping voice: ~A" e))))
|
||||
(log:info "All voices stopped on mixer")))))
|
||||
|
||||
(defun pipeline-pop-queue (pipeline)
|
||||
"Pop the next entry from the file queue (internal use)."
|
||||
(bt:with-lock-held ((pipeline-queue-lock pipeline))
|
||||
(pop (pipeline-file-queue pipeline))))
|
||||
|
||||
;;; ---- Metadata ----
|
||||
|
||||
(defun ensure-simple-string (s)
|
||||
"Coerce S to a simple-string if it's a string, or return NIL.
|
||||
Coerce first to guarantee simple-string before any string operations,
|
||||
since SBCL's string-trim may require simple-string input."
|
||||
(when (stringp s)
|
||||
(let ((simple (coerce s 'simple-string)))
|
||||
(string-trim '(#\Space #\Nul) simple))))
|
||||
|
||||
(defun safe-tag (fn audio-file)
|
||||
"Safely read a tag field, coercing to simple-string. Returns NIL on any error."
|
||||
(handler-case
|
||||
(ensure-simple-string (funcall fn audio-file))
|
||||
(error () nil)))
|
||||
|
||||
(defun read-audio-metadata (file-path)
|
||||
"Read metadata (artist, title, album) from an audio file using taglib.
|
||||
Returns a plist (:artist ... :title ... :album ...) or NIL on failure."
|
||||
(handler-case
|
||||
(let ((audio-file (audio-streams:open-audio-file (namestring file-path))))
|
||||
(list :artist (safe-tag #'abstract-tag:artist audio-file)
|
||||
:title (safe-tag #'abstract-tag:title audio-file)
|
||||
:album (safe-tag #'abstract-tag:album audio-file)))
|
||||
(error (e)
|
||||
(log:debug "Could not read tags from ~A: ~A" file-path e)
|
||||
nil)))
|
||||
|
||||
(defun format-display-title (file-path &optional explicit-title)
|
||||
"Build a display title for ICY metadata.
|
||||
If EXPLICIT-TITLE is given, use it.
|
||||
Otherwise read tags from the file: 'Artist - Title' or fall back to filename."
|
||||
(or explicit-title
|
||||
(let ((tags (read-audio-metadata file-path)))
|
||||
(if tags
|
||||
(let ((artist (getf tags :artist))
|
||||
(title (getf tags :title)))
|
||||
(cond ((and artist title (not (string= artist ""))
|
||||
(not (string= title "")))
|
||||
(format nil "~A - ~A" artist title))
|
||||
(title title)
|
||||
(artist artist)
|
||||
(t (pathname-name (pathname file-path)))))
|
||||
(pathname-name (pathname file-path))))))
|
||||
|
||||
(defun update-all-mounts-metadata (pipeline display-title)
|
||||
"Update ICY metadata on all mount points."
|
||||
(dolist (output (drain-outputs (pipeline-drain pipeline)))
|
||||
(cl-streamer:set-now-playing (cdr output) display-title)))
|
||||
|
||||
(defun notify-track-change (pipeline track-info)
|
||||
"Update pipeline state and fire the on-track-change callback."
|
||||
(setf (pipeline-current-track pipeline) track-info)
|
||||
(when (pipeline-on-track-change pipeline)
|
||||
(handler-case
|
||||
(funcall (pipeline-on-track-change pipeline) pipeline track-info)
|
||||
(error (e)
|
||||
(log:warn "Track change callback error: ~A" e)))))
|
||||
|
||||
(defun play-file (pipeline file-path &key (mixer :music) title (on-end :free)
|
||||
(update-metadata t))
|
||||
"Play an audio file through the pipeline.
|
||||
The file will be decoded by Harmony and encoded for streaming.
|
||||
If TITLE is given, update ICY metadata with it.
|
||||
Otherwise reads tags from the file via taglib.
|
||||
FILE-PATH can be a string or pathname.
|
||||
ON-END is passed to harmony:play (default :free).
|
||||
UPDATE-METADATA controls whether ICY metadata is updated immediately."
|
||||
(let* ((path-string (etypecase file-path
|
||||
(string file-path)
|
||||
(pathname (namestring file-path))))
|
||||
;; Use parse-native-namestring to prevent SBCL from interpreting
|
||||
;; brackets as wildcard patterns. Standard (pathname ...) turns
|
||||
;; "[FLAC]" into a wild component with non-simple strings, which
|
||||
;; causes SIMPLE-ARRAY errors in cl-flac's CFFI calls.
|
||||
(path (sb-ext:parse-native-namestring path-string))
|
||||
(server (pipeline-harmony-server pipeline))
|
||||
(harmony:*server* server)
|
||||
(tags (read-audio-metadata path))
|
||||
(display-title (format-display-title path title))
|
||||
(track-info (list :file path-string
|
||||
:display-title display-title
|
||||
:artist (getf tags :artist)
|
||||
:title (getf tags :title)
|
||||
:album (getf tags :album))))
|
||||
(when update-metadata
|
||||
(update-all-mounts-metadata pipeline display-title)
|
||||
(notify-track-change pipeline track-info))
|
||||
(let ((voice (harmony:play path :mixer mixer :on-end on-end)))
|
||||
(if update-metadata
|
||||
(log:info "Now playing: ~A" display-title)
|
||||
(log:info "Loading next: ~A" display-title))
|
||||
(values voice display-title track-info))))
|
||||
|
||||
(defun voice-remaining-seconds (voice)
|
||||
"Return estimated seconds remaining for a voice, or NIL if unknown."
|
||||
(handler-case
|
||||
(let ((pos (mixed:frame-position voice))
|
||||
(total (mixed:frame-count voice))
|
||||
(sr (mixed:samplerate voice)))
|
||||
(when (and pos total sr (> total 0) (> sr 0))
|
||||
(/ (- total pos) sr)))
|
||||
(error () nil)))
|
||||
|
||||
(defun volume-ramp (voice target-volume duration &key (steps 20))
|
||||
"Smoothly ramp a voice's volume to TARGET-VOLUME over DURATION seconds.
|
||||
Runs in the calling thread (blocks for DURATION seconds)."
|
||||
(let* ((start-volume (mixed:volume voice))
|
||||
(delta (- target-volume start-volume))
|
||||
(step-time (/ duration steps)))
|
||||
(loop for i from 1 to steps
|
||||
for fraction = (/ i steps)
|
||||
for vol = (+ start-volume (* delta fraction))
|
||||
do (setf (mixed:volume voice) (max 0.0 (min 1.0 (float vol))))
|
||||
(sleep step-time))))
|
||||
|
||||
(defun drain-queue-into-remaining (pipeline remaining-ref current-list-ref)
|
||||
"If the scheduler has queued tracks, drain them all into remaining-ref,
|
||||
replacing any current remaining tracks. Also update current-list-ref
|
||||
so loop-queue replays the scheduler's playlist, not the original.
|
||||
Returns T if new tracks were loaded, NIL otherwise."
|
||||
(let ((first (pipeline-pop-queue pipeline)))
|
||||
(when first
|
||||
(let ((all-queued (list first)))
|
||||
;; Drain remaining queue entries
|
||||
(loop for item = (pipeline-pop-queue pipeline)
|
||||
while item do (push item all-queued))
|
||||
(setf all-queued (nreverse all-queued))
|
||||
(log:info "Scheduler playlist taking over: ~A tracks" (length all-queued))
|
||||
;; Replace remaining list and update current for loop-queue
|
||||
(setf (car remaining-ref) all-queued)
|
||||
(setf (car current-list-ref) (copy-list all-queued))
|
||||
;; Fire playlist-change callback so app layer updates metadata
|
||||
(when (pipeline-on-playlist-change pipeline)
|
||||
(let ((playlist-path (pipeline-pending-playlist-path pipeline)))
|
||||
(when playlist-path
|
||||
(handler-case
|
||||
(funcall (pipeline-on-playlist-change pipeline)
|
||||
pipeline playlist-path)
|
||||
(error (e)
|
||||
(log:warn "Playlist change callback error: ~A" e)))
|
||||
(setf (pipeline-pending-playlist-path pipeline) nil))))
|
||||
t))))
|
||||
|
||||
(defun next-entry (pipeline remaining-ref current-list-ref)
|
||||
"Get the next entry to play. Checks scheduler queue first (drains all into remaining),
|
||||
then pops from remaining-ref.
|
||||
REMAINING-REF is a cons cell whose car is the remaining file list.
|
||||
CURRENT-LIST-REF is a cons cell whose car is the full current playlist (for loop-queue)."
|
||||
(drain-queue-into-remaining pipeline remaining-ref current-list-ref)
|
||||
(pop (car remaining-ref)))
|
||||
|
||||
(defun play-list (pipeline file-list &key (crossfade-duration 3.0)
|
||||
(fade-in 2.0)
|
||||
(fade-out 2.0)
|
||||
(loop-queue nil))
|
||||
"Play a list of file paths sequentially through the pipeline.
|
||||
Each entry can be a string (path) or a plist (:file path :title title).
|
||||
CROSSFADE-DURATION is how early to start the next track (seconds).
|
||||
FADE-IN/FADE-OUT control the volume ramp durations.
|
||||
Both voices play simultaneously through the mixer during crossfade.
|
||||
When LOOP-QUEUE is T, repeats the playlist from the start when tracks run out.
|
||||
Scheduler-queued tracks take priority over the repeat cycle."
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(handler-case
|
||||
(let ((prev-voice nil)
|
||||
(idx 0)
|
||||
(remaining-list (list (copy-list file-list)))
|
||||
(current-list (list (copy-list file-list))))
|
||||
(loop while (pipeline-running-p pipeline)
|
||||
for entry = (next-entry pipeline remaining-list current-list)
|
||||
do (cond
|
||||
;; No entry and loop mode: re-queue current playlist
|
||||
((and (null entry) loop-queue)
|
||||
(log:info "Playlist ended, repeating from start (~A tracks)"
|
||||
(length (car current-list)))
|
||||
(setf (car remaining-list) (copy-list (car current-list))))
|
||||
;; No entry: done
|
||||
((null entry)
|
||||
(return))
|
||||
;; Play the entry
|
||||
(t
|
||||
(multiple-value-bind (path title)
|
||||
(if (listp entry)
|
||||
(values (getf entry :file) (getf entry :title))
|
||||
(values entry nil))
|
||||
(handler-case
|
||||
(let* ((server (pipeline-harmony-server pipeline))
|
||||
(harmony:*server* server))
|
||||
(multiple-value-bind (voice display-title track-info)
|
||||
(handler-case
|
||||
(play-file pipeline path :title title
|
||||
:on-end :disconnect
|
||||
:update-metadata (null prev-voice))
|
||||
(error (retry-err)
|
||||
;; Retry once after brief delay for transient FLAC init errors
|
||||
(log:debug "Retrying ~A after init error: ~A"
|
||||
(pathname-name (pathname path)) retry-err)
|
||||
(sleep 0.2)
|
||||
(play-file pipeline path :title title
|
||||
:on-end :disconnect
|
||||
:update-metadata (null prev-voice))))
|
||||
(when voice
|
||||
;; If this isn't the first track, crossfade
|
||||
(when (and prev-voice (> idx 0))
|
||||
(setf (mixed:volume voice) 0.0)
|
||||
(let ((fade-thread
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(volume-ramp prev-voice 0.0 fade-out)
|
||||
(harmony:stop prev-voice))
|
||||
:name "cl-streamer-fadeout")))
|
||||
(volume-ramp voice 1.0 fade-in)
|
||||
(bt:join-thread fade-thread))
|
||||
;; Crossfade done — brief pause so listeners perceive
|
||||
;; the new track before UI updates
|
||||
(sleep 1.0)
|
||||
(update-all-mounts-metadata pipeline display-title)
|
||||
(notify-track-change pipeline track-info))
|
||||
;; Wait for track to approach its end (or skip)
|
||||
(setf (pipeline-skip-flag pipeline) nil)
|
||||
(sleep 0.5)
|
||||
;; Log initial track duration info
|
||||
(let ((initial-remaining (voice-remaining-seconds voice)))
|
||||
(log:info "Track duration check: remaining=~A pos=~A total=~A sr=~A"
|
||||
initial-remaining
|
||||
(ignore-errors (mixed:frame-position voice))
|
||||
(ignore-errors (mixed:frame-count voice))
|
||||
(ignore-errors (mixed:samplerate voice))))
|
||||
(loop while (and (pipeline-running-p pipeline)
|
||||
(not (mixed:done-p voice))
|
||||
(not (pipeline-skip-flag pipeline)))
|
||||
for remaining = (voice-remaining-seconds voice)
|
||||
when (and remaining
|
||||
(<= remaining crossfade-duration)
|
||||
(not (mixed:done-p voice)))
|
||||
do (log:info "Crossfade trigger: ~,1Fs remaining" remaining)
|
||||
(setf prev-voice voice)
|
||||
(return)
|
||||
do (sleep 0.1))
|
||||
;; Handle skip
|
||||
(when (pipeline-skip-flag pipeline)
|
||||
(setf (pipeline-skip-flag pipeline) nil)
|
||||
(setf prev-voice voice)
|
||||
(log:info "Skipping current track"))
|
||||
;; If track ended naturally (no crossfade), clean up
|
||||
(when (mixed:done-p voice)
|
||||
(harmony:stop voice)
|
||||
(setf prev-voice nil))
|
||||
(incf idx))))
|
||||
(error (e)
|
||||
(log:warn "Error playing ~A: ~A" path e)
|
||||
(sleep 1)))))))
|
||||
;; Clean up last voice
|
||||
(when prev-voice
|
||||
(let ((harmony:*server* (pipeline-harmony-server pipeline)))
|
||||
(volume-ramp prev-voice 0.0 fade-out)
|
||||
(harmony:stop prev-voice))))
|
||||
(error (e)
|
||||
(log:error "play-list thread crashed: ~A" e))))
|
||||
:name "cl-streamer-playlist"))
|
||||
|
||||
|
|
@ -1,58 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
(defparameter *default-metaint* 16000
|
||||
"Default ICY metadata interval in bytes.")
|
||||
|
||||
(defclass icy-metadata ()
|
||||
((title :initarg :title :accessor icy-metadata-title :initform nil)
|
||||
(url :initarg :url :accessor icy-metadata-url :initform nil)))
|
||||
|
||||
(defun make-icy-metadata (&key title url)
|
||||
"Create an ICY metadata object."
|
||||
(make-instance 'icy-metadata :title title :url url))
|
||||
|
||||
(defun encode-icy-metadata (metadata)
|
||||
"Encode metadata into ICY protocol format.
|
||||
Returns a byte vector with length prefix."
|
||||
(let* ((stream-title (or (icy-metadata-title metadata) ""))
|
||||
(stream-url (or (icy-metadata-url metadata) ""))
|
||||
(meta-string (format nil "StreamTitle='~A';StreamUrl='~A';"
|
||||
stream-title stream-url))
|
||||
(meta-bytes (flexi-streams:string-to-octets meta-string :external-format :utf-8))
|
||||
(meta-len (length meta-bytes))
|
||||
(padded-len (* 16 (ceiling meta-len 16)))
|
||||
(length-byte (floor padded-len 16))
|
||||
(result (make-array (1+ padded-len) :element-type '(unsigned-byte 8)
|
||||
:initial-element 0)))
|
||||
(setf (aref result 0) length-byte)
|
||||
(replace result meta-bytes :start1 1)
|
||||
result))
|
||||
|
||||
(defun parse-icy-request (request-line headers)
|
||||
"Parse an ICY/HTTP request. Returns (values mount-point wants-metadata-p).
|
||||
HEADERS is an alist of (name . value) pairs."
|
||||
(let* ((parts (split-sequence:split-sequence #\Space request-line))
|
||||
(path (second parts))
|
||||
(icy-metadata-header (cdr (assoc "icy-metadata" headers :test #'string-equal))))
|
||||
(values path
|
||||
(and icy-metadata-header
|
||||
(string= icy-metadata-header "1")))))
|
||||
|
||||
(defun write-icy-response-headers (stream &key content-type metaint
|
||||
(name "CL-Streamer")
|
||||
(genre "Various")
|
||||
(bitrate 128))
|
||||
"Write ICY/HTTP response headers to STREAM."
|
||||
(format stream "HTTP/1.1 200 OK~C~C" #\Return #\Linefeed)
|
||||
(format stream "Content-Type: ~A~C~C" content-type #\Return #\Linefeed)
|
||||
(format stream "icy-name: ~A~C~C" name #\Return #\Linefeed)
|
||||
(format stream "icy-genre: ~A~C~C" genre #\Return #\Linefeed)
|
||||
(format stream "icy-br: ~A~C~C" bitrate #\Return #\Linefeed)
|
||||
(when metaint
|
||||
(format stream "icy-metaint: ~A~C~C" metaint #\Return #\Linefeed))
|
||||
(format stream "Access-Control-Allow-Origin: *~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Allow-Headers: Origin, Accept, Content-Type, Icy-MetaData~C~C" #\Return #\Linefeed)
|
||||
(format stream "Cache-Control: no-cache, no-store~C~C" #\Return #\Linefeed)
|
||||
(format stream "Connection: close~C~C" #\Return #\Linefeed)
|
||||
(format stream "~C~C" #\Return #\Linefeed)
|
||||
(force-output stream))
|
||||
|
|
@ -1,92 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
(cffi:define-foreign-library liblame
|
||||
(:unix (:or "libmp3lame.so.0" "libmp3lame.so"))
|
||||
(:darwin "libmp3lame.dylib")
|
||||
(:windows "libmp3lame.dll")
|
||||
(t (:default "libmp3lame")))
|
||||
|
||||
(cffi:use-foreign-library liblame)
|
||||
|
||||
(cffi:defctype lame-global-flags :pointer)
|
||||
|
||||
(cffi:defcenum lame-vbr-mode
|
||||
(:vbr-off 0)
|
||||
(:vbr-mt 1)
|
||||
(:vbr-rh 2)
|
||||
(:vbr-abr 3)
|
||||
(:vbr-mtrh 4)
|
||||
(:vbr-default 4))
|
||||
|
||||
(cffi:defcenum lame-mode
|
||||
(:stereo 0)
|
||||
(:joint-stereo 1)
|
||||
(:dual-channel 2)
|
||||
(:mono 3))
|
||||
|
||||
(cffi:defcfun ("lame_init" lame-init) lame-global-flags)
|
||||
|
||||
(cffi:defcfun ("lame_close" lame-close) :int
|
||||
(gfp lame-global-flags))
|
||||
|
||||
(cffi:defcfun ("lame_set_in_samplerate" lame-set-in-samplerate) :int
|
||||
(gfp lame-global-flags)
|
||||
(rate :int))
|
||||
|
||||
(cffi:defcfun ("lame_set_out_samplerate" lame-set-out-samplerate) :int
|
||||
(gfp lame-global-flags)
|
||||
(rate :int))
|
||||
|
||||
(cffi:defcfun ("lame_set_num_channels" lame-set-num-channels) :int
|
||||
(gfp lame-global-flags)
|
||||
(channels :int))
|
||||
|
||||
(cffi:defcfun ("lame_set_mode" lame-set-mode) :int
|
||||
(gfp lame-global-flags)
|
||||
(mode lame-mode))
|
||||
|
||||
(cffi:defcfun ("lame_set_quality" lame-set-quality) :int
|
||||
(gfp lame-global-flags)
|
||||
(quality :int))
|
||||
|
||||
(cffi:defcfun ("lame_set_brate" lame-set-brate) :int
|
||||
(gfp lame-global-flags)
|
||||
(brate :int))
|
||||
|
||||
(cffi:defcfun ("lame_set_VBR" lame-set-vbr) :int
|
||||
(gfp lame-global-flags)
|
||||
(vbr-mode lame-vbr-mode))
|
||||
|
||||
(cffi:defcfun ("lame_set_VBR_quality" lame-set-vbr-quality) :int
|
||||
(gfp lame-global-flags)
|
||||
(quality :float))
|
||||
|
||||
(cffi:defcfun ("lame_init_params" lame-init-params) :int
|
||||
(gfp lame-global-flags))
|
||||
|
||||
(cffi:defcfun ("lame_encode_buffer_interleaved" lame-encode-buffer-interleaved) :int
|
||||
(gfp lame-global-flags)
|
||||
(pcm :pointer)
|
||||
(num-samples :int)
|
||||
(mp3buf :pointer)
|
||||
(mp3buf-size :int))
|
||||
|
||||
(cffi:defcfun ("lame_encode_buffer" lame-encode-buffer) :int
|
||||
(gfp lame-global-flags)
|
||||
(buffer-l :pointer)
|
||||
(buffer-r :pointer)
|
||||
(num-samples :int)
|
||||
(mp3buf :pointer)
|
||||
(mp3buf-size :int))
|
||||
|
||||
(cffi:defcfun ("lame_encode_flush" lame-encode-flush) :int
|
||||
(gfp lame-global-flags)
|
||||
(mp3buf :pointer)
|
||||
(mp3buf-size :int))
|
||||
|
||||
(cffi:defcfun ("lame_get_lametag_frame" lame-get-lametag-frame) :size
|
||||
(gfp lame-global-flags)
|
||||
(buffer :pointer)
|
||||
(size :size))
|
||||
|
||||
(cffi:defcfun ("get_lame_version" get-lame-version) :string)
|
||||
Binary file not shown.
|
|
@ -1,58 +0,0 @@
|
|||
(defpackage #:cl-streamer
|
||||
(:use #:cl #:alexandria)
|
||||
(:export
|
||||
;; Conditions
|
||||
#:streamer-error
|
||||
#:connection-error
|
||||
#:encoding-error
|
||||
|
||||
;; Buffer
|
||||
#:broadcast-buffer
|
||||
#:make-ring-buffer
|
||||
#:buffer-write
|
||||
#:buffer-read-from
|
||||
#:buffer-wait-for-data
|
||||
#:buffer-current-pos
|
||||
#:buffer-burst-start
|
||||
#:buffer-clear
|
||||
|
||||
;; ICY Protocol
|
||||
#:icy-metadata
|
||||
#:make-icy-metadata
|
||||
#:icy-metadata-title
|
||||
#:icy-metadata-url
|
||||
#:encode-icy-metadata
|
||||
#:icy-metaint
|
||||
|
||||
;; Stream Server
|
||||
#:stream-server
|
||||
#:make-stream-server
|
||||
#:start-server
|
||||
#:stop-server
|
||||
#:server-running-p
|
||||
#:add-mount
|
||||
#:remove-mount
|
||||
#:update-metadata
|
||||
#:listener-count
|
||||
|
||||
;; Main API
|
||||
#:*server*
|
||||
#:*default-port*
|
||||
#:*default-metaint*
|
||||
#:start
|
||||
#:stop
|
||||
#:write-audio-data
|
||||
#:set-now-playing
|
||||
#:get-listener-count
|
||||
|
||||
;; Encoder
|
||||
#:make-mp3-encoder
|
||||
#:close-encoder
|
||||
#:encode-pcm-interleaved
|
||||
#:encode-flush
|
||||
#:lame-version
|
||||
|
||||
;; AAC Encoder
|
||||
#:make-aac-encoder
|
||||
#:close-aac-encoder
|
||||
#:encode-aac-pcm))
|
||||
|
|
@ -1,252 +0,0 @@
|
|||
(in-package #:cl-streamer)
|
||||
|
||||
(defparameter *default-port* 8000
|
||||
"Default port for the streaming server.")
|
||||
|
||||
(defclass stream-server ()
|
||||
((port :initarg :port :accessor server-port :initform *default-port*)
|
||||
(socket :initform nil :accessor server-socket)
|
||||
(running :initform nil :accessor server-running-p)
|
||||
(mounts :initform (make-hash-table :test 'equal) :accessor server-mounts)
|
||||
(clients :initform nil :accessor server-clients)
|
||||
(clients-lock :initform (bt:make-lock "clients-lock") :reader server-clients-lock)
|
||||
(accept-thread :initform nil :accessor server-accept-thread)))
|
||||
|
||||
(defclass mount-point ()
|
||||
((path :initarg :path :accessor mount-path)
|
||||
(content-type :initarg :content-type :accessor mount-content-type
|
||||
:initform "audio/mpeg")
|
||||
(bitrate :initarg :bitrate :accessor mount-bitrate :initform 128)
|
||||
(name :initarg :name :accessor mount-name :initform "CL-Streamer")
|
||||
(genre :initarg :genre :accessor mount-genre :initform "Various")
|
||||
(buffer :initarg :buffer :accessor mount-buffer)
|
||||
(metadata :initform (make-icy-metadata) :accessor mount-metadata)
|
||||
(metadata-lock :initform (bt:make-lock "metadata-lock") :reader mount-metadata-lock)))
|
||||
|
||||
(defclass client-connection ()
|
||||
((socket :initarg :socket :accessor client-socket)
|
||||
(stream :initarg :stream :accessor client-stream)
|
||||
(mount :initarg :mount :accessor client-mount)
|
||||
(wants-metadata :initarg :wants-metadata :accessor client-wants-metadata-p)
|
||||
(bytes-since-meta :initform 0 :accessor client-bytes-since-meta)
|
||||
(read-pos :initform 0 :accessor client-read-pos
|
||||
:documentation "Client's absolute position in the broadcast buffer")
|
||||
(thread :initform nil :accessor client-thread)
|
||||
(active :initform t :accessor client-active-p)))
|
||||
|
||||
(defun make-stream-server (&key (port *default-port*))
|
||||
"Create a new stream server instance."
|
||||
(make-instance 'stream-server :port port))
|
||||
|
||||
(defun add-mount (server path &key (content-type "audio/mpeg")
|
||||
(bitrate 128)
|
||||
(name "CL-Streamer")
|
||||
(genre "Various")
|
||||
(buffer-size (* 1024 1024)))
|
||||
"Add a mount point to the server."
|
||||
(let ((mount (make-instance 'mount-point
|
||||
:path path
|
||||
:content-type content-type
|
||||
:bitrate bitrate
|
||||
:name name
|
||||
:genre genre
|
||||
:buffer (make-ring-buffer buffer-size))))
|
||||
(setf (gethash path (server-mounts server)) mount)
|
||||
mount))
|
||||
|
||||
(defun remove-mount (server path)
|
||||
"Remove a mount point from the server."
|
||||
(remhash path (server-mounts server)))
|
||||
|
||||
(defun update-metadata (server path &key title url)
|
||||
"Update the metadata for a mount point."
|
||||
(let ((mount (gethash path (server-mounts server))))
|
||||
(when mount
|
||||
(bt:with-lock-held ((mount-metadata-lock mount))
|
||||
(let ((meta (mount-metadata mount)))
|
||||
(when title (setf (icy-metadata-title meta) title))
|
||||
(when url (setf (icy-metadata-url meta) url)))))))
|
||||
|
||||
(defun listener-count (server &optional path)
|
||||
"Return the number of connected listeners.
|
||||
If PATH is specified, count only listeners on that mount."
|
||||
(bt:with-lock-held ((server-clients-lock server))
|
||||
(if path
|
||||
(count-if (lambda (c) (and (client-active-p c)
|
||||
(string= path (mount-path (client-mount c)))))
|
||||
(server-clients server))
|
||||
(count-if #'client-active-p (server-clients server)))))
|
||||
|
||||
(defun start-server (server)
|
||||
"Start the streaming server."
|
||||
(when (server-running-p server)
|
||||
(error 'streamer-error :message "Server already running"))
|
||||
(setf (server-socket server)
|
||||
(usocket:socket-listen "0.0.0.0" (server-port server)
|
||||
:reuse-address t
|
||||
:element-type '(unsigned-byte 8)))
|
||||
(setf (server-running-p server) t)
|
||||
(setf (server-accept-thread server)
|
||||
(bt:make-thread (lambda () (accept-loop server))
|
||||
:name "cl-streamer-accept"))
|
||||
(log:info "CL-Streamer started on port ~A" (server-port server))
|
||||
server)
|
||||
|
||||
(defun stop-server (server)
|
||||
"Stop the streaming server."
|
||||
(setf (server-running-p server) nil)
|
||||
(bt:with-lock-held ((server-clients-lock server))
|
||||
(dolist (client (server-clients server))
|
||||
(setf (client-active-p client) nil)
|
||||
(ignore-errors (usocket:socket-close (client-socket client)))))
|
||||
(ignore-errors (usocket:socket-close (server-socket server)))
|
||||
(log:info "CL-Streamer stopped")
|
||||
server)
|
||||
|
||||
(defun accept-loop (server)
|
||||
"Main accept loop for incoming connections."
|
||||
(loop while (server-running-p server)
|
||||
do (handler-case
|
||||
(let ((client-socket (usocket:socket-accept (server-socket server))))
|
||||
(bt:make-thread (lambda () (handle-client server client-socket))
|
||||
:name "cl-streamer-client"))
|
||||
(usocket:socket-error (e)
|
||||
(unless (server-running-p server)
|
||||
(return))
|
||||
(log:warn "Accept error: ~A" e)))))
|
||||
|
||||
(defun handle-client (server client-socket)
|
||||
"Handle a single client connection."
|
||||
(let ((stream (flexi-streams:make-flexi-stream
|
||||
(usocket:socket-stream client-socket)
|
||||
:external-format :latin-1)))
|
||||
(handler-case
|
||||
(let* ((request-line (read-line stream))
|
||||
(headers (read-http-headers stream))
|
||||
(method (first (split-sequence:split-sequence #\Space request-line))))
|
||||
;; Handle CORS preflight
|
||||
(when (string-equal method "OPTIONS")
|
||||
(send-cors-preflight stream)
|
||||
(ignore-errors (usocket:socket-close client-socket))
|
||||
(return-from handle-client))
|
||||
(multiple-value-bind (path wants-meta)
|
||||
(parse-icy-request request-line headers)
|
||||
(let ((mount (gethash path (server-mounts server))))
|
||||
(if mount
|
||||
(serve-stream server client-socket stream mount wants-meta)
|
||||
(progn
|
||||
(log:debug "404 for path: ~A" path)
|
||||
(send-404 stream path))))))
|
||||
(error (e)
|
||||
(log:debug "Client error: ~A" e)
|
||||
(ignore-errors (usocket:socket-close client-socket))))))
|
||||
|
||||
(defun read-http-headers (stream)
|
||||
"Read HTTP headers from STREAM. Returns alist of (name . value)."
|
||||
(loop for line = (read-line stream nil nil)
|
||||
while (and line (> (length line) 1))
|
||||
for colon-pos = (position #\: line)
|
||||
when colon-pos
|
||||
collect (cons (string-trim '(#\Space #\Return) (subseq line 0 colon-pos))
|
||||
(string-trim '(#\Space #\Return) (subseq line (1+ colon-pos))))))
|
||||
|
||||
(defun serve-stream (server client-socket stream mount wants-meta)
|
||||
"Serve audio stream to a client."
|
||||
(let ((client (make-instance 'client-connection
|
||||
:socket client-socket
|
||||
:stream stream
|
||||
:mount mount
|
||||
:wants-metadata wants-meta)))
|
||||
(bt:with-lock-held ((server-clients-lock server))
|
||||
(push client (server-clients server)))
|
||||
(log:info "Client connected to ~A (metadata: ~A)"
|
||||
(mount-path mount) wants-meta)
|
||||
(write-icy-response-headers stream
|
||||
:content-type (mount-content-type mount)
|
||||
:metaint (when wants-meta *default-metaint*)
|
||||
:name (mount-name mount)
|
||||
:genre (mount-genre mount)
|
||||
:bitrate (mount-bitrate mount))
|
||||
(unwind-protect
|
||||
(stream-to-client client)
|
||||
(setf (client-active-p client) nil)
|
||||
(ignore-errors (usocket:socket-close client-socket))
|
||||
(bt:with-lock-held ((server-clients-lock server))
|
||||
(setf (server-clients server)
|
||||
(remove client (server-clients server))))
|
||||
(log:info "Client disconnected from ~A" (mount-path mount)))))
|
||||
|
||||
(defun stream-to-client (client)
|
||||
"Stream audio data to a client from the broadcast buffer.
|
||||
Starts with a burst of recent data for fast playback start."
|
||||
(let* ((mount (client-mount client))
|
||||
(buffer (mount-buffer mount))
|
||||
(stream (client-stream client))
|
||||
(chunk-size 4096)
|
||||
(chunk (make-array chunk-size :element-type '(unsigned-byte 8))))
|
||||
;; For MP3, burst recent data for fast playback start.
|
||||
;; For AAC, start from current position — AAC requires ADTS frame alignment
|
||||
;; and burst data from mid-stream causes browser decode errors.
|
||||
(setf (client-read-pos client)
|
||||
(if (string= (mount-content-type mount) "audio/aac")
|
||||
(buffer-current-pos buffer)
|
||||
(buffer-burst-start buffer)))
|
||||
(loop while (client-active-p client)
|
||||
do (multiple-value-bind (bytes-read new-pos)
|
||||
(buffer-read-from buffer (client-read-pos client) chunk)
|
||||
(if (zerop bytes-read)
|
||||
;; No data yet — wait for producer
|
||||
(buffer-wait-for-data buffer (client-read-pos client))
|
||||
(progn
|
||||
(setf (client-read-pos client) new-pos)
|
||||
(handler-case
|
||||
(progn
|
||||
(if (client-wants-metadata-p client)
|
||||
(write-with-metadata client chunk bytes-read)
|
||||
(write-sequence chunk stream :end bytes-read))
|
||||
(force-output stream))
|
||||
(error (e)
|
||||
(log:warn "Client stream error on ~A: ~A"
|
||||
(mount-path mount) e)
|
||||
(setf (client-active-p client) nil)
|
||||
(return)))))))))
|
||||
|
||||
(defun write-with-metadata (client data length)
|
||||
"Write audio data with ICY metadata injection."
|
||||
(let* ((stream (client-stream client))
|
||||
(mount (client-mount client))
|
||||
(metaint *default-metaint*)
|
||||
(pos 0))
|
||||
(loop while (< pos length)
|
||||
do (let ((bytes-until-meta (- metaint (client-bytes-since-meta client)))
|
||||
(bytes-remaining (- length pos)))
|
||||
(if (<= bytes-until-meta bytes-remaining)
|
||||
(progn
|
||||
(write-sequence data stream :start pos :end (+ pos bytes-until-meta))
|
||||
(incf pos bytes-until-meta)
|
||||
(setf (client-bytes-since-meta client) 0)
|
||||
(let ((meta-bytes (bt:with-lock-held ((mount-metadata-lock mount))
|
||||
(encode-icy-metadata (mount-metadata mount)))))
|
||||
(write-sequence meta-bytes stream)))
|
||||
(progn
|
||||
(write-sequence data stream :start pos :end length)
|
||||
(incf (client-bytes-since-meta client) bytes-remaining)
|
||||
(setf pos length)))))))
|
||||
|
||||
(defun send-cors-preflight (stream)
|
||||
"Send a CORS preflight response for OPTIONS requests."
|
||||
(format stream "HTTP/1.1 204 No Content~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Allow-Origin: *~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Allow-Methods: GET, OPTIONS~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Allow-Headers: Origin, Accept, Content-Type, Icy-MetaData, Range~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Max-Age: 86400~C~C" #\Return #\Linefeed)
|
||||
(format stream "~C~C" #\Return #\Linefeed)
|
||||
(force-output stream))
|
||||
|
||||
(defun send-404 (stream path)
|
||||
"Send a 404 response for unknown mount points."
|
||||
(format stream "HTTP/1.1 404 Not Found~C~C" #\Return #\Linefeed)
|
||||
(format stream "Content-Type: text/plain~C~C" #\Return #\Linefeed)
|
||||
(format stream "~C~C" #\Return #\Linefeed)
|
||||
(format stream "Mount point not found: ~A~%" path)
|
||||
(force-output stream))
|
||||
|
|
@ -1,92 +0,0 @@
|
|||
;;; End-to-end streaming test with playlist (MP3 + AAC)
|
||||
;;; Usage: sbcl --load test-stream.lisp
|
||||
;;;
|
||||
;;; Then open in VLC or browser:
|
||||
;;; http://localhost:8000/stream.mp3 (MP3 128kbps)
|
||||
;;; http://localhost:8000/stream.aac (AAC 128kbps)
|
||||
;;; ICY metadata will show track names as they change.
|
||||
|
||||
(push #p"/home/glenn/SourceCode/harmony/" asdf:*central-registry*)
|
||||
(push #p"/home/glenn/SourceCode/asteroid/cl-streamer/" asdf:*central-registry*)
|
||||
|
||||
(ql:quickload '(:cl-streamer :cl-streamer/encoder :cl-streamer/aac-encoder :cl-streamer/harmony))
|
||||
|
||||
(format t "~%=== CL-Streamer Playlist Test (MP3 + AAC) ===~%")
|
||||
(format t "LAME version: ~A~%" (cl-streamer::lame-version))
|
||||
|
||||
;; 1. Create and start stream server
|
||||
(format t "~%[1] Starting stream server on port 8000...~%")
|
||||
(cl-streamer:start :port 8000)
|
||||
|
||||
;; 2. Add mount points
|
||||
(format t "[2] Adding mount points...~%")
|
||||
(cl-streamer:add-mount cl-streamer:*server* "/stream.mp3"
|
||||
:content-type "audio/mpeg"
|
||||
:bitrate 128
|
||||
:name "Asteroid Radio MP3")
|
||||
(cl-streamer:add-mount cl-streamer:*server* "/stream.aac"
|
||||
:content-type "audio/aac"
|
||||
:bitrate 128
|
||||
:name "Asteroid Radio AAC")
|
||||
|
||||
;; 3. Create encoders
|
||||
(format t "[3] Creating encoders...~%")
|
||||
(defvar *mp3-encoder* (cl-streamer:make-mp3-encoder :sample-rate 44100
|
||||
:channels 2
|
||||
:bitrate 128))
|
||||
(defvar *aac-encoder* (cl-streamer:make-aac-encoder :sample-rate 44100
|
||||
:channels 2
|
||||
:bitrate 128000))
|
||||
|
||||
;; 4. Create and start audio pipeline with both outputs
|
||||
(format t "[4] Starting audio pipeline with Harmony (MP3 + AAC)...~%")
|
||||
(defvar *pipeline* (cl-streamer/harmony:make-audio-pipeline
|
||||
:encoder *mp3-encoder*
|
||||
:stream-server cl-streamer:*server*
|
||||
:mount-path "/stream.mp3"
|
||||
:sample-rate 44100
|
||||
:channels 2))
|
||||
|
||||
;; Add AAC as second output
|
||||
(cl-streamer/harmony:add-pipeline-output *pipeline* *aac-encoder* "/stream.aac")
|
||||
|
||||
(cl-streamer/harmony:start-pipeline *pipeline*)
|
||||
|
||||
;; 5. Build a playlist from the music library
|
||||
(format t "[5] Building playlist from music library...~%")
|
||||
(defvar *music-dir* #p"/home/glenn/SourceCode/asteroid/music/library/")
|
||||
|
||||
(defvar *playlist*
|
||||
(let ((files nil))
|
||||
(dolist (dir (directory (merge-pathnames "*/" *music-dir*)))
|
||||
(dolist (flac (directory (merge-pathnames "**/*.flac" dir)))
|
||||
(push (list :file (namestring flac)) files)))
|
||||
;; Shuffle and take first 10 tracks
|
||||
(subseq (alexandria:shuffle (copy-list files))
|
||||
0 (min 10 (length files)))))
|
||||
|
||||
(format t "Queued ~A tracks:~%" (length *playlist*))
|
||||
(dolist (entry *playlist*)
|
||||
(format t " ~A~%" (getf entry :file)))
|
||||
|
||||
;; 6. Start playlist playback
|
||||
(format t "~%[6] Starting playlist...~%")
|
||||
(cl-streamer/harmony:play-list *pipeline* *playlist*
|
||||
:crossfade-duration 3.0
|
||||
:fade-in 2.0
|
||||
:fade-out 2.0)
|
||||
|
||||
(format t "~%=== Stream is live! ===~%")
|
||||
(format t "MP3: http://localhost:8000/stream.mp3~%")
|
||||
(format t "AAC: http://localhost:8000/stream.aac~%")
|
||||
(format t "~%Press Enter to stop...~%")
|
||||
|
||||
(read-line)
|
||||
|
||||
;; Cleanup
|
||||
(format t "Stopping...~%")
|
||||
(cl-streamer/harmony:stop-pipeline *pipeline*)
|
||||
(cl-streamer:close-encoder *mp3-encoder*)
|
||||
(cl-streamer:close-aac-encoder *aac-encoder*)
|
||||
(cl-streamer:stop)
|
||||
(format t "Done.~%")
|
||||
|
|
@ -92,14 +92,14 @@
|
|||
(when *harmony-pipeline*
|
||||
(let ((state (list :playlist-path (when *current-playlist-path*
|
||||
(namestring *current-playlist-path*))
|
||||
:current-track (cl-streamer/harmony:pipeline-current-track
|
||||
:current-track (cl-streamer:pipeline-current-track
|
||||
*harmony-pipeline*))))
|
||||
;; 1. Clear the queue so play-list has nothing to advance to
|
||||
(cl-streamer/harmony:pipeline-clear-queue *harmony-pipeline*)
|
||||
(cl-streamer:pipeline-clear-queue *harmony-pipeline*)
|
||||
;; 2. Set skip flag so the play-list loop exits its wait
|
||||
(cl-streamer/harmony:pipeline-skip *harmony-pipeline*)
|
||||
(cl-streamer:pipeline-skip *harmony-pipeline*)
|
||||
;; 3. Immediately silence and stop all voices on the mixer
|
||||
(cl-streamer/harmony:pipeline-stop-all-voices *harmony-pipeline*)
|
||||
(cl-streamer:pipeline-stop-all-voices *harmony-pipeline*)
|
||||
(log:info "Auto-playlist paused for DJ session")
|
||||
state)))
|
||||
|
||||
|
|
@ -183,15 +183,13 @@
|
|||
(unless *dj-session*
|
||||
(error "No active DJ session"))
|
||||
(let* ((deck (get-deck *dj-session* deck-id))
|
||||
(pipeline *harmony-pipeline*)
|
||||
(server (cl-streamer/harmony:pipeline-harmony-server pipeline))
|
||||
(org.shirakumo.fraf.harmony:*server* server))
|
||||
(pipeline *harmony-pipeline*))
|
||||
;; Stop current track if playing
|
||||
(when (member (deck-state deck) '(:playing :paused))
|
||||
(stop-deck-internal deck))
|
||||
;; Read metadata
|
||||
(let* ((tags (cl-streamer/harmony:read-audio-metadata file-path))
|
||||
(display-title (cl-streamer/harmony:format-display-title file-path))
|
||||
(let* ((tags (cl-streamer:pipeline-read-metadata pipeline file-path))
|
||||
(display-title (cl-streamer:pipeline-format-title pipeline file-path))
|
||||
(track-info (list :file file-path
|
||||
:display-title display-title
|
||||
:artist (getf tags :artist)
|
||||
|
|
@ -209,16 +207,14 @@
|
|||
(error "No active DJ session"))
|
||||
(let* ((session *dj-session*)
|
||||
(deck (get-deck session deck-id))
|
||||
(pipeline *harmony-pipeline*)
|
||||
(server (cl-streamer/harmony:pipeline-harmony-server pipeline))
|
||||
(org.shirakumo.fraf.harmony:*server* server))
|
||||
(pipeline *harmony-pipeline*))
|
||||
(ecase (deck-state deck)
|
||||
(:empty
|
||||
(error "Deck ~A has no track loaded" deck-id))
|
||||
(:loaded
|
||||
;; Create a new voice and start playing
|
||||
(let ((voice (org.shirakumo.fraf.harmony:play
|
||||
(sb-ext:parse-native-namestring (deck-file-path deck))
|
||||
(let ((voice (cl-streamer:pipeline-play-voice pipeline
|
||||
(deck-file-path deck)
|
||||
:mixer :music
|
||||
:on-end :disconnect)))
|
||||
(setf (deck-voice deck) voice
|
||||
|
|
@ -264,11 +260,9 @@
|
|||
(defun stop-deck-internal (deck)
|
||||
"Internal: stop a deck's voice and reset state."
|
||||
(when (deck-voice deck)
|
||||
(let* ((pipeline *harmony-pipeline*)
|
||||
(server (cl-streamer/harmony:pipeline-harmony-server pipeline))
|
||||
(org.shirakumo.fraf.harmony:*server* server))
|
||||
(let ((pipeline *harmony-pipeline*))
|
||||
(handler-case
|
||||
(org.shirakumo.fraf.harmony:stop (deck-voice deck))
|
||||
(cl-streamer:pipeline-stop-voice pipeline (deck-voice deck))
|
||||
(error (e)
|
||||
(log:debug "Error stopping deck voice: ~A" e)))))
|
||||
(setf (deck-voice deck) nil
|
||||
|
|
@ -282,7 +276,7 @@
|
|||
(member (deck-state deck) '(:playing :paused)))
|
||||
(handler-case
|
||||
(progn
|
||||
(cl-streamer/harmony:volume-ramp (deck-voice deck) 0.0 duration)
|
||||
(cl-streamer:pipeline-volume-ramp *harmony-pipeline* (deck-voice deck) 0.0 duration)
|
||||
(stop-deck-internal deck))
|
||||
(error (e)
|
||||
(log:debug "Error fading deck: ~A" e)
|
||||
|
|
@ -343,10 +337,8 @@
|
|||
"Internal: disconnect external input voice."
|
||||
(when (session-external-input session)
|
||||
(handler-case
|
||||
(let* ((pipeline *harmony-pipeline*)
|
||||
(server (cl-streamer/harmony:pipeline-harmony-server pipeline))
|
||||
(org.shirakumo.fraf.harmony:*server* server))
|
||||
(org.shirakumo.fraf.harmony:stop (session-external-input session)))
|
||||
(let ((pipeline *harmony-pipeline*))
|
||||
(cl-streamer:pipeline-stop-voice pipeline (session-external-input session)))
|
||||
(error (e)
|
||||
(log:debug "Error stopping external input: ~A" e)))
|
||||
(setf (session-external-input session) nil)
|
||||
|
|
@ -379,7 +371,7 @@
|
|||
(let ((title (or (session-metadata-override *dj-session*)
|
||||
(auto-detect-dj-metadata *dj-session*))))
|
||||
(when title
|
||||
(cl-streamer/harmony:update-all-mounts-metadata *harmony-pipeline* title)))))
|
||||
(cl-streamer:pipeline-update-metadata *harmony-pipeline* title)))))
|
||||
|
||||
(defun auto-detect-dj-metadata (session)
|
||||
"Determine ICY metadata from the louder deck.
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@
|
|||
;; Normal auto-playlist mode
|
||||
(harmony-now-playing mount)))
|
||||
|
||||
(define-api-with-limit asteroid/partial/now-playing (&optional mount) (:limit 10 :timeout 1)
|
||||
(define-api-with-limit asteroid/partial/now-playing (&optional mount) (:limit 30 :timeout 60)
|
||||
"Get Partial HTML with live now-playing status.
|
||||
Optional MOUNT parameter specifies which stream to get metadata from.
|
||||
Returns partial HTML with current track info."
|
||||
|
|
@ -87,7 +87,7 @@
|
|||
:connection-error t
|
||||
:stats nil))))))
|
||||
|
||||
(define-api-with-limit asteroid/partial/now-playing-inline (&optional mount) (:limit 10 :timeout 1)
|
||||
(define-api-with-limit asteroid/partial/now-playing-inline (&optional mount) (:limit 30 :timeout 60)
|
||||
"Get inline text with now playing info (for admin dashboard and widgets).
|
||||
Optional MOUNT parameter specifies which stream to get metadata from."
|
||||
(with-error-handling
|
||||
|
|
@ -101,7 +101,7 @@
|
|||
(setf (header "Content-Type") "text/plain")
|
||||
"Stream Offline")))))
|
||||
|
||||
(define-api-with-limit asteroid/partial/now-playing-json (&optional mount) (:limit 10 :timeout 1)
|
||||
(define-api-with-limit asteroid/partial/now-playing-json (&optional mount) (:limit 30 :timeout 60)
|
||||
"Get JSON with now playing info including track ID for favorites.
|
||||
Optional MOUNT parameter specifies which stream to get metadata from."
|
||||
;; Register web listener for geo stats (keeps listener active during playback)
|
||||
|
|
|
|||
|
|
@ -385,7 +385,8 @@
|
|||
(defun poll-and-store-stats ()
|
||||
"Single poll iteration: fetch listener counts from cl-streamer and store."
|
||||
(dolist (mount '("/asteroid.mp3" "/asteroid.aac"))
|
||||
(let ((listeners (cl-streamer:get-listener-count mount)))
|
||||
(let ((listeners (when *harmony-pipeline*
|
||||
(cl-streamer:pipeline-listener-count *harmony-pipeline* mount))))
|
||||
(when (and listeners (> listeners 0))
|
||||
(store-listener-snapshot mount listeners)
|
||||
(log:debug "Stored snapshot: ~a = ~a listeners" mount listeners))))
|
||||
|
|
|
|||
|
|
@ -960,7 +960,7 @@
|
|||
|
||||
;; Start now playing updates
|
||||
(set-timeout update-mini-now-playing 1000)
|
||||
(set-interval update-mini-now-playing 5000))))
|
||||
(set-interval update-mini-now-playing 15000))))
|
||||
|
||||
;; Initialize popout player
|
||||
(defun init-popout-player ()
|
||||
|
|
@ -996,7 +996,7 @@
|
|||
|
||||
;; Start now playing updates
|
||||
(update-popout-now-playing)
|
||||
(set-interval update-popout-now-playing 5000)
|
||||
(set-interval update-popout-now-playing 15000)
|
||||
|
||||
;; Notify parent window
|
||||
(notify-popout-opened)
|
||||
|
|
|
|||
|
|
@ -12,11 +12,19 @@
|
|||
(defvar *harmony-stream-port* 8000
|
||||
"Port for the cl-streamer HTTP stream server.")
|
||||
|
||||
(defvar *harmony-mp3-encoder* nil
|
||||
"MP3 encoder instance.")
|
||||
;; Encoder instances are now owned by the pipeline (Phase 2).
|
||||
;; Kept as aliases for backward compatibility with any external references.
|
||||
(defun harmony-mp3-encoder ()
|
||||
"Get the MP3 encoder from the pipeline (if running)."
|
||||
(when *harmony-pipeline*
|
||||
(car (find "/asteroid.mp3" (cl-streamer/harmony:pipeline-encoders *harmony-pipeline*)
|
||||
:key #'cdr :test #'string=))))
|
||||
|
||||
(defvar *harmony-aac-encoder* nil
|
||||
"AAC encoder instance.")
|
||||
(defun harmony-aac-encoder ()
|
||||
"Get the AAC encoder from the pipeline (if running)."
|
||||
(when *harmony-pipeline*
|
||||
(car (find "/asteroid.aac" (cl-streamer/harmony:pipeline-encoders *harmony-pipeline*)
|
||||
:key #'cdr :test #'string=))))
|
||||
|
||||
(defvar *harmony-state-file*
|
||||
(merge-pathnames ".playback-state.lisp" (asdf:system-source-directory :asteroid))
|
||||
|
|
@ -185,7 +193,7 @@
|
|||
(cl-streamer/harmony:pipeline-current-track *harmony-pipeline*))
|
||||
(let* ((track-info (cl-streamer/harmony:pipeline-current-track *harmony-pipeline*))
|
||||
(display-title (or (getf track-info :display-title) "Unknown"))
|
||||
(listeners (cl-streamer:get-listener-count))
|
||||
(listeners (cl-streamer:pipeline-listener-count *harmony-pipeline*))
|
||||
(track-id (or (find-track-by-title display-title)
|
||||
(find-track-by-file-path (getf track-info :file)))))
|
||||
`((:listenurl . ,(format nil "~A/~A" *stream-base-url* mount))
|
||||
|
|
@ -197,75 +205,46 @@
|
|||
;;; ---- Pipeline Lifecycle ----
|
||||
|
||||
(defun start-harmony-streaming (&key (port *harmony-stream-port*)
|
||||
(mp3-bitrate 128000)
|
||||
(aac-bitrate 128000))
|
||||
(mp3-bitrate 128)
|
||||
(aac-bitrate 128))
|
||||
"Start the cl-streamer pipeline with MP3 and AAC outputs.
|
||||
Should be called once during application startup."
|
||||
Should be called once during application startup.
|
||||
MP3-BITRATE and AAC-BITRATE are in kbps (e.g. 128)."
|
||||
(when *harmony-pipeline*
|
||||
(log:warn "Harmony streaming already running")
|
||||
(return-from start-harmony-streaming *harmony-pipeline*))
|
||||
|
||||
;; Start the stream server
|
||||
(cl-streamer:start :port port)
|
||||
|
||||
;; Add mount points
|
||||
(cl-streamer:add-mount cl-streamer:*server* "/asteroid.mp3"
|
||||
:content-type "audio/mpeg"
|
||||
:bitrate 128
|
||||
:name "Asteroid Radio MP3")
|
||||
(cl-streamer:add-mount cl-streamer:*server* "/asteroid.aac"
|
||||
:content-type "audio/aac"
|
||||
:bitrate 128
|
||||
:name "Asteroid Radio AAC")
|
||||
|
||||
;; Create encoders
|
||||
(setf *harmony-mp3-encoder*
|
||||
(cl-streamer:make-mp3-encoder :bitrate (floor mp3-bitrate 1000)
|
||||
:sample-rate 44100
|
||||
:channels 2))
|
||||
(setf *harmony-aac-encoder*
|
||||
(cl-streamer:make-aac-encoder :bitrate aac-bitrate
|
||||
:sample-rate 44100
|
||||
:channels 2))
|
||||
|
||||
;; Create pipeline with track-change callback
|
||||
;; Create pipeline from declarative spec — server, mounts, encoders all handled
|
||||
(setf *harmony-pipeline*
|
||||
(cl-streamer/harmony:make-audio-pipeline
|
||||
:encoder *harmony-mp3-encoder*
|
||||
:stream-server cl-streamer:*server*
|
||||
:mount-path "/asteroid.mp3"))
|
||||
(cl-streamer/harmony:make-pipeline
|
||||
:port port
|
||||
:outputs (list (list :format :mp3
|
||||
:mount "/asteroid.mp3"
|
||||
:bitrate mp3-bitrate
|
||||
:name "Asteroid Radio MP3")
|
||||
(list :format :aac
|
||||
:mount "/asteroid.aac"
|
||||
:bitrate aac-bitrate
|
||||
:name "Asteroid Radio AAC"))))
|
||||
|
||||
;; Add AAC output
|
||||
(cl-streamer/harmony:add-pipeline-output *harmony-pipeline*
|
||||
*harmony-aac-encoder*
|
||||
"/asteroid.aac")
|
||||
|
||||
;; Set the track-change callback
|
||||
(setf (cl-streamer/harmony:pipeline-on-track-change *harmony-pipeline*)
|
||||
#'on-harmony-track-change)
|
||||
|
||||
;; Set the playlist-change callback (fires when scheduler playlist actually starts)
|
||||
(setf (cl-streamer/harmony:pipeline-on-playlist-change *harmony-pipeline*)
|
||||
#'on-harmony-playlist-change)
|
||||
;; Register hooks
|
||||
(cl-streamer/harmony:pipeline-add-hook *harmony-pipeline*
|
||||
:track-change #'on-harmony-track-change)
|
||||
(cl-streamer/harmony:pipeline-add-hook *harmony-pipeline*
|
||||
:playlist-change #'on-harmony-playlist-change)
|
||||
|
||||
;; Start the audio pipeline
|
||||
(cl-streamer/harmony:start-pipeline *harmony-pipeline*)
|
||||
(cl-streamer/harmony:pipeline-start *harmony-pipeline*)
|
||||
|
||||
(log:info "Harmony streaming started on port ~A (MP3 + AAC)" port)
|
||||
*harmony-pipeline*)
|
||||
|
||||
(defun stop-harmony-streaming ()
|
||||
"Stop the cl-streamer pipeline and stream server."
|
||||
"Stop the cl-streamer pipeline and stream server.
|
||||
Pipeline owns encoders and server — cleanup is automatic."
|
||||
(when *harmony-pipeline*
|
||||
(cl-streamer/harmony:stop-pipeline *harmony-pipeline*)
|
||||
(cl-streamer/harmony:pipeline-stop *harmony-pipeline*)
|
||||
(setf *harmony-pipeline* nil))
|
||||
(when *harmony-mp3-encoder*
|
||||
(cl-streamer:close-encoder *harmony-mp3-encoder*)
|
||||
(setf *harmony-mp3-encoder* nil))
|
||||
(when *harmony-aac-encoder*
|
||||
(cl-streamer:close-aac-encoder *harmony-aac-encoder*)
|
||||
(setf *harmony-aac-encoder* nil))
|
||||
(cl-streamer:stop)
|
||||
(log:info "Harmony streaming stopped"))
|
||||
|
||||
;;; ---- Playlist Control ----
|
||||
|
|
@ -305,7 +284,7 @@
|
|||
"Get current pipeline status."
|
||||
(if *harmony-pipeline*
|
||||
(let ((track (cl-streamer/harmony:pipeline-current-track *harmony-pipeline*))
|
||||
(listeners (cl-streamer:get-listener-count)))
|
||||
(listeners (cl-streamer:pipeline-listener-count *harmony-pipeline*)))
|
||||
(list :running t
|
||||
:current-track (getf track :display-title)
|
||||
:artist (getf track :artist)
|
||||
|
|
|
|||
Loading…
Reference in New Issue