Compare commits
40 Commits
9eb09537e6
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
| 17846e068c | |||
| b979be540e | |||
| 5eefacacba | |||
| 8e8b9a00c0 | |||
| d6aa880104 | |||
| 444d62edac | |||
| 696ef1b978 | |||
| 4b6adc404e | |||
| cf87fa7ed8 | |||
| d7be947886 | |||
| bfed212346 | |||
| 9f5c4d3efc | |||
| 2daaafb229 | |||
| ef68672203 | |||
| 360b9eea47 | |||
| 73e778e4a5 | |||
| 5cff13f55a | |||
| 9cb7b43cc3 | |||
| 690cbb60b4 | |||
| 65ca59bef8 | |||
| f706d4e8e6 | |||
| 475f7230b5 | |||
| ba087f07f1 | |||
| 17838e4f33 | |||
| c9a91bf2be | |||
| 3c18e75cf6 | |||
| d298b411a5 | |||
| 734aeef222 | |||
| 20d0194f48 | |||
| a059444ecf | |||
| 30698de4e9 | |||
| a2f7341f1f | |||
| b7f58f43a9 | |||
| 89592ddea9 | |||
| 61d87ba543 | |||
| 4966936381 | |||
| 7956d15072 | |||
| f8c091946f | |||
| 29cf56a6d2 | |||
| 84f4719513 |
@@ -0,0 +1,7 @@
|
||||
|
||||
|
||||
all:
|
||||
@echo "make clean to cleanup bak/~ files"
|
||||
|
||||
clean:
|
||||
rm -f *~ *.bak scrbl/*~ scrbl/*.bak private/*~ private/*.bak
|
||||
@@ -1,14 +1,80 @@
|
||||
# racket-audio
|
||||
|
||||
Integration of common audio libraries in racket.
|
||||
Integration of common audio libraries in Racket.
|
||||
|
||||
## Mac OS X
|
||||
The package contains decoder, player and encoder bindings. Playback uses the
|
||||
existing audio player modules. Encoding is provided by `audio-encoder.rkt` with
|
||||
Opus and FLAC backends.
|
||||
|
||||
Make sure you have libao, libFLAC, mpg123 and ffmpeg-full installed using brew.
|
||||
## Native dependencies
|
||||
|
||||
% brew install libao
|
||||
% brew install flac
|
||||
% brew install mpg123
|
||||
% brew install ffmpeg-full
|
||||
For playback and decoding, install the native libraries used by the selected
|
||||
backends:
|
||||
|
||||
- libao
|
||||
- libFLAC
|
||||
- mpg123
|
||||
- FFmpeg libraries, including libavutil, libavcodec, libavformat and
|
||||
libswresample
|
||||
|
||||
For encoding, also install:
|
||||
|
||||
- libopusenc
|
||||
- libopus
|
||||
- libogg
|
||||
- TagLib with the C binding, usually provided as `taglib` / `taglib_c`
|
||||
|
||||
The Opus encoder backend uses libopusenc directly. The FLAC encoder backend
|
||||
uses libFLAC directly. FLAC sample-rate conversion uses the existing FFmpeg
|
||||
swresample layer. Metadata and cover-art copying use the TagLib wrapper; the
|
||||
public `taglib.rkt` API also supports read-write tag editing.
|
||||
|
||||
## macOS
|
||||
|
||||
Using Homebrew, install the native libraries before using the package:
|
||||
|
||||
```sh
|
||||
brew install libao
|
||||
brew install flac
|
||||
brew install mpg123
|
||||
brew install ffmpeg
|
||||
brew install opus
|
||||
brew install libopusenc
|
||||
brew install taglib
|
||||
```
|
||||
|
||||
Some Homebrew installations provide FFmpeg as `ffmpeg`; older local setups may
|
||||
use `ffmpeg-full`.
|
||||
|
||||
## Encoder examples
|
||||
|
||||
Encode to Opus:
|
||||
|
||||
```racket
|
||||
(require "audio-encoder.rkt")
|
||||
|
||||
(audio-encode "input.flac"
|
||||
"output.opus"
|
||||
(hash 'bitrate 224000
|
||||
'vbr? #t
|
||||
'complexity 10)
|
||||
#:encoder 'opus)
|
||||
```
|
||||
|
||||
Encode 96 kHz FLAC to 48 kHz FLAC:
|
||||
|
||||
```racket
|
||||
(audio-encode "input-96k.flac"
|
||||
"output-48k.flac"
|
||||
(hash 'sample-rate 48000
|
||||
'bits-per-sample 24
|
||||
'compression-level 8)
|
||||
#:encoder 'flac)
|
||||
```
|
||||
|
||||
A small test wrapper is available in `encoder-test.rkt`:
|
||||
|
||||
```sh
|
||||
racket encoder-test.rkt --encoder opus --input input.flac --output output.opus --bitrate-kbps 224
|
||||
racket encoder-test.rkt --encoder flac --input input-96k.flac --output output-48k.flac --sample-rate 48000
|
||||
```
|
||||
|
||||
+34
-16
@@ -2,6 +2,7 @@
|
||||
|
||||
(require "flac-decoder.rkt"
|
||||
"mp3-decoder.rkt"
|
||||
"opusfile-decoder.rkt"
|
||||
"ffmpeg-decoder.rkt"
|
||||
"audio-sniffer.rkt"
|
||||
"private/utils.rkt"
|
||||
@@ -22,6 +23,8 @@
|
||||
make-audio-reader
|
||||
audio-handle?
|
||||
audio-supported-extensions
|
||||
current-opusfile-output-format
|
||||
opusfile-output-format?
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -56,7 +59,18 @@
|
||||
mp3-stop
|
||||
'ao))
|
||||
|
||||
;; FFmpeg decodere
|
||||
;; Opus, via Xiph libopusfile
|
||||
(hash-set! audio-readers
|
||||
'opusfile
|
||||
(make-audio-reader '("opus")
|
||||
opusfile-valid?
|
||||
opusfile-open
|
||||
opusfile-read
|
||||
opusfile-seek
|
||||
opusfile-stop
|
||||
'ao))
|
||||
|
||||
;; FFmpeg decoder
|
||||
(hash-set! audio-readers
|
||||
'ffmpeg
|
||||
(make-audio-reader '("ogg" "oga" "opus"
|
||||
@@ -112,6 +126,7 @@
|
||||
(driver #:mutable)
|
||||
(driver-handle #:mutable)
|
||||
)
|
||||
#:transparent
|
||||
)
|
||||
|
||||
(define (audio-known-exts?)
|
||||
@@ -216,6 +231,7 @@
|
||||
|
||||
(define/contract (audio-stop handle)
|
||||
(-> audio-handle? void?)
|
||||
(dbg-sound "audio-stop called")
|
||||
(let ((stopper (audio-reader-stopper (audio-handle-driver handle))))
|
||||
(void (stopper (audio-handle-driver-handle handle)))))
|
||||
|
||||
@@ -227,21 +243,23 @@
|
||||
(not (null? (filter (λ (e) (string-ci=? ext e)) (audio-reader-exts reader)))))
|
||||
|
||||
(define reader-for-kind
|
||||
(make-hash '((mp3 . ffmpeg) ; ffmpeg does a better job on gapless playback...
|
||||
(flac . flac)
|
||||
(ogg . ffmpeg)
|
||||
(vorbis . ffmpeg)
|
||||
(opus . ffmpeg)
|
||||
(wav . ffmpeg)
|
||||
(aiff . ffmpeg)
|
||||
(mp4 . ffmpeg)
|
||||
(aac . ffmpeg)
|
||||
(alac . ffmpeg)
|
||||
(ac3 . ffmpeg)
|
||||
(ape . ffmpeg)
|
||||
(wavpack . ffmpeg)
|
||||
(wma . ffmpeg)
|
||||
(matroska . ffmpeg))))
|
||||
(make-hash
|
||||
(list (cons 'mp3 'ffmpeg) ; ffmpeg does a better job on gapless playback...
|
||||
(cons 'flac 'flac)
|
||||
(cons 'ogg 'ffmpeg)
|
||||
(cons 'vorbis 'ffmpeg)
|
||||
(cons 'opus (if (opusfile-available?) 'opusfile 'ffmpeg))
|
||||
(cons 'wav 'ffmpeg)
|
||||
(cons 'aiff 'ffmpeg)
|
||||
(cons 'mp4 'ffmpeg)
|
||||
(cons 'aac 'ffmpeg)
|
||||
(cons 'alac 'ffmpeg)
|
||||
(cons 'ac3 'ffmpeg)
|
||||
(cons 'ape 'ffmpeg)
|
||||
(cons 'wavpack 'ffmpeg)
|
||||
(cons 'wma 'ffmpeg)
|
||||
(cons 'matroska 'ffmpeg))))
|
||||
|
||||
|
||||
|
||||
(define (find-reader audio-file)
|
||||
|
||||
@@ -0,0 +1,287 @@
|
||||
(module audio-encoder racket/base
|
||||
|
||||
(require racket/path
|
||||
racket/string
|
||||
racket/contract
|
||||
racket/runtime-path
|
||||
"flac-encoder.rkt"
|
||||
"opus-encoder.rkt"
|
||||
"taglib.rkt"
|
||||
"private/pcm-converter.rkt"
|
||||
"private/utils.rkt")
|
||||
|
||||
(provide audio-encode
|
||||
audio-supported-encoder-extensions
|
||||
audio-register-encoder!
|
||||
make-audio-encoder
|
||||
audio-encoder?)
|
||||
|
||||
(define-struct audio-encoder (exts open write finish settings))
|
||||
|
||||
(define-runtime-module-path-index audio-decoder-module "audio-decoder.rkt")
|
||||
|
||||
(define audio-encoders (make-hash))
|
||||
|
||||
(define (audio-register-encoder! type encoder)
|
||||
(hash-set! audio-encoders type encoder))
|
||||
|
||||
(audio-register-encoder!
|
||||
'flac
|
||||
(make-audio-encoder '("flac")
|
||||
flac-encoder-open
|
||||
flac-encoder-write
|
||||
flac-encoder-finish
|
||||
flac-encoder-prepare-settings))
|
||||
|
||||
(audio-register-encoder!
|
||||
'opus
|
||||
(make-audio-encoder '("opus" "oga")
|
||||
opus-encoder-open
|
||||
opus-encoder-write
|
||||
opus-encoder-finish
|
||||
opus-encoder-prepare-settings))
|
||||
|
||||
(define (audio-supported-encoder-extensions)
|
||||
(apply append (map audio-encoder-exts (hash-values audio-encoders))))
|
||||
|
||||
(define (path-extension-symbol file)
|
||||
(let ((ext (path-get-extension (build-path file))))
|
||||
(and ext (string->symbol (string-downcase (substring (bytes->string/utf-8 ext) 1))))))
|
||||
|
||||
(define (encoder-for-output output-file explicit-kind)
|
||||
(let ((kind (or explicit-kind (path-extension-symbol output-file))))
|
||||
(cond [(and kind (hash-ref audio-encoders kind #f)) (values kind (hash-ref audio-encoders kind))]
|
||||
[else (error 'audio-encode "cannot infer encoder from output file ~a" output-file)])))
|
||||
|
||||
(define (tag-value-copy! src dst getter setter empty?)
|
||||
(let ((v (getter src)))
|
||||
(unless (empty? v) (setter dst v))))
|
||||
|
||||
(define (empty-string? v) (or (eq? v #f) (and (string? v) (string=? v ""))))
|
||||
(define (empty-number? v) (or (eq? v #f) (and (number? v) (< v 0))))
|
||||
|
||||
(define (merge-hash a b)
|
||||
(let ((out (make-hash)))
|
||||
(when (hash? a)
|
||||
(for-each (lambda (k) (hash-set! out k (hash-ref a k))) (hash-keys a)))
|
||||
(when (hash? b)
|
||||
(for-each (lambda (k) (hash-set! out k (hash-ref b k))) (hash-keys b)))
|
||||
out))
|
||||
|
||||
(define (copy-hash h)
|
||||
(let ((out (make-hash)))
|
||||
(when (hash? h)
|
||||
(for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h)))
|
||||
out))
|
||||
|
||||
(define (maybe-string s) (and (string? s) (not (string=? s "")) s))
|
||||
(define (maybe-number n) (and (number? n) (>= n 0) (number->string n)))
|
||||
|
||||
(define (source-tags->opus-settings input-file settings)
|
||||
;; For Opus, embedded pictures must be written into the OpusTags packet
|
||||
;; before the encoder starts. TagLib post-processing is not reliable for
|
||||
;; this path, so transfer the regular comments and cover art through
|
||||
;; libopusenc comments instead.
|
||||
(with-handlers ([exn:fail? (lambda (e)
|
||||
(warn-sound "Could not read source tags from ~a for Opus comments: ~a"
|
||||
input-file (exn-message e))
|
||||
settings)])
|
||||
(call-with-id3-tags
|
||||
input-file
|
||||
(lambda (src)
|
||||
(if (not (tags-valid? src))
|
||||
settings
|
||||
(let ((out (copy-hash settings))
|
||||
(comments (make-hash)))
|
||||
(let ((title (maybe-string (tags-title src)))) (when title (hash-set! comments 'title title)))
|
||||
(let ((album (maybe-string (tags-album src)))) (when album (hash-set! comments 'album album)))
|
||||
(let ((artist (maybe-string (tags-artist src)))) (when artist (hash-set! comments 'artist artist)))
|
||||
(let ((comment (maybe-string (tags-comment src)))) (when comment (hash-set! comments 'comment comment)))
|
||||
(let ((genre (maybe-string (tags-genre src)))) (when genre (hash-set! comments 'genre genre)))
|
||||
(let ((composer (maybe-string (tags-composer src)))) (when composer (hash-set! comments 'composer composer)))
|
||||
(let ((album-artist (maybe-string (tags-album-artist src)))) (when album-artist (hash-set! comments 'albumartist album-artist)))
|
||||
(let ((year (maybe-number (tags-year src)))) (when year (hash-set! comments 'date year)))
|
||||
(let ((track (maybe-number (tags-track src)))) (when track (hash-set! comments 'tracknumber track)))
|
||||
(let ((disc (tags-disc-number src)))
|
||||
(cond [(string? disc) (unless (string=? disc "") (hash-set! comments 'discnumber disc))]
|
||||
[(and (number? disc) (>= disc 0)) (hash-set! comments 'discnumber (number->string disc))]
|
||||
[else (void)]))
|
||||
(unless (null? (hash-keys comments)) (hash-set! out 'comments comments))
|
||||
(let ((picture (tags-picture src)))
|
||||
(unless (eq? picture #f) (hash-set! out 'picture picture)))
|
||||
out)))
|
||||
#:mode 'read)))
|
||||
|
||||
(define (make-tag-result method success? picture note)
|
||||
(let ((h (make-hash)))
|
||||
(hash-set! h 'method method)
|
||||
(hash-set! h 'success? success?)
|
||||
(hash-set! h 'picture? (not (eq? picture #f)))
|
||||
(when (id3-picture? picture)
|
||||
(hash-set! h 'picture-size (id3-picture-size picture))
|
||||
(hash-set! h 'picture-mimetype (id3-picture-mimetype picture)))
|
||||
(when note (hash-set! h 'note note))
|
||||
h))
|
||||
|
||||
(define (copy-tags! input-file output-file)
|
||||
(with-handlers ([exn:fail? (lambda (e)
|
||||
(warn-sound "Could not copy tags from ~a to ~a: ~a"
|
||||
input-file output-file (exn-message e))
|
||||
(make-tag-result 'taglib-post-copy #f #f (exn-message e)))])
|
||||
(call-with-id3-tags
|
||||
input-file
|
||||
(lambda (src)
|
||||
(call-with-id3-tags
|
||||
output-file
|
||||
(lambda (dst)
|
||||
(if (and (tags-valid? src) (tags-valid? dst))
|
||||
(begin
|
||||
(tag-value-copy! src dst tags-title tags-title! empty-string?)
|
||||
(tag-value-copy! src dst tags-album tags-album! empty-string?)
|
||||
(tag-value-copy! src dst tags-artist tags-artist! empty-string?)
|
||||
(tag-value-copy! src dst tags-comment tags-comment! empty-string?)
|
||||
(tag-value-copy! src dst tags-genre tags-genre! empty-string?)
|
||||
(tag-value-copy! src dst tags-composer tags-composer! empty-string?)
|
||||
(tag-value-copy! src dst tags-album-artist tags-album-artist! empty-string?)
|
||||
(tag-value-copy! src dst tags-year tags-year! empty-number?)
|
||||
(tag-value-copy! src dst tags-track tags-track! empty-number?)
|
||||
(tag-value-copy! src dst tags-disc-number tags-disc-number! empty-number?)
|
||||
(let ((picture (tags-picture src)))
|
||||
(unless (eq? picture #f) (tags-picture! dst picture))
|
||||
(tags-save! dst)
|
||||
(make-tag-result 'taglib-post-copy #t picture #f)))
|
||||
(make-tag-result 'taglib-post-copy #f #f "source or destination tags invalid")))
|
||||
#:mode 'read-write))
|
||||
#:mode 'read)))
|
||||
|
||||
(define (input-frames-in-buffer fmt buf-len)
|
||||
(let* ((channels (hash-ref fmt 'channels 1))
|
||||
(bits (hash-ref fmt 'bits-per-sample (hash-ref fmt 'pcm-bits-per-sample 16)))
|
||||
(bytes-per-sample (max 1 (quotient bits 8)))
|
||||
(frame-bytes (* channels bytes-per-sample)))
|
||||
(if (> frame-bytes 0) (quotient buf-len frame-bytes) 0)))
|
||||
|
||||
(define (total-input-frames fmt)
|
||||
(and (hash? fmt)
|
||||
(or (hash-ref fmt 'total-samples #f)
|
||||
(hash-ref fmt 'total-frames #f)
|
||||
(hash-ref fmt 'frames #f))))
|
||||
|
||||
(define (audio-encode input-file output-file settings
|
||||
#:encoder [explicit-kind #f]
|
||||
#:copy-tags? [copy-tags? #t]
|
||||
#:progress-callback [progress-callback #f])
|
||||
(define-values (kind encoder) (encoder-for-output output-file explicit-kind))
|
||||
(define effective-settings (if (and copy-tags? (eq? kind 'opus))
|
||||
(source-tags->opus-settings input-file settings)
|
||||
settings))
|
||||
(define backend-handle #f)
|
||||
(define format #f)
|
||||
(define output-format #f)
|
||||
(define converter #f)
|
||||
(define frames-written 0)
|
||||
(define frames-read 0)
|
||||
(define last-progress -1.0)
|
||||
(define tags-result #f)
|
||||
|
||||
(define (progress! phase input-format)
|
||||
(when progress-callback
|
||||
(let* ((total (total-input-frames input-format))
|
||||
(progress (and (integer? total) (> total 0)
|
||||
(min 1.0 (/ frames-read total))))
|
||||
(h (make-hash)))
|
||||
(hash-set! h 'phase phase)
|
||||
(hash-set! h 'encoder kind)
|
||||
(hash-set! h 'input input-file)
|
||||
(hash-set! h 'output output-file)
|
||||
(hash-set! h 'frames-read frames-read)
|
||||
(hash-set! h 'frames-written frames-written)
|
||||
(hash-set! h 'total-frames total)
|
||||
(hash-set! h 'progress progress)
|
||||
(hash-set! h 'input-format input-format)
|
||||
(when output-format (hash-set! h 'output-format output-format))
|
||||
(progress-callback h)
|
||||
(when (number? progress) (set! last-progress progress)))))
|
||||
|
||||
(define (ensure-open! fmt)
|
||||
(when (eq? backend-handle #f)
|
||||
;; Record the resolved output format, not merely the incoming PCM format.
|
||||
;; This matters when only FLAC bit depth changes, because no swresample
|
||||
;; converter is needed but the resulting FLAC stream metadata still differs.
|
||||
(set! output-format ((audio-encoder-settings encoder) effective-settings fmt))
|
||||
(set! backend-handle ((audio-encoder-open encoder) output-file effective-settings fmt))))
|
||||
|
||||
(define (write-backend! fmt buffer buf-len)
|
||||
(ensure-open! fmt)
|
||||
(set! frames-written (+ frames-written ((audio-encoder-write encoder) backend-handle fmt buffer buf-len))))
|
||||
|
||||
(define (ensure-converter! input-format)
|
||||
;; FLAC may need conversion because the caller requested a target sample
|
||||
;; rate or bit depth. Opus is deliberately not routed through this
|
||||
;; converter by default: libopusenc accepts the source input rate and has
|
||||
;; its own resampler, and opus-encoder.rkt feeds it float PCM directly.
|
||||
(when (and (eq? kind 'flac) (eq? converter #f))
|
||||
(when (pcm-conversion-needed? input-format effective-settings)
|
||||
(set! converter (make-pcm-converter input-format effective-settings)))))
|
||||
|
||||
(define (write-converted! input-format buffer buf-len)
|
||||
(ensure-converter! input-format)
|
||||
(cond [converter
|
||||
(let-values (((out out-samples) (pcm-converter-convert converter buffer buf-len input-format)))
|
||||
(when (> out-samples 0)
|
||||
(write-backend! (pcm-converter-output-format converter) out (bytes-length out))))]
|
||||
[else (write-backend! input-format buffer buf-len)]))
|
||||
|
||||
(define (drain-converter!)
|
||||
(when converter
|
||||
(let loop ()
|
||||
(let-values (((out out-samples) (pcm-converter-drain converter)))
|
||||
(when (> out-samples 0)
|
||||
(write-backend! (pcm-converter-output-format converter) out (bytes-length out))
|
||||
(loop))))))
|
||||
|
||||
(define (on-format audio-kind ao-kind handle fmt)
|
||||
;; Keep stream metadata, but delay encoder creation until the first audio
|
||||
;; buffer. Some decoders report an output-oriented stream format first
|
||||
;; and then the exact PCM frame format in buf-info.
|
||||
(set! format fmt)
|
||||
(progress! 'format fmt))
|
||||
|
||||
(define (on-audio audio-kind ao-kind handle buf-info buffer buf-len)
|
||||
(let ((effective-format (merge-hash format buf-info)))
|
||||
(set! format effective-format)
|
||||
(set! frames-read (+ frames-read (input-frames-in-buffer effective-format buf-len)))
|
||||
(write-converted! effective-format buffer buf-len)
|
||||
(progress! 'audio effective-format)))
|
||||
|
||||
(let* ((audio-open-proc (dynamic-require audio-decoder-module 'audio-open))
|
||||
(audio-read-proc (dynamic-require audio-decoder-module 'audio-read))
|
||||
(decoder (audio-open-proc input-file on-format on-audio)))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda () (audio-read-proc decoder))
|
||||
(lambda ()
|
||||
(dynamic-wind
|
||||
drain-converter!
|
||||
(lambda () (when backend-handle ((audio-encoder-finish encoder) backend-handle)))
|
||||
(lambda () (when converter (pcm-converter-close! converter)))))))
|
||||
|
||||
(progress! 'finished-encoding format)
|
||||
(set! tags-result
|
||||
(cond [(not copy-tags?) (make-tag-result 'none #t #f "tag copy disabled")]
|
||||
[(eq? kind 'opus)
|
||||
(make-tag-result 'libopusenc-comments #t (hash-ref effective-settings 'picture #f) #f)]
|
||||
[else (copy-tags! input-file output-file)]))
|
||||
(progress! 'finished format)
|
||||
(let ((r (make-hash)))
|
||||
(hash-set! r 'encoder kind)
|
||||
(hash-set! r 'input input-file)
|
||||
(hash-set! r 'output output-file)
|
||||
(hash-set! r 'input-format format)
|
||||
(hash-set! r 'output-format output-format)
|
||||
(hash-set! r 'frames-read frames-read)
|
||||
(hash-set! r 'frames-written frames-written)
|
||||
(hash-set! r 'tag-copy tags-result)
|
||||
r))
|
||||
|
||||
) ; end of module
|
||||
@@ -0,0 +1,539 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/place
|
||||
racket/async-channel
|
||||
"libao.rkt"
|
||||
"audio-decoder.rkt"
|
||||
"private/utils.rkt"
|
||||
early-return
|
||||
)
|
||||
|
||||
(provide placed-player
|
||||
audio-known-exts?
|
||||
)
|
||||
|
||||
(define get-current-seconds current-seconds)
|
||||
|
||||
(define (eq-seconds? s1 s2)
|
||||
(let ((s1* (inexact->exact (round s1)))
|
||||
(s2* (inexact->exact (round s2))))
|
||||
(= s1* s2*)))
|
||||
|
||||
(define (placed-player ch-in)
|
||||
(let ((ch-evt #f)
|
||||
(ch-out #f)
|
||||
(ao-h #f)
|
||||
(ao-mutex (make-mutex))
|
||||
(ao-dec #f)
|
||||
(current-seconds 0)
|
||||
(current-deci-seconds 0)
|
||||
(stored-seconds -1)
|
||||
(current-file-id 0)
|
||||
(files-playing '())
|
||||
(current-bits -1)
|
||||
(current-rate -1)
|
||||
(current-channels -1)
|
||||
(current-volume 100.0)
|
||||
(req-volume 100.0)
|
||||
(max-buf-secs 4)
|
||||
(min-buf-secs 2)
|
||||
(play-thread #f)
|
||||
(player-state 'stopped)
|
||||
(decoder-buf-info #f)
|
||||
(decoder-meta #f)
|
||||
(feeding-audio #f)
|
||||
(feed-interrupted #f)
|
||||
)
|
||||
|
||||
(define-syntax with-ao-h
|
||||
(syntax-rules (ao-h ao-mutex)
|
||||
((_ r b1 ...)
|
||||
(with-mutex ao-mutex
|
||||
(if (ao-valid? ao-h)
|
||||
(begin b1 ...)
|
||||
r)))))
|
||||
|
||||
(define (put data)
|
||||
(if (place-channel? ch-out)
|
||||
(place-channel-put ch-out data)
|
||||
(async-channel-put ch-out data)))
|
||||
|
||||
(define (evt data)
|
||||
(if (place-channel? ch-evt)
|
||||
(place-channel-put ch-evt data)
|
||||
(async-channel-put ch-evt data)))
|
||||
|
||||
(define (get)
|
||||
(if (place-channel? ch-in)
|
||||
(place-channel-get ch-in)
|
||||
(async-channel-get ch-in)))
|
||||
|
||||
(define (audio-read-worker ao-dec file-id)
|
||||
(set! feeding-audio #t)
|
||||
(set! play-thread
|
||||
(thread (λ ()
|
||||
(with-handlers ([exn:fail?
|
||||
(λ (e)
|
||||
(dbg-sound "Exception in audio-read-worker: ~a" e)
|
||||
(set! feeding-audio #f)
|
||||
(set! feed-interrupted #f)
|
||||
(set! player-state 'stopped)
|
||||
(evt (list 'exception (exn-message e))))])
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(dbg-sound "audio-read start")
|
||||
(audio-read ao-dec)
|
||||
(dbg-sound "audio-read end")
|
||||
)
|
||||
(λ () (set! feeding-audio #f)))
|
||||
(state "audio-read-worker: just after audio-read" evt)
|
||||
(if feed-interrupted
|
||||
(set! feed-interrupted #f)
|
||||
(begin
|
||||
(evt '(audio-done))
|
||||
(let ((bufsize #f))
|
||||
(let loop ()
|
||||
(let ((nbfs (with-ao-h 'done
|
||||
(ao-bufsize-async ao-h))))
|
||||
(if (eq? nbfs 'done)
|
||||
(begin
|
||||
(set! bufsize 0)
|
||||
'done)
|
||||
(cond
|
||||
((eq? bufsize #f) (set! bufsize nbfs) (loop))
|
||||
((= nbfs 0) (set! bufsize 0) 'done)
|
||||
((> nbfs bufsize) (set! bufsize nbfs) 'done)
|
||||
(else
|
||||
(check-paused)
|
||||
(set! bufsize nbfs)
|
||||
(sleep 0.1)
|
||||
(loop)))
|
||||
)
|
||||
)
|
||||
)
|
||||
;; Alleen de actuele worker mag de globale spelerstatus beëindigen.
|
||||
;; Een oude drain-worker mag hoogstens zichzelf opruimen.
|
||||
(when (and (= bufsize 0) (= file-id current-file-id))
|
||||
(set! player-state 'stopped)
|
||||
(state "audio-read-worker: after read with bufsize 0" evt))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define (check-volume)
|
||||
(unless (= req-volume current-volume)
|
||||
(set! current-volume req-volume)
|
||||
(with-ao-h 'no-op
|
||||
(ao-set-volume! ao-h current-volume))
|
||||
(state "check-volume: volume changed" evt)
|
||||
)
|
||||
)
|
||||
|
||||
(define (check-paused)
|
||||
(if (eq? player-state 'paused)
|
||||
(begin
|
||||
(with-ao-h 'no-op (ao-pause ao-h #t))
|
||||
(state "check-paused: player-state = paused" evt)
|
||||
(let loop ()
|
||||
(sleep 0.1)
|
||||
(when (eq? player-state 'paused)
|
||||
(loop)))
|
||||
; If the player is no longer paused, we unpause the ao stream,
|
||||
; also if the player is no longer playing (i.e. player-state = stopped)
|
||||
; in which case, we expect ao-clear-async to have been executed, which
|
||||
; means the playing queue is empty.
|
||||
(with-ao-h 'no-op (ao-pause ao-h #f))
|
||||
(state (format "check-paused: player-state = ~a" player-state) evt)
|
||||
#t)
|
||||
#f))
|
||||
|
||||
(define (audio-play type ao-type handle buf-info buffer buf-len)
|
||||
(let* ((sample (hash-ref buf-info 'sample))
|
||||
(rate (hash-ref buf-info 'sample-rate))
|
||||
(second (/ (* sample 1.0) (* rate 1.0)))
|
||||
(bits-per-sample (hash-ref buf-info 'bits-per-sample))
|
||||
(bytes-per-sample (/ bits-per-sample 8))
|
||||
(channels (hash-ref buf-info 'channels))
|
||||
(bytes-per-sample-all-channels (* channels bytes-per-sample))
|
||||
(duration (hash-ref buf-info 'duration))
|
||||
)
|
||||
|
||||
(set! decoder-buf-info buf-info)
|
||||
|
||||
(when (not (and
|
||||
(= current-bits bits-per-sample)
|
||||
(= current-rate rate)
|
||||
(= current-channels channels)))
|
||||
; If we need to reopen the ao device with different bit-rates,
|
||||
; we need to wait until the ao sample queue is empty
|
||||
(let loop ()
|
||||
(let* ((s (with-ao-h -1 (ao-at-second ao-h))))
|
||||
(unless (or (= s -1) (eq-seconds? stored-seconds s))
|
||||
(set! stored-seconds s)
|
||||
(state "audio-play: seconds changes (III)" evt)))
|
||||
(let ((bufsize (with-ao-h 0 (ao-bufsize-async ao-h))))
|
||||
(if (= bufsize 0)
|
||||
(with-mutex ao-mutex
|
||||
(when (ao-valid? ao-h)
|
||||
(ao-close ao-h))
|
||||
(set! ao-h #f))
|
||||
(begin (sleep 0.1) (loop)))))
|
||||
)
|
||||
|
||||
(with-mutex ao-mutex
|
||||
(when (eq? ao-h #f)
|
||||
(dbg-sound "opening ao-h for ~a ~a" current-file-id files-playing)
|
||||
(set! ao-h (ao-open-live bits-per-sample
|
||||
rate channels
|
||||
'native-endian))
|
||||
)
|
||||
(with-ao-h 'no-op
|
||||
(ao-set-volume! ao-h current-volume)
|
||||
(set! current-bits bits-per-sample)
|
||||
(set! current-rate rate)
|
||||
(set! current-channels channels)
|
||||
)
|
||||
)
|
||||
|
||||
(check-volume)
|
||||
(with-ao-h 'no-op
|
||||
(when (not (eq? player-state 'stopped))
|
||||
(ao-play ao-h current-file-id second duration buffer buf-len ao-type)
|
||||
))
|
||||
(check-paused)
|
||||
|
||||
(let* ((s* (with-ao-h 0 (ao-at-second ao-h)))
|
||||
(s (inexact->exact (round (* s* 10)))))
|
||||
(unless (= s current-deci-seconds)
|
||||
(set! current-deci-seconds s)
|
||||
(set! current-seconds s*)))
|
||||
|
||||
(unless (eq-seconds? stored-seconds current-seconds)
|
||||
(set! stored-seconds current-seconds)
|
||||
(state "audio-play: seconds changed (I)" evt))
|
||||
|
||||
(let* ((buf-size (with-ao-h 0 (ao-bufsize-async ao-h)))
|
||||
(buf-seconds (exact->inexact (/ buf-size
|
||||
bytes-per-sample-all-channels
|
||||
rate)))
|
||||
)
|
||||
(when (> buf-seconds max-buf-secs)
|
||||
(let waiter ()
|
||||
(when (not (check-paused))
|
||||
(sleep 0.3))
|
||||
(let* ((s* (with-ao-h 0 (ao-at-second ao-h)))
|
||||
(s (inexact->exact (round (* s* 10)))))
|
||||
|
||||
(unless (= s current-deci-seconds)
|
||||
(set! current-deci-seconds s)
|
||||
(set! current-seconds s*))
|
||||
|
||||
(unless (eq-seconds? stored-seconds current-seconds)
|
||||
(set! stored-seconds current-seconds)
|
||||
(state "audio-play: seconds changed (II)" evt))
|
||||
|
||||
(let ((buf-seconds-left (exact->inexact
|
||||
(/ (with-ao-h 0 (ao-bufsize-async ao-h))
|
||||
bytes-per-sample-all-channels
|
||||
rate))))
|
||||
(when (>= buf-seconds-left min-buf-secs)
|
||||
(waiter)))))
|
||||
))
|
||||
)
|
||||
)
|
||||
|
||||
(define (audio-meta type ao-type handle meta)
|
||||
(set! decoder-meta meta)
|
||||
#t)
|
||||
|
||||
(define (cleanup)
|
||||
(set! files-playing '())
|
||||
(set! current-seconds 0)
|
||||
(set! current-deci-seconds 0)
|
||||
(set! stored-seconds -1)
|
||||
(set! current-file-id 0)
|
||||
(set! current-bits -1)
|
||||
(set! current-rate -1)
|
||||
(set! current-channels -1)
|
||||
(set! decoder-buf-info #f)
|
||||
(set! decoder-meta #f)
|
||||
)
|
||||
|
||||
(define (stop-and-cleanup)
|
||||
(dbg-sound "stop and cleanup called")
|
||||
(set! feed-interrupted #t)
|
||||
|
||||
(with-ao-h 'no-op (ao-clear-async ao-h))
|
||||
(set! player-state 'stopped)
|
||||
(unless (eq? ao-dec #f)
|
||||
(audio-stop ao-dec))
|
||||
(set! ao-dec #f)
|
||||
|
||||
(with-ao-h 'no-op (ao-clear-async ao-h))
|
||||
|
||||
(when (thread? play-thread) (thread-wait play-thread))
|
||||
(set! play-thread #f)
|
||||
|
||||
(with-mutex ao-mutex
|
||||
(when (ao-valid? ao-h)
|
||||
(ao-close ao-h)
|
||||
)
|
||||
(set! ao-h #f))
|
||||
|
||||
(set! feed-interrupted #f)
|
||||
(set! feeding-audio #f)
|
||||
|
||||
(cleanup)
|
||||
|
||||
(state "stop-and-cleanup: stopped/cleaned" evt 'force)
|
||||
|
||||
player-state
|
||||
)
|
||||
|
||||
(define (start file)
|
||||
(dbg-sound "starting ~a" file)
|
||||
(when feeding-audio
|
||||
(dbg-sound "interrupting feed")
|
||||
(set! feed-interrupted #t)
|
||||
(with-ao-h 'no-op (ao-clear-async ao-h))
|
||||
(set! player-state 'stopped)
|
||||
(when (audio-handle? ao-dec)
|
||||
(audio-stop ao-dec))
|
||||
(dbg-sound "clearing ao-h queue")
|
||||
(with-ao-h 'no-op (ao-clear-async ao-h))
|
||||
(dbg-sound "waiting for feed to stop")
|
||||
(let loop ()
|
||||
(if feeding-audio
|
||||
(begin
|
||||
(sleep 0.1)
|
||||
(loop))
|
||||
(with-ao-h 'no-op (ao-clear-async ao-h))
|
||||
)
|
||||
)
|
||||
(dbg-sound "waiting for play thread")
|
||||
(when (thread? play-thread) (thread-wait play-thread))
|
||||
(dbg-sound "oke done")
|
||||
)
|
||||
|
||||
|
||||
;(set! current-file-id (+ current-file-id 1))
|
||||
(set! current-file-id (+ (* (get-current-seconds) 10000) (random 1000)))
|
||||
(let ((f (build-path file)))
|
||||
(set! files-playing (cons
|
||||
(cons current-file-id f)
|
||||
(filter (λ (e)
|
||||
(= (car e) (- current-file-id 1)))
|
||||
files-playing))))
|
||||
(set! ao-dec (audio-open file audio-meta audio-play))
|
||||
|
||||
(when (eq? player-state 'stopped)
|
||||
(set! player-state 'playing))
|
||||
(audio-read-worker ao-dec current-file-id)
|
||||
current-file-id)
|
||||
|
||||
(define (param! par val)
|
||||
(cond
|
||||
((eq? par 'opus-bits)
|
||||
(if (integer? val)
|
||||
(cond
|
||||
((= val 16)
|
||||
(current-opusfile-output-format 's16)
|
||||
16
|
||||
)
|
||||
((= val 24)
|
||||
(current-opusfile-output-format 's24)
|
||||
24)
|
||||
(else 'error-unsupported-value)
|
||||
)
|
||||
'error-wrong-value-type)
|
||||
)
|
||||
(else 'error-unknown-param)))
|
||||
|
||||
(define (param par)
|
||||
(cond
|
||||
((eq? par 'opus-bits)
|
||||
(if (eq? (current-opusfile-output-format) 's16)
|
||||
16
|
||||
24))
|
||||
(else 'error-unknown-param)))
|
||||
|
||||
(define (pause paused)
|
||||
(when (or (eq? player-state 'paused)
|
||||
(eq? player-state 'playing))
|
||||
(set! player-state (if paused 'paused 'playing))))
|
||||
|
||||
(define (seek percentage)
|
||||
(with-ao-h 'no-op
|
||||
(ao-clear-async ao-h))
|
||||
(unless (eq? ao-dec #f)
|
||||
(audio-seek ao-dec percentage)))
|
||||
|
||||
(define (volume percentage)
|
||||
(set! req-volume percentage))
|
||||
|
||||
(define (ao-buf-ms)
|
||||
(ao-playback-buf-ms))
|
||||
|
||||
(define (ao-buf-ms! ms)
|
||||
(let ((the-ms (if (< ms 50) 50 (if (> ms 1000) 1000 ms))))
|
||||
(ao-set-playback-buf-ms! the-ms)
|
||||
(ao-buf-ms)))
|
||||
|
||||
(define (state msg cb . force)
|
||||
(let ((h (make-hash)))
|
||||
(with-mutex ao-mutex
|
||||
(let ((m-id (if (ao-valid? ao-h) (ao-at-music-id ao-h) #f)))
|
||||
(hash-set! h 'decoder (if (audio-handle? ao-dec) (audio-kind ao-dec) #f))
|
||||
(hash-set! h 'msg msg)
|
||||
(hash-set! h 'file (let ((r (filter (λ (e)
|
||||
(and (not (eq? m-id #f)) (= (car e) m-id)))
|
||||
files-playing)))
|
||||
(if (null? r) #f (cdar r))))
|
||||
(hash-set! h 'state player-state)
|
||||
(hash-set! h 'valid-ao-handle (ao-valid? ao-h))
|
||||
(hash-set! h 'duration (if (ao-valid? ao-h) (ao-music-duration ao-h) #f))
|
||||
(hash-set! h 'at-second (if (ao-valid? ao-h) (ao-at-second ao-h) #f))
|
||||
(hash-set! h 'at-music-id m-id)
|
||||
(hash-set! h 'volume current-volume)
|
||||
(hash-set! h 'buf-size (if (ao-valid? ao-h) (ao-bufsize-async ao-h) 0))
|
||||
(hash-set! h 'reuse-buf-len (if (ao-valid? ao-h)
|
||||
(ao-reuse-buf-len-async ao-h)
|
||||
#f))
|
||||
(hash-set! h 'sample-queue-len (if (ao-valid? ao-h)
|
||||
(ao-sample-queue-len-async ao-h)
|
||||
#f))
|
||||
(hash-set! h 'bits current-bits)
|
||||
(hash-set! h 'rate current-rate)
|
||||
(hash-set! h 'channels current-channels)
|
||||
(hash-set! h 'decoder-meta decoder-meta)
|
||||
(hash-set! h 'decoder-buf-info decoder-buf-info)
|
||||
)
|
||||
)
|
||||
|
||||
(let ((m-id (hash-ref h 'at-music-id)))
|
||||
(unless (and (null? force) (or (eq? m-id #f) (= m-id 0)))
|
||||
(cb (list 'state (list h player-state)))))
|
||||
)
|
||||
)
|
||||
|
||||
(let loop ()
|
||||
(let* ((data (get))
|
||||
(cmd (car data))
|
||||
(in-rpc #f))
|
||||
|
||||
(define-syntax do-rpc
|
||||
(syntax-rules (in-rpc)
|
||||
((_ b1 ...)
|
||||
(begin
|
||||
(set! in-rpc #t)
|
||||
(let ((r (begin b1 ...)))
|
||||
(set! in-rpc #f)
|
||||
(put r))))))
|
||||
|
||||
(with-handlers ([exn:fail? (λ (e)
|
||||
(if (eq? ch-evt #f)
|
||||
(raise e)
|
||||
(begin
|
||||
(evt (list 'exception
|
||||
(exn-message e)))
|
||||
(when in-rpc
|
||||
(put (list 'error
|
||||
(exn-message e)))
|
||||
(set! in-rpc #f))
|
||||
(loop))
|
||||
))])
|
||||
|
||||
(cond
|
||||
((eq? cmd 'quit) (do-rpc
|
||||
(stop-and-cleanup)
|
||||
(set! player-state 'quit)
|
||||
(state "quit" evt 'force)
|
||||
'(quit)))
|
||||
((eq? cmd 'init) (do-rpc
|
||||
(set! ch-out (cadr data))
|
||||
(set! ch-evt (caddr data))
|
||||
'(initialized))
|
||||
(loop))
|
||||
(else
|
||||
(when (or (eq? ch-out #f) (eq? ch-evt #f))
|
||||
(error "placed player not initialized"))
|
||||
|
||||
(unless (eq? cmd 'quit)
|
||||
(cond
|
||||
((eq? cmd 'buf-seconds)
|
||||
(do-rpc
|
||||
(let* ((clamp (λ (x) (min 30 (max 2 x))))
|
||||
(a (clamp (cadr data)))
|
||||
(b (clamp (caddr data))))
|
||||
(set! min-buf-secs (min a b))
|
||||
(set! max-buf-secs (max a b))
|
||||
'(ok))))
|
||||
((eq? cmd 'open)
|
||||
(do-rpc
|
||||
(let ((file (cadr data)))
|
||||
(let ((id (start file)))
|
||||
(list (list 'ok id))))))
|
||||
((eq? cmd 'seek)
|
||||
(do-rpc
|
||||
(let ((percentage (cadr data)))
|
||||
(seek percentage)
|
||||
'(ok))))
|
||||
((eq? cmd 'pause)
|
||||
(do-rpc
|
||||
(let ((paused (cadr data)))
|
||||
(pause paused)
|
||||
'(ok))))
|
||||
((eq? cmd 'paused)
|
||||
(do-rpc
|
||||
(list (eq? player-state 'paused))))
|
||||
((eq? cmd 'volume)
|
||||
(do-rpc
|
||||
(let ((percentage (cadr data)))
|
||||
(volume (exact->inexact percentage))
|
||||
'(ok))))
|
||||
((eq? cmd 'get-volume)
|
||||
(do-rpc
|
||||
(list current-volume)))
|
||||
((eq? cmd 'stop)
|
||||
(do-rpc
|
||||
(stop-and-cleanup)
|
||||
'(ok)))
|
||||
((eq? cmd 'param!)
|
||||
(do-rpc
|
||||
(let ((par (cadr data))
|
||||
(value (caddr data)))
|
||||
(list (param! par value)))))
|
||||
((eq? cmd 'param)
|
||||
(do-rpc
|
||||
(let ((par (cadr data)))
|
||||
(list (param par)))))
|
||||
((eq? cmd 'state)
|
||||
(do-rpc
|
||||
(let ((st #f))
|
||||
(state "'state command" (λ (s) (set! st s)) 'force)
|
||||
st)))
|
||||
((eq? cmd 'ao-buf-ms)
|
||||
(do-rpc
|
||||
(if (null? (cdr data))
|
||||
(list (ao-buf-ms))
|
||||
(list (ao-buf-ms! (cadr data))))
|
||||
))
|
||||
(else
|
||||
(do-rpc
|
||||
(list 'error (format "Unknown command ~a" cmd))))
|
||||
)
|
||||
(loop)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -0,0 +1,299 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/place
|
||||
racket/contract
|
||||
racket/async-channel
|
||||
racket/runtime-path
|
||||
"audio-placed-player.rkt"
|
||||
"private/utils.rkt"
|
||||
(prefix-in ffi: ffi/unsafe)
|
||||
)
|
||||
|
||||
(provide make-audio-player
|
||||
audio-play!
|
||||
audio-pause!
|
||||
audio-paused?
|
||||
audio-stop!
|
||||
audio-quit!
|
||||
audio-seek!
|
||||
audio-volume!
|
||||
audio-volume
|
||||
audio-at-second
|
||||
audio-duration
|
||||
audio-state
|
||||
audio-bits
|
||||
audio-channels
|
||||
audio-decoder
|
||||
audio-music-id
|
||||
audio-rate
|
||||
audio-full-state
|
||||
audio-file
|
||||
audio-play?
|
||||
audio-buf-seconds!
|
||||
audio-ao-buf-ms!
|
||||
audio-ao-buf-ms
|
||||
audio-known-exts?
|
||||
audio-param!
|
||||
audio-param
|
||||
)
|
||||
|
||||
(define-runtime-path placed-player-module "audio-placed-player.rkt")
|
||||
|
||||
(define-struct audio-play
|
||||
(valid? cb-state cb-eof-stream rpc au-place evt-thread state)
|
||||
#:mutable
|
||||
#:transparent
|
||||
)
|
||||
|
||||
(define audio-play-struct? audio-play?)
|
||||
(set! audio-play? (λ (h)
|
||||
(and (audio-play-struct? h)
|
||||
(audio-play-valid? h))))
|
||||
|
||||
|
||||
(define (percentage? p)
|
||||
(and (number? p) (>= p 0)))
|
||||
|
||||
(define (any? x)
|
||||
#t)
|
||||
|
||||
(define (max-percentage? n)
|
||||
(λ (p) (and (percentage? p)
|
||||
(<= p n))))
|
||||
|
||||
(define (is-return? retval sym)
|
||||
;(displayln retval)
|
||||
(if (list? retval)
|
||||
(if (null? retval)
|
||||
#f
|
||||
(eq? (car retval) sym))
|
||||
#f))
|
||||
|
||||
(define (to-ret-value ret)
|
||||
(if (list? ret)
|
||||
(if (null? ret)
|
||||
(error (format "audio-player: no return value in ~a" ret))
|
||||
(car ret))
|
||||
ret))
|
||||
|
||||
(define (is-event? evt sym)
|
||||
(is-return? evt sym))
|
||||
|
||||
(define (evt-data evt)
|
||||
(cadr evt))
|
||||
|
||||
(define-syntax assert
|
||||
(syntax-rules ()
|
||||
((_ cond message ...)
|
||||
(unless cond (error (format message ...))))))
|
||||
|
||||
(define/contract (make-audio-player cb-state cb-eof-stream
|
||||
#:use-place [use-place (place-enabled?)])
|
||||
(->* (procedure? procedure?) (#:use-place boolean?) audio-play?)
|
||||
(let ((cmd-ch #f)
|
||||
(ret-ch #f)
|
||||
(evt-ch #f)
|
||||
(cmd-put #f)
|
||||
(ret-get #f)
|
||||
(evt-get #f)
|
||||
(au-pl #f)
|
||||
(dead-guard #f)
|
||||
(rpc #f)
|
||||
(rpc-mutex (make-mutex))
|
||||
)
|
||||
(if use-place
|
||||
(begin
|
||||
(set! cmd-ch (dynamic-place placed-player-module 'placed-player))
|
||||
(set! cmd-put (λ (data) (place-channel-put cmd-ch data)))
|
||||
(set! au-pl cmd-ch)
|
||||
(set! dead-guard (λ () (let ((evt (place-dead-evt au-pl)))
|
||||
(sync evt))))
|
||||
(let-values (((ret-ch-in ret-ch-out) (place-channel))
|
||||
((evt-ch-in evt-ch-out) (place-channel)))
|
||||
(place-channel-put cmd-ch (list 'init ret-ch-out evt-ch-out))
|
||||
(set! evt-ch evt-ch-in)
|
||||
(set! ret-ch ret-ch-in)
|
||||
(assert (is-return? (place-channel-get ret-ch-in) 'initialized)
|
||||
"Unexpected: not 'initialized returnd from 'init command"))
|
||||
)
|
||||
(begin
|
||||
(set! cmd-ch (make-async-channel))
|
||||
(set! cmd-put (λ (data) (async-channel-put cmd-ch data)))
|
||||
(set! au-pl (thread (λ () (placed-player cmd-ch))))
|
||||
(set! dead-guard (λ () (let ((evt (thread-dead-evt au-pl)))
|
||||
(sync evt))))
|
||||
(set! ret-ch (make-async-channel))
|
||||
(set! evt-ch (make-async-channel))
|
||||
(async-channel-put cmd-ch (list 'init ret-ch evt-ch))
|
||||
(assert (is-return? (async-channel-get ret-ch) 'initialized)
|
||||
"Unexpected: not 'initialized returnd from 'init command")
|
||||
)
|
||||
)
|
||||
(set! ret-get (λ () (to-ret-value (sync ret-ch))))
|
||||
(set! evt-get (λ (timeout-ms) (sync/timeout (/ timeout-ms 1000) evt-ch)))
|
||||
(set! rpc (λ (cmd . args) (with-mutex rpc-mutex
|
||||
(cmd-put (cons cmd args)) (ret-get))))
|
||||
|
||||
(let* ((handle #f)
|
||||
(cb-state* (λ (st st-hash) (cb-state handle st st-hash)))
|
||||
(cb-eof* (λ () (cb-eof-stream handle))))
|
||||
(set! handle (make-audio-play #t
|
||||
cb-state* cb-eof*
|
||||
rpc
|
||||
au-pl
|
||||
#f
|
||||
(make-hash)))
|
||||
(set-audio-play-evt-thread! handle
|
||||
(thread
|
||||
(λ ()
|
||||
(let loop ()
|
||||
(if (audio-play-valid? handle)
|
||||
(let ((e (evt-get 500)))
|
||||
(cond ((eq? e #f) (void))
|
||||
((is-event? e 'state)
|
||||
(let ((data (evt-data e)))
|
||||
(set-audio-play-state! handle (car data))
|
||||
(cb-state* (cadr data) (car data))))
|
||||
((is-event? e 'audio-done) (cb-eof*))
|
||||
((is-event? e 'exception)
|
||||
(err-sound "audio-player: exception event: ~a" e))
|
||||
(else (warn-sound "audio-player: unknown event ~a" e))
|
||||
)
|
||||
(loop))
|
||||
'done)))))
|
||||
|
||||
(thread (λ ()
|
||||
(dbg-sound "guarding audio-placed-player")
|
||||
(dead-guard)
|
||||
(dbg-sound "audio-placed-player has stopped")
|
||||
(set-audio-play-valid?! handle #f)
|
||||
(set-audio-play-rpc! handle #f)
|
||||
(set-audio-play-au-place! handle #f)
|
||||
(set-audio-play-evt-thread! handle #f)
|
||||
(set-audio-play-cb-state! handle #f)
|
||||
(set-audio-play-cb-eof-stream! handle #f)
|
||||
(when (hash? (audio-play-state handle))
|
||||
(let ((h (hash-copy (audio-play-state handle))))
|
||||
(hash-set! h 'state 'invalid)
|
||||
(set-audio-play-state! handle h)))
|
||||
(dbg-sound "audio-play handle invalidated and cleaned of references")
|
||||
))
|
||||
|
||||
(ffi:register-finalizer handle
|
||||
(λ (h)
|
||||
(when (audio-play? h)
|
||||
(rpc 'quit))))
|
||||
|
||||
handle)
|
||||
)
|
||||
)
|
||||
|
||||
(define/contract (audio-play! handle audio-file)
|
||||
(-> audio-play? path-string? number?)
|
||||
(let ((result ((audio-play-rpc handle) 'open audio-file)))
|
||||
(when (eq? result 'error)
|
||||
(error "Got an error from the placed audio player"))
|
||||
(cadr result)))
|
||||
|
||||
(define/contract (audio-pause! handle paused)
|
||||
(-> audio-play? boolean? symbol?)
|
||||
((audio-play-rpc handle) 'pause paused))
|
||||
|
||||
(define/contract (audio-paused? handle)
|
||||
(-> audio-play? boolean?)
|
||||
((audio-play-rpc handle) 'paused))
|
||||
|
||||
(define/contract (audio-stop! handle)
|
||||
(-> audio-play? symbol?)
|
||||
((audio-play-rpc handle) 'stop))
|
||||
|
||||
(define/contract (audio-quit! handle)
|
||||
(-> audio-play? (or/c number? boolean? symbol?))
|
||||
(let ((r ((audio-play-rpc handle) 'quit)))
|
||||
(set-audio-play-valid?! handle #f)
|
||||
r))
|
||||
|
||||
(define/contract (audio-seek! handle percentage)
|
||||
(-> audio-play? (max-percentage? 100) symbol?)
|
||||
((audio-play-rpc handle) 'seek percentage))
|
||||
|
||||
(define/contract (audio-volume! handle percentage)
|
||||
(-> audio-play? percentage? symbol?)
|
||||
((audio-play-rpc handle) 'volume percentage))
|
||||
|
||||
(define/contract (audio-volume handle)
|
||||
(-> audio-play? percentage?)
|
||||
((audio-play-rpc handle) 'get-volume))
|
||||
|
||||
(define/contract (audio-full-state handle)
|
||||
(-> audio-play? hash?)
|
||||
(audio-play-state handle))
|
||||
|
||||
(define-syntax get-state
|
||||
(syntax-rules ()
|
||||
((_ handle id def)
|
||||
(hash-ref (audio-play-state handle) id def))))
|
||||
|
||||
(define/contract (audio-at-second handle)
|
||||
(-> audio-play? (or/c number? boolean?))
|
||||
(get-state handle 'at-second #f))
|
||||
|
||||
(define/contract (audio-duration handle)
|
||||
(-> audio-play? (or/c number? boolean?))
|
||||
(get-state handle 'duration #f))
|
||||
|
||||
(define/contract (audio-channels handle)
|
||||
(-> audio-play? (or/c number? boolean?))
|
||||
(get-state handle 'channels #f))
|
||||
|
||||
(define/contract (audio-state handle)
|
||||
(-> audio-play-struct? symbol?)
|
||||
(if (audio-play-valid? handle)
|
||||
(get-state handle 'state 'initialized)
|
||||
'invalid))
|
||||
|
||||
(define/contract (audio-bits handle)
|
||||
(-> audio-play? (or/c number? boolean?))
|
||||
(get-state handle 'bits #f))
|
||||
|
||||
(define/contract (audio-rate handle)
|
||||
(-> audio-play? (or/c number? boolean?))
|
||||
(get-state handle 'rate #f))
|
||||
|
||||
(define/contract (audio-decoder handle)
|
||||
(-> audio-play? (or/c symbol? boolean?))
|
||||
(get-state handle 'decoder #f))
|
||||
|
||||
(define/contract (audio-music-id handle)
|
||||
(-> audio-play? (or/c number? boolean?))
|
||||
(get-state handle 'at-music-id #f))
|
||||
|
||||
(define/contract (audio-file handle)
|
||||
(-> audio-play? (or/c path-string? boolean?))
|
||||
(get-state handle 'file #f))
|
||||
|
||||
(define/contract (audio-buf-seconds! handle min max)
|
||||
(-> audio-play? number? number? (or/c symbol? boolean?))
|
||||
(let ((from (if (< min 1) 1 (if (> min 10) 10 min)))
|
||||
(until (if (< max min) (+ min 1) (if (> max 30) 30 max))))
|
||||
((audio-play-rpc handle) 'buf-seconds from until)))
|
||||
|
||||
(define/contract (audio-ao-buf-ms! handle ms)
|
||||
(-> audio-play? integer? (or/c integer? boolean?))
|
||||
((audio-play-rpc handle) 'ao-buf-ms ms))
|
||||
|
||||
(define/contract (audio-ao-buf-ms handle)
|
||||
(-> audio-play? (or/c integer? boolean?))
|
||||
((audio-play-rpc handle) 'ao-buf-ms))
|
||||
|
||||
(define/contract (audio-param! handle param value)
|
||||
(-> audio-play? symbol? any? any?)
|
||||
((audio-play-rpc handle) 'param! param value))
|
||||
|
||||
(define/contract (audio-param handle param)
|
||||
(-> audio-play? symbol? any?)
|
||||
((audio-play-rpc handle) 'param param))
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,187 @@
|
||||
#lang racket/base
|
||||
|
||||
(require "audio-encoder.rkt"
|
||||
"tests.rkt"
|
||||
simple-log
|
||||
racket/cmdline
|
||||
racket/file
|
||||
racket/path
|
||||
racket/string)
|
||||
|
||||
(provide encoder-test
|
||||
encoder-test-opus
|
||||
encoder-test-flac)
|
||||
|
||||
(define (setting-value v)
|
||||
(cond ((or (eq? v #f) (eq? v 'source)) 'source)
|
||||
((string? v)
|
||||
(let ((s (string-downcase v)))
|
||||
(if (string=? s "source")
|
||||
'source
|
||||
(let ((n (string->number v)))
|
||||
(if n n (raise-argument-error 'encoder-test "number or source" v))))))
|
||||
(else v)))
|
||||
|
||||
(define (encoder-symbol v)
|
||||
(cond ((symbol? v) v)
|
||||
((string? v) (string->symbol (string-downcase v)))
|
||||
(else (raise-argument-error 'encoder-test "encoder name" v))))
|
||||
|
||||
(define (default-output-file encoder)
|
||||
(build-path (find-system-path 'temp-dir)
|
||||
(format "racket-audio-encoder-test.~a"
|
||||
(case encoder
|
||||
((opus) "opus")
|
||||
((flac) "flac")
|
||||
(else (raise-argument-error 'encoder-test "opus or flac" encoder))))))
|
||||
|
||||
(define (opus-settings bitrate-kbps sample-rate)
|
||||
(if (eq? sample-rate 'source)
|
||||
(hash 'bitrate (* bitrate-kbps 1000)
|
||||
'vbr? #t
|
||||
'complexity 10)
|
||||
(hash 'bitrate (* bitrate-kbps 1000)
|
||||
'vbr? #t
|
||||
'complexity 10
|
||||
'sample-rate sample-rate)))
|
||||
|
||||
(define (flac-settings compression-level sample-rate bits-per-sample)
|
||||
(let ((h (make-hash)))
|
||||
(hash-set! h 'compression-level compression-level)
|
||||
(unless (eq? sample-rate 'source) (hash-set! h 'sample-rate sample-rate))
|
||||
(unless (eq? bits-per-sample 'source) (hash-set! h 'bits-per-sample bits-per-sample))
|
||||
h))
|
||||
|
||||
(define (format-summary fmt)
|
||||
(if (hash? fmt)
|
||||
(format "rate=~a, channels=~a, bits=~a, frames=~a"
|
||||
(hash-ref fmt 'sample-rate "?")
|
||||
(hash-ref fmt 'channels "?")
|
||||
(hash-ref fmt 'bits-per-sample "?")
|
||||
(hash-ref fmt 'total-frames (hash-ref fmt 'total-samples "?")))
|
||||
"unknown"))
|
||||
|
||||
(define (tag-summary tag-copy)
|
||||
(if (hash? tag-copy)
|
||||
(format "method=~a, success=~a, picture=~a~a"
|
||||
(hash-ref tag-copy 'method "?")
|
||||
(hash-ref tag-copy 'success? "?")
|
||||
(hash-ref tag-copy 'picture? #f)
|
||||
(let ((size (hash-ref tag-copy 'picture-size #f))
|
||||
(mt (hash-ref tag-copy 'picture-mimetype #f)))
|
||||
(if size (format ", ~a bytes, ~a" size mt) "")))
|
||||
"unknown"))
|
||||
|
||||
(define (display-result result)
|
||||
(displayln "")
|
||||
(displayln "Encoder result")
|
||||
(displayln "--------------")
|
||||
(displayln (format "encoder : ~a" (hash-ref result 'encoder '?)))
|
||||
(displayln (format "input : ~a" (hash-ref result 'input '?)))
|
||||
(displayln (format "output : ~a" (hash-ref result 'output '?)))
|
||||
(displayln (format "frames read : ~a" (hash-ref result 'frames-read '?)))
|
||||
(displayln (format "frames written : ~a" (hash-ref result 'frames-written '?)))
|
||||
(displayln (format "input format : ~a" (format-summary (hash-ref result 'input-format #f))))
|
||||
(displayln (format "output format : ~a" (format-summary (hash-ref result 'output-format #f))))
|
||||
(displayln (format "tag copy : ~a" (tag-summary (hash-ref result 'tag-copy #f))))
|
||||
result)
|
||||
|
||||
(define (make-progress-callback)
|
||||
(define last-pct -1)
|
||||
(lambda (h)
|
||||
(let ((p (hash-ref h 'progress #f)))
|
||||
(when (number? p)
|
||||
(let ((pct (inexact->exact (round (* 100 p)))))
|
||||
(when (not (= pct last-pct))
|
||||
(set! last-pct pct)
|
||||
(printf "\rprogress : ~a%" pct)
|
||||
(flush-output))
|
||||
(when (or (>= pct 100) (eq? (hash-ref h 'phase #f) 'finished))
|
||||
(newline)))))))
|
||||
|
||||
(define (encoder-test input-file output-file encoder settings #:copy-tags? [copy-tags? #t])
|
||||
(let* ((enc (encoder-symbol encoder))
|
||||
(out (if output-file output-file (default-output-file enc))))
|
||||
(when (file-exists? out) (delete-file out))
|
||||
(displayln (format "Encoding ~a" input-file))
|
||||
(displayln (format " -> ~a" out))
|
||||
(displayln (format "encoder : ~a" enc))
|
||||
(displayln (format "settings: ~a" settings))
|
||||
(display-result (audio-encode input-file out settings
|
||||
#:encoder enc
|
||||
#:copy-tags? copy-tags?
|
||||
#:progress-callback (make-progress-callback)))))
|
||||
|
||||
(define (encoder-test-opus [input-file test-file3]
|
||||
[output-file #f]
|
||||
#:bitrate-kbps [bitrate-kbps 160]
|
||||
#:sample-rate [sample-rate 'source]
|
||||
#:copy-tags? [copy-tags? #t])
|
||||
(encoder-test input-file output-file 'opus
|
||||
(opus-settings bitrate-kbps (setting-value sample-rate))
|
||||
#:copy-tags? copy-tags?))
|
||||
|
||||
(define (encoder-test-flac [input-file test-file3]
|
||||
[output-file #f]
|
||||
#:compression-level [compression-level 8]
|
||||
#:sample-rate [sample-rate 'source]
|
||||
#:bits-per-sample [bits-per-sample 'source]
|
||||
#:copy-tags? [copy-tags? #t])
|
||||
(encoder-test input-file output-file 'flac
|
||||
(flac-settings compression-level
|
||||
(setting-value sample-rate)
|
||||
(setting-value bits-per-sample))
|
||||
#:copy-tags? copy-tags?))
|
||||
|
||||
(module+ main
|
||||
(sl-log-to-display)
|
||||
|
||||
(define encoder 'opus)
|
||||
(define input-file test-file3)
|
||||
(define output-file #f)
|
||||
(define copy-tags? #t)
|
||||
(define bitrate-kbps 160)
|
||||
(define compression-level 8)
|
||||
(define sample-rate 'source)
|
||||
(define bits-per-sample 'source)
|
||||
|
||||
(command-line
|
||||
#:program "encoder-test.rkt"
|
||||
#:once-each
|
||||
(("-e" "--encoder") e "Encoder: opus or flac. Default: opus."
|
||||
(set! encoder (encoder-symbol e)))
|
||||
(("-i" "--input") f "Input audio file. Default: tests.rkt test-file3."
|
||||
(set! input-file f))
|
||||
(("-o" "--output") f "Output audio file. Default: temp test file."
|
||||
(set! output-file f))
|
||||
(("--sample-rate") r "Target sample rate, e.g. 48000, or source. Default: source."
|
||||
(set! sample-rate (setting-value r)))
|
||||
(("--bits-per-sample") b "Target FLAC bits per sample, e.g. 16/24, or source. Default: source."
|
||||
(set! bits-per-sample (setting-value b)))
|
||||
(("--bitrate-kbps") b "Opus bitrate in kbps. Default: 160."
|
||||
(set! bitrate-kbps (or (string->number b)
|
||||
(raise-argument-error 'encoder-test "number" b))))
|
||||
(("--compression-level") n "FLAC compression level. Default: 8."
|
||||
(set! compression-level (or (string->number n)
|
||||
(raise-argument-error 'encoder-test "number" n))))
|
||||
(("--no-tags") "Do not copy tags/pictures to the output file."
|
||||
(set! copy-tags? #f))
|
||||
#:args rest
|
||||
(cond ((null? rest) (void))
|
||||
((null? (cdr rest)) (set! input-file (car rest)))
|
||||
((null? (cddr rest)) (set! input-file (car rest)) (set! output-file (cadr rest)))
|
||||
(else (raise-user-error 'encoder-test "too many positional arguments: ~a" rest))))
|
||||
|
||||
(case encoder
|
||||
((opus)
|
||||
(encoder-test-opus input-file output-file
|
||||
#:bitrate-kbps bitrate-kbps
|
||||
#:sample-rate sample-rate
|
||||
#:copy-tags? copy-tags?))
|
||||
((flac)
|
||||
(encoder-test-flac input-file output-file
|
||||
#:compression-level compression-level
|
||||
#:sample-rate sample-rate
|
||||
#:bits-per-sample bits-per-sample
|
||||
#:copy-tags? copy-tags?))
|
||||
(else (raise-argument-error 'encoder-test "opus or flac" encoder))))
|
||||
+5
-1
@@ -128,7 +128,9 @@
|
||||
(ffi-handler 'read
|
||||
(lambda (info pos buffer size)
|
||||
(if (eq? info 'done)
|
||||
(set-ffmpeg-handle-stop! handle #t)
|
||||
(begin
|
||||
(dbg-sound "ffmpeg read: ~a ~a ~a" info pos size)
|
||||
(set-ffmpeg-handle-stop! handle #t))
|
||||
(give-audio handle info pos buffer size)))
|
||||
(lambda (pcm-pos rate channels sample-bits sample-bytes pcm-length)
|
||||
(handle-format handle pcm-pos rate channels sample-bits sample-bytes pcm-length)))
|
||||
@@ -138,6 +140,7 @@
|
||||
(ffi-handler 'delete)))
|
||||
|
||||
(define (ffmpeg-seek handle percentage)
|
||||
(dbg-sound "ffmpeg-seek ~a" percentage)
|
||||
(let ((fmt (ffmpeg-handle-format handle)))
|
||||
(let ((total-samples (hash-ref fmt 'total-samples 0)))
|
||||
(unless (or
|
||||
@@ -149,6 +152,7 @@
|
||||
(set-ffmpeg-handle-seek! handle sample))))))
|
||||
|
||||
(define (ffmpeg-stop handle)
|
||||
(dbg-sound "ffmpeg-stop called")
|
||||
(set-ffmpeg-handle-stop! handle #t)
|
||||
(while (ffmpeg-handle-reading handle)
|
||||
(sleep 0.01)))
|
||||
|
||||
+770
-243
File diff suppressed because it is too large
Load Diff
+38
-2
@@ -16,7 +16,16 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (ok? r)
|
||||
(not (= r 0)))
|
||||
(> r 0))
|
||||
|
||||
(define (decode-ok? r)
|
||||
(= r 1))
|
||||
|
||||
(define (decode-eof? r)
|
||||
(= r 0))
|
||||
|
||||
(define (decode-error? r)
|
||||
(< r 0))
|
||||
|
||||
(define (filename->string filename)
|
||||
(cond
|
||||
@@ -149,10 +158,14 @@
|
||||
(reset!)
|
||||
#t))
|
||||
|
||||
#|
|
||||
(define (read cb format-cb)
|
||||
(when (= current-pcm-pos 0)
|
||||
(ffmpeg-format format-cb))
|
||||
(if (ok? (fmpg-decode-next! fh))
|
||||
(let ((dec-val (fmpg-decode-next! fh)))
|
||||
(unless (ok? dec-val)
|
||||
(err-sound "return value of fmpg-decode-next = ~a" dec-val))
|
||||
(if (ok? dec-val)
|
||||
(let-values ([(buffer size) (copy-current-buffer fh)])
|
||||
(cond
|
||||
[(or (eq? buffer #f) (<= size 0)) (read cb format-cb)]
|
||||
@@ -161,6 +174,29 @@
|
||||
(set! current-pcm-pos (fmpg-buffer-end-sample fh))
|
||||
(cb 'data pcm-pos buffer size))]))
|
||||
(cb 'done -1 #f 0))
|
||||
#t))
|
||||
|#
|
||||
(define (read cb format-cb)
|
||||
(when (= current-pcm-pos 0)
|
||||
(ffmpeg-format format-cb))
|
||||
(let ((dec-val (fmpg-decode-next! fh)))
|
||||
(cond
|
||||
[(decode-ok? dec-val)
|
||||
(let-values ([(buffer size) (copy-current-buffer fh)])
|
||||
(cond
|
||||
[(or (eq? buffer #f) (<= size 0))
|
||||
(read cb format-cb)]
|
||||
[else
|
||||
(let ((pcm-pos (fmpg-buffer-start-sample fh)))
|
||||
(set! current-pcm-pos (fmpg-buffer-end-sample fh))
|
||||
(cb 'data pcm-pos buffer size))]))]
|
||||
|
||||
[(decode-eof? dec-val)
|
||||
(cb 'done -1 #f 0)]
|
||||
|
||||
[else
|
||||
(err-sound "fmpg-decode-next failed: ~a" dec-val)
|
||||
(cb 'done -1 #f 0)]))
|
||||
#t)
|
||||
|
||||
(define (seek pcm-pos)
|
||||
|
||||
+26
-91
@@ -3,7 +3,9 @@
|
||||
(require ffi/unsafe
|
||||
"libflac-ffi.rkt"
|
||||
"flac-definitions.rkt"
|
||||
"private/utils.rkt")
|
||||
"private/utils.rkt"
|
||||
let-assert
|
||||
)
|
||||
|
||||
(provide flac-open
|
||||
flac-valid?
|
||||
@@ -26,15 +28,16 @@
|
||||
|
||||
(define (flac-open flac-file* cb-stream-info cb-audio)
|
||||
(let ((flac-file (if (path? flac-file*) (path->string flac-file*) flac-file*)))
|
||||
(if (file-exists? flac-file)
|
||||
(and (string? flac-file)
|
||||
(file-exists? flac-file)
|
||||
(let ((handler (flac-ffi-decoder-handler)))
|
||||
(handler 'new)
|
||||
(handler 'init flac-file)
|
||||
(let/assert
|
||||
((dec (handler 'new) a-!nullptr? #f)
|
||||
(ret (handler 'init flac-file) zero? (begin (handler 'delete) #f)))
|
||||
(let ((h (make-flac-handle handler)))
|
||||
(set-flac-handle-cb-stream-info! h cb-stream-info)
|
||||
(set-flac-handle-cb-audio! h cb-audio)
|
||||
h))
|
||||
#f)))
|
||||
h))))))
|
||||
|
||||
(define (flac-stream-state handle)
|
||||
((flac-handle-ffi-decoder-handler handle) 'state))
|
||||
@@ -44,84 +47,13 @@
|
||||
(define last-buffer #f)
|
||||
(define last-buf-len #f)
|
||||
|
||||
(define (endian-little? e)
|
||||
(cond [(eq? e 'little-endian) #t]
|
||||
[(eq? e 'big-endian) #f]
|
||||
[(eq? e 'native-endian) (not (system-big-endian?))]
|
||||
[else (error (format "unknown endian value: ~a" e))]))
|
||||
|
||||
#|
|
||||
(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
|
||||
(let* ([bytes (quotient bits 8)]
|
||||
[little? (endian-little? endianness)]
|
||||
[buf-size (* block-size channels bytes)]
|
||||
[mem-out (malloc buf-size 'atomic)]
|
||||
[out-pos 0])
|
||||
|
||||
(for ([k (in-range block-size)])
|
||||
(for ([channel (in-range channels)])
|
||||
(let* ([channel-ptr (ptr-ref buffer _pointer channel)]
|
||||
[sample (ptr-ref channel-ptr _int32 k)])
|
||||
|
||||
(if little?
|
||||
(for ([j (in-range bytes)])
|
||||
(ptr-set! mem-out _uint8 (+ out-pos j)
|
||||
(bitwise-and
|
||||
(arithmetic-shift sample (* -8 j))
|
||||
#xff)))
|
||||
(for ([j (in-range bytes)])
|
||||
(ptr-set! mem-out _uint8 (+ out-pos j)
|
||||
(bitwise-and
|
||||
(arithmetic-shift sample
|
||||
(* -8 (- bytes j 1)))
|
||||
#xff))))
|
||||
|
||||
(set! out-pos (+ out-pos bytes)))))
|
||||
|
||||
(list mem-out buf-size)))
|
||||
|#
|
||||
|
||||
(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
|
||||
;; buffer = FLAC__int32 * const buffer[]
|
||||
;; block-size = samples per channel
|
||||
|
||||
(let* ([bytes (quotient bits 8)]
|
||||
[big? (not (endian-little? endianness))]
|
||||
[buf-size (* block-size channels bytes)]
|
||||
[bs (make-bytes buf-size)]
|
||||
;[out (malloc buf-size 'atomic-interior)]
|
||||
[out-pos 0])
|
||||
|
||||
(for ([k (in-range block-size)])
|
||||
(for ([channel (in-range channels)])
|
||||
(let* ([chan (ptr-ref buffer _pointer channel)]
|
||||
[sample (ptr-ref chan _int32 k)])
|
||||
(integer->int-bytes sample bytes #t big? bs out-pos)
|
||||
(set! out-pos (+ out-pos bytes)))))
|
||||
|
||||
;(memcpy out bs buf-size)
|
||||
;(list out buf-size)
|
||||
(list bs buf-size)
|
||||
))
|
||||
|
||||
(define (process-frame handle frame buffer)
|
||||
(let* ([h (flac-ffi-frame-header frame)]
|
||||
[cb-audio (flac-handle-cb-audio handle)]
|
||||
(define (process-frame handle h mem-out)
|
||||
(let* ([cb-audio (flac-handle-cb-audio handle)]
|
||||
[type (hash-ref h 'number-type)]
|
||||
[channels (hash-ref h 'channels)]
|
||||
[block-size (hash-ref h 'blocksize)]
|
||||
[bits (hash-ref h 'bits-per-sample)]
|
||||
[endianness 'native-endian]
|
||||
[result (flac-channels->interleaved-buffer
|
||||
buffer block-size channels bits endianness)]
|
||||
[mem-out (car result)]
|
||||
[buf-size (cadr result)])
|
||||
[buf-size (bytes-length mem-out)])
|
||||
|
||||
(hash-set! h 'duration (flac-duration handle))
|
||||
(hash-set! h 'sample (hash-ref h 'number))
|
||||
(hash-set! h 'type 'interleaved)
|
||||
(hash-set! h 'endianness endianness)
|
||||
(hash-set! h 'bits-per-sample bits)
|
||||
|
||||
(set! last-buffer mem-out)
|
||||
(set! last-buf-len buf-size)
|
||||
@@ -186,9 +118,10 @@
|
||||
)
|
||||
(when (ffi-handler 'has-write-data?)
|
||||
(ffi-handler 'process-write-data
|
||||
(lambda (frame buffer)
|
||||
(process-frame handle frame buffer)))
|
||||
(lambda (h mem-out)
|
||||
(process-frame handle h mem-out)))
|
||||
)
|
||||
|
||||
(if (eq? st 'end-of-stream)
|
||||
(begin
|
||||
(set-flac-handle-reading! handle #f)
|
||||
@@ -220,17 +153,18 @@
|
||||
(flac-handle-stream-info handle))
|
||||
#f)))
|
||||
|
||||
|
||||
(define (flac-seek handle percentage)
|
||||
(dbg-sound "seek to percentage ~a" percentage)
|
||||
(let ((ffi-handler (flac-handle-ffi-decoder-handler handle)))
|
||||
(let ((total-samples (flac-total-samples handle)))
|
||||
(unless (eq? total-samples #f)
|
||||
(let ((sample (inexact->exact (round (* (exact->inexact (/ percentage 100.0)) total-samples)))))
|
||||
(ffi-handler 'seek-to-sample sample))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(let* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
|
||||
(total-samples (flac-total-samples handle)))
|
||||
(and total-samples
|
||||
(> total-samples 0)
|
||||
(let* ((percentage (max 0 (min 100 percentage)))
|
||||
(sample (inexact->exact
|
||||
(round (* (/ percentage 100.0) total-samples))))
|
||||
(sample (min sample (- total-samples 1))))
|
||||
(ffi-handler 'seek-to-sample sample)))))
|
||||
|
||||
|
||||
(define (flac-stop handle)
|
||||
@@ -245,4 +179,5 @@
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
); end of module
|
||||
|
||||
@@ -25,6 +25,13 @@
|
||||
flac-bits-per-sample
|
||||
flac-total-samples
|
||||
flac-duration
|
||||
|
||||
flac-encoder-handle
|
||||
make-flac-encoder-handle
|
||||
flac-encoder-handle-ffi-encoder-handler
|
||||
flac-encoder-handle-settings
|
||||
flac-encoder-handle-format
|
||||
flac-encoder-handle-file
|
||||
)
|
||||
|
||||
(define-struct flac-stream-info
|
||||
@@ -105,4 +112,12 @@
|
||||
;#:transparent
|
||||
)
|
||||
|
||||
|
||||
;; A high level FLAC encoder handle. The actual native encoder pointer
|
||||
;; remains encapsulated in the FFI command handler, matching the existing
|
||||
;; decoder-side style in this package.
|
||||
(define-struct flac-encoder-handle
|
||||
(ffi-encoder-handler settings format file)
|
||||
#:transparent)
|
||||
|
||||
); end of module
|
||||
|
||||
@@ -0,0 +1,90 @@
|
||||
(module flac-encoder racket/base
|
||||
|
||||
(require "libflac-ffi.rkt"
|
||||
"flac-definitions.rkt")
|
||||
|
||||
(provide flac-encoder-available?
|
||||
flac-encoder-default-settings
|
||||
flac-encoder-prepare-settings
|
||||
flac-encoder-open
|
||||
flac-encoder-write
|
||||
flac-encoder-finish)
|
||||
|
||||
(define (flac-encoder-available?) #t)
|
||||
|
||||
(define (copy-hash h)
|
||||
(let ((out (make-hash)))
|
||||
(for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h))
|
||||
out))
|
||||
|
||||
(define (hash-ref/default h k default)
|
||||
(if (hash-has-key? h k) (hash-ref h k) default))
|
||||
|
||||
(define (hash-merge base override)
|
||||
(let ((out (copy-hash base)))
|
||||
(when (hash? override)
|
||||
(for-each (lambda (k) (hash-set! out k (hash-ref override k))) (hash-keys override)))
|
||||
out))
|
||||
|
||||
(define (flac-encoder-default-settings)
|
||||
(make-hash '((compression-level . 5)
|
||||
(verify? . #f)
|
||||
(blocksize . 0))))
|
||||
|
||||
(define (source-value v source)
|
||||
(if (eq? v 'source) source v))
|
||||
|
||||
(define (safe-flac-bits bits)
|
||||
(cond [(and (integer? bits) (or (= bits 8) (= bits 12) (= bits 16) (= bits 20) (= bits 24))) bits]
|
||||
[(and (integer? bits) (< bits 16)) 16]
|
||||
[else 24]))
|
||||
|
||||
(define (flac-encoder-prepare-settings settings format)
|
||||
(let* ((base (flac-encoder-default-settings))
|
||||
(h (hash-merge base settings))
|
||||
;; In encoder settings, 'sample-rate means the requested output rate.
|
||||
;; 'target-sample-rate is accepted as an explicit alias for readability.
|
||||
(source-rate (hash-ref format 'sample-rate))
|
||||
(source-channels (hash-ref format 'channels))
|
||||
(source-bits (hash-ref/default format 'bits-per-sample 24))
|
||||
(rate (source-value (hash-ref/default h 'target-sample-rate
|
||||
(hash-ref/default h 'sample-rate source-rate))
|
||||
source-rate))
|
||||
(channels (source-value (hash-ref/default h 'target-channels
|
||||
(hash-ref/default h 'channels source-channels))
|
||||
source-channels))
|
||||
(bits0 (source-value (hash-ref/default h 'target-bits-per-sample
|
||||
(hash-ref/default h 'bits-per-sample source-bits))
|
||||
source-bits))
|
||||
(bits (safe-flac-bits bits0))
|
||||
(total (hash-ref/default h 'total-samples (hash-ref/default format 'total-samples #f))))
|
||||
(hash-set! h 'sample-rate rate)
|
||||
(hash-set! h 'channels channels)
|
||||
(hash-set! h 'bits-per-sample bits)
|
||||
(when (hash-has-key? h 'target-sample-rate) (hash-remove! h 'target-sample-rate))
|
||||
(when (hash-has-key? h 'target-channels) (hash-remove! h 'target-channels))
|
||||
(when (hash-has-key? h 'target-bits-per-sample) (hash-remove! h 'target-bits-per-sample))
|
||||
(when (and total (integer? total) (>= total 0)) (hash-set! h 'total-samples total))
|
||||
(unless (hash-has-key? h 'streamable-subset?) (hash-set! h 'streamable-subset? (<= bits 24)))
|
||||
h))
|
||||
|
||||
(define (flac-encoder-open output-file settings format)
|
||||
(let* ((file (if (path? output-file) (path->string output-file) output-file))
|
||||
(resolved (flac-encoder-prepare-settings settings format))
|
||||
(handler (flac-ffi-encoder-handler)))
|
||||
(handler 'new)
|
||||
(handler 'configure resolved)
|
||||
(handler 'init file)
|
||||
(make-flac-encoder-handle handler resolved format file)))
|
||||
|
||||
(define (flac-encoder-write handle buf-info buffer buf-len)
|
||||
((flac-encoder-handle-ffi-encoder-handler handle) 'write buffer buf-len buf-info))
|
||||
|
||||
(define (flac-encoder-finish handle)
|
||||
(let ((handler (flac-encoder-handle-ffi-encoder-handler handle)))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda () (handler 'finish))
|
||||
(lambda () (handler 'delete)))))
|
||||
|
||||
) ; end of module
|
||||
@@ -8,19 +8,16 @@
|
||||
|
||||
(define scribblings
|
||||
'(
|
||||
("scrbl/libao.scrbl" () (library))
|
||||
("scrbl/audio-decoder.scrbl" () (library))
|
||||
("scrbl/flac-decoder.scrbl" () (library))
|
||||
("scrbl/mp3-decoder.scrbl" () (library))
|
||||
("scrbl/audio-sniffer.scrbl" () (library))
|
||||
("scrbl/ffmpeg-ffi.scrbl" () (library))
|
||||
("scrbl/ffmpeg-decoder.scrbl" () (library))
|
||||
("scrbl/ffmpeg-c-backend.scrbl" () (library))
|
||||
)
|
||||
)
|
||||
("scrbl/racket-audio.scrbl" (multi-page) (library 0))
|
||||
))
|
||||
|
||||
(define deps
|
||||
'("racket/gui" "racket/base" "racket" "finalizer" "draw-lib" "net-lib" "simple-log" "racket-sprintf" "define-return" "let-assert")
|
||||
'("racket/gui" "racket/base" "racket"
|
||||
"finalizer" "draw-lib" "net-lib"
|
||||
"simple-log" "racket-sprintf"
|
||||
"early-return" "let-assert"
|
||||
"rackunit-lib"
|
||||
)
|
||||
)
|
||||
|
||||
(define build-deps
|
||||
|
||||
+22
-11
@@ -14,7 +14,8 @@
|
||||
racket/async-channel
|
||||
data/queue
|
||||
racket/list
|
||||
"private/utils.rkt")
|
||||
"private/utils.rkt"
|
||||
racket/place)
|
||||
|
||||
(provide ao_version_async
|
||||
ao_create_async
|
||||
@@ -33,6 +34,8 @@
|
||||
ao_sample_queue_len
|
||||
make-buffer-info
|
||||
make-BufferInfo_t
|
||||
ao-playback-buf-ms
|
||||
ao-set-playback-buf-ms!
|
||||
)
|
||||
|
||||
;; -------------------------------------------------------------------------
|
||||
@@ -194,7 +197,13 @@
|
||||
;; Playback buffer to send to libao in milliseconds
|
||||
;; -------------------------------------------------------------------------
|
||||
|
||||
(define ao-buf-ms 250) ;; Playback buffer of 0.25s
|
||||
(define ao-buf-ms 350) ;; Playback buffer of 0.35s
|
||||
|
||||
(define (ao-playback-buf-ms)
|
||||
ao-buf-ms)
|
||||
|
||||
(define (ao-set-playback-buf-ms! ms)
|
||||
(set! ao-buf-ms ms))
|
||||
|
||||
;; -------------------------------------------------------------------------
|
||||
;; Sample queue handling
|
||||
@@ -216,12 +225,13 @@
|
||||
)
|
||||
|
||||
|
||||
(define (needed-bytes h)
|
||||
(define (needed-bytes h elem-buflen)
|
||||
(let ((req-bytes (/ (ao-handle-dev-bits-per-sample h) 8))
|
||||
(rate-s (ao-handle-dev-rate h))
|
||||
(channels (ao-handle-dev-channels h))
|
||||
)
|
||||
(/ (* req-bytes rate-s channels ao-buf-ms) 1000)
|
||||
(let ((needed-for-ao (/ (* req-bytes rate-s channels ao-buf-ms) 1000)))
|
||||
(max needed-for-ao elem-buflen))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -247,7 +257,7 @@
|
||||
(begin
|
||||
(set-ao-handle-current-elem! h elem)
|
||||
(set! cb elem)
|
||||
(let* ((ns (needed-bytes h))
|
||||
(let* ((ns (needed-bytes h (queue-elem-buflen elem)))
|
||||
(new-buf (alloc-buf h ns)))
|
||||
(m-memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb))
|
||||
(reuse-buf h (queue-elem-buf cb))
|
||||
@@ -272,7 +282,7 @@
|
||||
(reuse-buf h (queue-elem-buf elem))
|
||||
(when (= (ao-handle-bytes-left h) 0)
|
||||
(async-channel-put (ao-handle-queue h) cb)
|
||||
(set-ao-handle-in-queue! h (+ ao-handle-in-queue h) 1)
|
||||
(set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1))
|
||||
(set-ao-handle-current-elem! h #f))
|
||||
)
|
||||
)
|
||||
@@ -423,8 +433,8 @@
|
||||
|
||||
|
||||
(define (planar-to-interleaved h in-buf info)
|
||||
;; mem: bytes
|
||||
;; result: (list bytes output-size)
|
||||
;; in-buf: mem
|
||||
;; result: mem
|
||||
|
||||
(let* ([in-bytes (mem-bytes in-buf)]
|
||||
[buf-size (mem-size in-buf)]
|
||||
@@ -456,7 +466,7 @@
|
||||
bytes)])
|
||||
(bytes-copy! out-bytes out-pos in-bytes in-pos (+ in-pos bytes)))))
|
||||
|
||||
out out-size)))
|
||||
out)))
|
||||
|
||||
;;; requested bits to device bits
|
||||
|
||||
@@ -503,6 +513,7 @@
|
||||
;; ASync player
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(define (run h)
|
||||
(thread
|
||||
(λ ()
|
||||
@@ -756,9 +767,9 @@
|
||||
|
||||
(let ((ao-size buf-size)
|
||||
(ao-mem au-buf))
|
||||
(let ((m (convert-req-bits-to-dev-bits h mem info)))
|
||||
(let ((m (convert-req-bits-to-dev-bits h au-buf info)))
|
||||
(when (eq? (cadr m) #t)
|
||||
(reuse-buf h mem)
|
||||
(reuse-buf h au-buf)
|
||||
(set! ao-mem (car m))
|
||||
(set! ao-size (mem-size ao-mem))))
|
||||
|
||||
|
||||
@@ -1,115 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
|
||||
(require ffi/unsafe
|
||||
ffi/unsafe/define
|
||||
"private/utils.rkt"
|
||||
;"libao-ffi.rkt"
|
||||
)
|
||||
|
||||
(provide ao_create_async
|
||||
ao_real_output_bits_async
|
||||
ao_stop_async
|
||||
ao_play_async
|
||||
ao_is_at_music_id_async
|
||||
ao_is_at_second_async
|
||||
ao_music_duration_async
|
||||
ao_bufsize_async
|
||||
ao_reuse_buf_len
|
||||
ao_clear_async
|
||||
ao_pause_async
|
||||
ao_set_volume_async
|
||||
ao_volume_async
|
||||
make-BufferInfo_t
|
||||
ao_version
|
||||
)
|
||||
|
||||
(define _BufferType_t
|
||||
(_enum '(ao = 1
|
||||
flac = 2
|
||||
mp3 = 3
|
||||
ogg = 4
|
||||
)))
|
||||
|
||||
;#define AO_FMT_LITTLE 1
|
||||
;#define AO_FMT_BIG 2
|
||||
;#define AO_FMT_NATIVE 4
|
||||
|
||||
(define _Endian_t
|
||||
(_enum '(little-endian = 1
|
||||
big-endian = 2
|
||||
native-endian = 4
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define-cstruct _BufferInfo_t
|
||||
(
|
||||
[type _BufferType_t]
|
||||
[sample_bits _int]
|
||||
[sample_rate _int]
|
||||
[channels _int]
|
||||
[endiannes _Endian_t]
|
||||
))
|
||||
|
||||
(define (ao_version)
|
||||
(let* ((v (ao_async_version))
|
||||
(patch (remainder v 256))
|
||||
(minor (remainder (quotient v 256) 256))
|
||||
(major (quotient v 65536))
|
||||
)
|
||||
(list major minor patch)))
|
||||
|
||||
|
||||
(when (eq? (system-type 'os) 'windows)
|
||||
(void (get-lib '("libao-1.2.2") '(#f))))
|
||||
|
||||
(define lib (get-lib '("ao-play-async" "libao-play-async") '(#f)))
|
||||
;(define lib (ffi-lib "/home/hans/src/racket/racket-sound-lib/lib/linux-x86_64/libao-play-async.so"))
|
||||
(define-ffi-definer define-libao-async lib
|
||||
#:default-make-fail make-not-available)
|
||||
|
||||
(define _libao-async-handle-pointer (_cpointer 'ao-async-handle))
|
||||
|
||||
;extern int ao_async_version()
|
||||
(define-libao-async ao_async_version (_fun -> _int))
|
||||
|
||||
;extern void *ao_create_async(int bits, int rate, int channel, int byte_format);
|
||||
(define-libao-async ao_create_async(_fun _int _int _int _Endian_t _string/utf-8 -> _libao-async-handle-pointer))
|
||||
|
||||
;extern int ao_real_output_bits(void *handle)
|
||||
(define-libao-async ao_real_output_bits_async
|
||||
(_fun _libao-async-handle-pointer -> _int))
|
||||
|
||||
;extern void ao_stop_async(void *handle);
|
||||
(define-libao-async ao_stop_async(_fun _libao-async-handle-pointer -> _void))
|
||||
|
||||
;extern void ao_play_async(void *handle, int music_id, double at_second, double music_duration, int buf_size, void *mem, BufferInfo_t info);
|
||||
(define-libao-async ao_play_async(_fun _libao-async-handle-pointer _int _double _double _uint32 _pointer _BufferInfo_t -> _void))
|
||||
|
||||
;extern double ao_is_at_second_async(void *handle);
|
||||
(define-libao-async ao_is_at_second_async(_fun _libao-async-handle-pointer -> _double))
|
||||
|
||||
;extern int ao_is_at_music_id_async(void *handle);
|
||||
(define-libao-async ao_is_at_music_id_async (_fun _libao-async-handle-pointer -> _int))
|
||||
|
||||
;extern double ao_music_duration_async(void *handle);
|
||||
(define-libao-async ao_music_duration_async(_fun _libao-async-handle-pointer -> _double))
|
||||
|
||||
;extern int ao_bufsize_async(void *handle);
|
||||
(define-libao-async ao_bufsize_async(_fun _libao-async-handle-pointer -> _int))
|
||||
|
||||
;extern void ao_clear_async(void *handle);
|
||||
(define-libao-async ao_clear_async(_fun _libao-async-handle-pointer -> _void))
|
||||
|
||||
;extern void ao_pause_async(void *handle, int pause);
|
||||
(define-libao-async ao_pause_async(_fun _libao-async-handle-pointer _int -> _void))
|
||||
|
||||
;extern void ao_set_volume_async(void *handle, double percentage)
|
||||
(define-libao-async ao_set_volume_async (_fun _libao-async-handle-pointer _double -> _void))
|
||||
|
||||
;extern double ao_volume_async(void *handle)
|
||||
(define-libao-async ao_volume_async (_fun _libao-async-handle-pointer -> _double))
|
||||
|
||||
(define (ao_reuse_buf_len h) -1)
|
||||
|
||||
@@ -31,8 +31,11 @@
|
||||
ao-valid-format?
|
||||
ao-handle?
|
||||
ao-supported-music-format?
|
||||
ao-playback-buf-ms
|
||||
ao-set-playback-buf-ms!
|
||||
)
|
||||
|
||||
|
||||
(define device-number 1)
|
||||
|
||||
(define-struct ao-handle (handle-num
|
||||
@@ -50,6 +53,10 @@
|
||||
)
|
||||
|
||||
|
||||
(define ao-playback-buf-ms ffi:ao-playback-buf-ms)
|
||||
(define ao-set-playback-buf-ms! ffi:ao-set-playback-buf-ms!)
|
||||
|
||||
|
||||
(define (ao-supported-music-format? f)
|
||||
(and (symbol? f)
|
||||
(or (eq? f 'flac)
|
||||
|
||||
+220
-37
@@ -6,6 +6,7 @@
|
||||
)
|
||||
|
||||
(provide flac-ffi-decoder-handler
|
||||
flac-ffi-encoder-handler
|
||||
_FLAC__StreamMetadata
|
||||
FLAC__StreamMetadata-type
|
||||
flac-ffi-meta
|
||||
@@ -108,21 +109,6 @@
|
||||
undefined
|
||||
)))
|
||||
|
||||
|
||||
;typedef enum {
|
||||
; FLAC__STREAM_DECODER_SEARCH_FOR_METADATA = 0,
|
||||
; FLAC__STREAM_DECODER_READ_METADATA,
|
||||
; FLAC__STREAM_DECODER_SEARCH_FOR_FRAME_SYNC,
|
||||
; FLAC__STREAM_DECODER_READ_FRAME,
|
||||
; FLAC__STREAM_DECODER_END_OF_STREAM,
|
||||
; FLAC__STREAM_DECODER_OGG_ERROR,
|
||||
; FLAC__STREAM_DECODER_SEEK_ERROR,
|
||||
; FLAC__STREAM_DECODER_ABORTED,
|
||||
; FLAC__STREAM_DECODER_MEMORY_ALLOCATION_ERROR,
|
||||
; FLAC__STREAM_DECODER_UNINITIALIZED,
|
||||
; FLAC__STREAM_DECODER_END_OF_LINK
|
||||
;} FLAC__StreamDecoderState;
|
||||
|
||||
(define _FLAC_StreamDecoderState
|
||||
(_enum '(search-for-metadata = 0
|
||||
read-metadata
|
||||
@@ -247,23 +233,6 @@
|
||||
;; FLAC Metadata
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;typedef struct FLAC__StreamMetadata {
|
||||
; FLAC__MetadataType type;
|
||||
; FLAC__bool is_last;
|
||||
; uint32_t length;
|
||||
; union {
|
||||
; FLAC__StreamMetadata_StreamInfo stream_info;
|
||||
; FLAC__StreamMetadata_Padding padding;
|
||||
; FLAC__StreamMetadata_Application application;
|
||||
; FLAC__StreamMetadata_SeekTable seek_table;
|
||||
; FLAC__StreamMetadata_VorbisComment vorbis_comment;
|
||||
; FLAC__StreamMetadata_CueSheet cue_sheet;
|
||||
; FLAC__StreamMetadata_Picture picture;
|
||||
; FLAC__StreamMetadata_Unknown unknown;
|
||||
; } data;
|
||||
;} FLAC__StreamMetadata;
|
||||
|
||||
|
||||
(define-cstruct _FLAC__StreamMetadata_StreamInfo
|
||||
(
|
||||
[min_blocksize _uint32_t]
|
||||
@@ -403,6 +372,7 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define _FLAC__StreamDecoder-pointer (_cpointer 'flac-streamdecoder))
|
||||
(define _FLAC__StreamEncoder-pointer (_cpointer 'flac-streamencoder))
|
||||
(define _FLAC__Data-pointer (_cpointer/null 'flac-client-data))
|
||||
;(define _FLAC__StreamMetadata-pointer (_cpointer/null 'flac-stream-metadata))
|
||||
|
||||
@@ -498,6 +468,52 @@
|
||||
;; Our interface for decoding to racket
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (endian-little? e)
|
||||
(cond [(eq? e 'little-endian) #t]
|
||||
[(eq? e 'big-endian) #f]
|
||||
[(eq? e 'native-endian) (not (system-big-endian?))]
|
||||
[else (error (format "unknown endian value: ~a" e))]))
|
||||
|
||||
(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
|
||||
;; buffer = FLAC__int32 * const buffer[]
|
||||
;; block-size = samples per channel
|
||||
|
||||
(let* ([bytes (quotient bits 8)]
|
||||
[big? (not (endian-little? endianness))]
|
||||
[buf-size (* block-size channels bytes)]
|
||||
[bs (make-bytes buf-size)]
|
||||
;[out (malloc buf-size 'atomic-interior)]
|
||||
[out-pos 0])
|
||||
|
||||
(for ([k (in-range block-size)])
|
||||
(for ([channel (in-range channels)])
|
||||
(let* ([chan (ptr-ref buffer _pointer channel)]
|
||||
[sample (ptr-ref chan _int32 k)])
|
||||
(integer->int-bytes sample bytes #t big? bs out-pos)
|
||||
(set! out-pos (+ out-pos bytes)))))
|
||||
|
||||
;(memcpy out bs buf-size)
|
||||
;(list out buf-size)
|
||||
(list bs buf-size)
|
||||
))
|
||||
|
||||
(define (copy-flac-frame frame buffer)
|
||||
(let* ((h (flac-ffi-frame-header frame))
|
||||
(channels (hash-ref h 'channels))
|
||||
(block-size (hash-ref h 'blocksize))
|
||||
(bits (hash-ref h 'bits-per-sample))
|
||||
(endianness 'native-endian)
|
||||
(result (flac-channels->interleaved-buffer
|
||||
buffer block-size channels bits endianness))
|
||||
(bs (car result))
|
||||
(buf-size (cadr result)))
|
||||
(hash-set! h 'type 'interleaved)
|
||||
(hash-set! h 'endianness endianness)
|
||||
(hash-set! h 'bits-per-sample bits)
|
||||
(hash-set! h 'sample (hash-ref h 'number))
|
||||
(cons h bs)))
|
||||
|
||||
|
||||
(define (flac-ffi-decoder-handler)
|
||||
(define write-data '())
|
||||
(define meta-data '())
|
||||
@@ -506,14 +522,21 @@
|
||||
(define flac-file #f)
|
||||
(define client-data #f)
|
||||
|
||||
;(define (write-callback fl frame buffer client-data)
|
||||
; (set! write-data (append write-data (list (cons frame buffer))))
|
||||
; 0)
|
||||
(define (write-callback fl frame buffer client-data)
|
||||
(set! write-data (append write-data (list (cons frame buffer))))
|
||||
(set! write-data (cons (copy-flac-frame frame buffer) write-data))
|
||||
0)
|
||||
|
||||
;(define (meta-callback fl meta client-data)
|
||||
; (let ((meta-clone (FLAC__metadata_object_clone meta)))
|
||||
; (unless (eq? meta-clone #f)
|
||||
; (set! meta-data (append meta-data (list meta-clone))))))
|
||||
(define (meta-callback fl meta client-data)
|
||||
(let ((meta-clone (FLAC__metadata_object_clone meta)))
|
||||
(unless (eq? meta-clone #f)
|
||||
(set! meta-data (append meta-data (list meta-clone))))))
|
||||
(set! meta-data (cons meta-clone meta-data)))))
|
||||
|
||||
(define (error-callback fl errno client-data)
|
||||
(set! error-no errno)
|
||||
@@ -557,16 +580,16 @@
|
||||
(decoder-state (int-state)))
|
||||
|
||||
(define (process-meta-data cb)
|
||||
(for-each (λ (meta-entry)
|
||||
(for-each (lambda (meta-entry)
|
||||
(cb meta-entry)
|
||||
(FLAC__metadata_object_delete meta-entry))
|
||||
meta-data)
|
||||
(reverse meta-data))
|
||||
(set! meta-data '()))
|
||||
|
||||
(define (process-write-data cb)
|
||||
(for-each (lambda (d)
|
||||
(cb (car d) (cdr d)))
|
||||
write-data)
|
||||
(reverse write-data))
|
||||
(set! write-data '()))
|
||||
|
||||
(define (buffer->vectorlist buffer channels size)
|
||||
@@ -618,4 +641,164 @@
|
||||
))
|
||||
)
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Direct FLAC encoder interface
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define FLAC__StreamEncoderInitStatus-ok 0)
|
||||
|
||||
(define _FLAC__StreamEncoderProgressCallback _pointer)
|
||||
|
||||
(define-libflac FLAC__stream_encoder_new
|
||||
(_fun -> _FLAC__StreamEncoder-pointer))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_delete
|
||||
(_fun _FLAC__StreamEncoder-pointer -> _void))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_finish
|
||||
(_fun _FLAC__StreamEncoder-pointer -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_get_state
|
||||
(_fun _FLAC__StreamEncoder-pointer -> _int))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_set_verify
|
||||
(_fun _FLAC__StreamEncoder-pointer FLAC__bool -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_set_streamable_subset
|
||||
(_fun _FLAC__StreamEncoder-pointer FLAC__bool -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_set_channels
|
||||
(_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_set_bits_per_sample
|
||||
(_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_set_sample_rate
|
||||
(_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_set_compression_level
|
||||
(_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_set_blocksize
|
||||
(_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_set_total_samples_estimate
|
||||
(_fun _FLAC__StreamEncoder-pointer FLAC__uint64 -> FLAC__bool))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_init_file
|
||||
(_fun _FLAC__StreamEncoder-pointer
|
||||
_string/utf-8
|
||||
_FLAC__StreamEncoderProgressCallback
|
||||
_FLAC__Data-pointer
|
||||
-> _int))
|
||||
|
||||
(define-libflac FLAC__stream_encoder_process_interleaved
|
||||
(_fun _FLAC__StreamEncoder-pointer _pointer _uint32_t -> FLAC__bool))
|
||||
|
||||
(define (hash-ref/default h k default)
|
||||
(if (hash-has-key? h k) (hash-ref h k) default))
|
||||
|
||||
(define (bool->flac-bool v) (if v 1 0))
|
||||
|
||||
(define (native-signed-ref bs start bytes)
|
||||
(int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
|
||||
|
||||
(define (scale-sample sample in-bits out-bits)
|
||||
(cond [(> in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
|
||||
[(< in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
|
||||
[else sample]))
|
||||
|
||||
(define (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)
|
||||
(let* ((in-bytes (quotient in-bits 8))
|
||||
(sample-count (quotient size in-bytes))
|
||||
(frame-count (quotient sample-count channels))
|
||||
(ptr (malloc _int32 sample-count 'atomic-interior)))
|
||||
(for ([i (in-range sample-count)])
|
||||
(let* ((off (* i in-bytes))
|
||||
(sample (native-signed-ref buffer off in-bytes)))
|
||||
(ptr-set! ptr _int32 i (scale-sample sample in-bits out-bits))))
|
||||
(values ptr frame-count)))
|
||||
|
||||
(define (flac-ffi-encoder-handler)
|
||||
(define enc #f)
|
||||
(define flac-file #f)
|
||||
(define settings #f)
|
||||
|
||||
(define (require-encoder who)
|
||||
(when (eq? enc #f) (error who "FLAC encoder is not initialized")))
|
||||
|
||||
(define (new)
|
||||
(if (eq? enc #f)
|
||||
(begin (set! enc (FLAC__stream_encoder_new)) enc)
|
||||
(error 'flac-ffi-encoder-handler "FLAC encoder already initialized")))
|
||||
|
||||
(define (configure h)
|
||||
(require-encoder 'flac-encoder-configure)
|
||||
(set! settings h)
|
||||
(let ((channels (hash-ref h 'channels))
|
||||
(sample-rate (hash-ref h 'sample-rate))
|
||||
(bits (hash-ref h 'bits-per-sample))
|
||||
(compression-level (hash-ref/default h 'compression-level 5))
|
||||
(verify? (hash-ref/default h 'verify? #f))
|
||||
(streamable-subset? (hash-ref/default h 'streamable-subset? (<= (hash-ref h 'bits-per-sample) 24)))
|
||||
(blocksize (hash-ref/default h 'blocksize 0))
|
||||
(total-samples (hash-ref/default h 'total-samples #f)))
|
||||
(unless (FLAC__stream_encoder_set_channels enc channels) (error 'flac-encoder-configure "could not set channels"))
|
||||
(unless (FLAC__stream_encoder_set_sample_rate enc sample-rate) (error 'flac-encoder-configure "could not set sample rate"))
|
||||
(unless (FLAC__stream_encoder_set_bits_per_sample enc bits) (error 'flac-encoder-configure "could not set bits per sample"))
|
||||
(unless (FLAC__stream_encoder_set_compression_level enc compression-level) (error 'flac-encoder-configure "could not set compression level"))
|
||||
(unless (FLAC__stream_encoder_set_verify enc (bool->flac-bool verify?)) (error 'flac-encoder-configure "could not set verify"))
|
||||
(unless (FLAC__stream_encoder_set_streamable_subset enc (bool->flac-bool streamable-subset?)) (error 'flac-encoder-configure "could not set streamable subset"))
|
||||
(when (and (integer? blocksize) (> blocksize 0))
|
||||
(unless (FLAC__stream_encoder_set_blocksize enc blocksize) (error 'flac-encoder-configure "could not set blocksize")))
|
||||
(when (and (integer? total-samples) (>= total-samples 0))
|
||||
(unless (FLAC__stream_encoder_set_total_samples_estimate enc total-samples) (error 'flac-encoder-configure "could not set total samples estimate")))
|
||||
#t))
|
||||
|
||||
(define (init file)
|
||||
(require-encoder 'flac-encoder-init)
|
||||
(let ((r (FLAC__stream_encoder_init_file enc file #f #f)))
|
||||
(set! flac-file file)
|
||||
(unless (= r FLAC__StreamEncoderInitStatus-ok)
|
||||
(error 'flac-encoder-init "FLAC encoder init failed with status ~a" r))
|
||||
#t))
|
||||
|
||||
(define (write buffer size buf-info)
|
||||
(require-encoder 'flac-encoder-write)
|
||||
(let* ((channels (hash-ref settings 'channels))
|
||||
(in-bits (hash-ref/default buf-info 'pcm-bits-per-sample
|
||||
(hash-ref/default buf-info 'bits-per-sample
|
||||
(hash-ref settings 'bits-per-sample))))
|
||||
(out-bits (hash-ref settings 'bits-per-sample)))
|
||||
(let-values (((ptr frames) (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)))
|
||||
(unless (FLAC__stream_encoder_process_interleaved enc ptr frames)
|
||||
(error 'flac-encoder-write "FLAC encoder process_interleaved failed, state ~a" (FLAC__stream_encoder_get_state enc)))
|
||||
frames)))
|
||||
|
||||
(define (finish)
|
||||
(require-encoder 'flac-encoder-finish)
|
||||
(FLAC__stream_encoder_finish enc))
|
||||
|
||||
(define (delete)
|
||||
(unless (eq? enc #f)
|
||||
(FLAC__stream_encoder_delete enc)
|
||||
(set! enc #f))
|
||||
#t)
|
||||
|
||||
(lambda (cmd . args)
|
||||
(cond [(eq? cmd 'new) (new)]
|
||||
[(eq? cmd 'configure) (configure (car args))]
|
||||
[(eq? cmd 'init) (init (car args))]
|
||||
[(eq? cmd 'write) (write (car args) (cadr args) (caddr args))]
|
||||
[(eq? cmd 'finish) (finish)]
|
||||
[(eq? cmd 'delete) (delete)]
|
||||
[(eq? cmd 'state) (and enc (FLAC__stream_encoder_get_state enc))]
|
||||
[(eq? cmd 'file) flac-file]
|
||||
[(eq? cmd 'settings) settings]
|
||||
[else (error (format "unknown FLAC encoder command ~a" cmd))])))
|
||||
|
||||
|
||||
); end of module
|
||||
|
||||
|
||||
+1
-1
@@ -405,7 +405,7 @@ int main(int argc, char *argv[])
|
||||
)
|
||||
|
||||
(define (init file)
|
||||
(let ((r (mpg123_open mh file)))
|
||||
(let ((r (mpg123_open mh (format "~a" file))))
|
||||
(unless (eq? r 'MPG123_OK)
|
||||
(error (format "mpg123_open: ~a" (mpg123_plain_strerror r))))
|
||||
)
|
||||
|
||||
@@ -1,14 +1,15 @@
|
||||
#lang racket/base
|
||||
|
||||
(require "libao.rkt"
|
||||
"audio-decoder.rkt"
|
||||
"taglib.rkt"
|
||||
(require "taglib.rkt"
|
||||
"audio-sniffer.rkt"
|
||||
"audio-player.rkt"
|
||||
"opusfile-decoder.rkt"
|
||||
)
|
||||
|
||||
(provide (all-from-out "libao.rkt")
|
||||
(all-from-out "audio-decoder.rkt")
|
||||
(all-from-out "taglib.rkt")
|
||||
(provide (all-from-out "taglib.rkt")
|
||||
(all-from-out "audio-sniffer.rkt")
|
||||
(all-from-out "audio-player.rkt")
|
||||
current-opusfile-output-format
|
||||
opusfile-output-format?
|
||||
)
|
||||
|
||||
|
||||
@@ -0,0 +1,267 @@
|
||||
(module opus-encoder racket/base
|
||||
|
||||
(require ffi/unsafe
|
||||
racket/string
|
||||
"private/utils.rkt"
|
||||
"taglib.rkt")
|
||||
|
||||
(provide opus-encoder-available?
|
||||
opus-encoder-default-settings
|
||||
opus-encoder-prepare-settings
|
||||
opus-encoder-open
|
||||
opus-encoder-write
|
||||
opus-encoder-finish)
|
||||
|
||||
;; libopusenc handles the Ogg container, OpusHead and OpusTags. The Racket
|
||||
;; side feeds interleaved floating-point PCM to ope_encoder_write_float().
|
||||
;; The input rate passed to ope_encoder_create_file is the source PCM rate;
|
||||
;; libopusenc performs the required Opus resampling internally.
|
||||
|
||||
;; Load libogg and libopus explicitly before libopusenc. This matters on
|
||||
;; Windows, where libopusenc.dll may not reliably find its dependent DLLs
|
||||
;; unless they have already been resolved through the same search path.
|
||||
(define libogg
|
||||
(get-lib (case (system-type 'os)
|
||||
[(windows) '("ogg")]
|
||||
[else '("ogg" "libogg")])
|
||||
'(#f)))
|
||||
|
||||
(define libopus
|
||||
(get-lib (case (system-type 'os)
|
||||
[(windows) '("opus")]
|
||||
[else '("opus" "libopus")])
|
||||
'(#f)))
|
||||
|
||||
(define libopusenc
|
||||
(get-lib (case (system-type 'os)
|
||||
[(windows) '("libopusenc")]
|
||||
[else '("opusenc" "libopusenc")])
|
||||
'(#f)))
|
||||
|
||||
(define _OggOpusComments (_cpointer/null 'ogg-opus-comments))
|
||||
(define _OggOpusEnc (_cpointer/null 'ogg-opus-enc))
|
||||
|
||||
(define (ffi-proc name type)
|
||||
(and libopusenc
|
||||
(with-handlers ([exn:fail? (lambda (_) #f)])
|
||||
(get-ffi-obj name libopusenc type))))
|
||||
|
||||
(define ope_comments_create (ffi-proc "ope_comments_create" (_fun -> _OggOpusComments)))
|
||||
(define ope_comments_destroy (ffi-proc "ope_comments_destroy" (_fun _OggOpusComments -> _void)))
|
||||
(define ope_comments_add (ffi-proc "ope_comments_add" (_fun _OggOpusComments _string/utf-8 _string/utf-8 -> _int)))
|
||||
(define ope_comments_add_picture_from_memory
|
||||
(ffi-proc "ope_comments_add_picture_from_memory" (_fun _OggOpusComments _bytes _size _int _string/utf-8 -> _int)))
|
||||
(define ope_encoder_create_file
|
||||
(ffi-proc "ope_encoder_create_file"
|
||||
(_fun _string/utf-8 _OggOpusComments _int32 _int _int (err : (_ptr o _int))
|
||||
-> (enc : _OggOpusEnc)
|
||||
-> (values enc err))))
|
||||
(define ope_encoder_write_float (ffi-proc "ope_encoder_write_float" (_fun _OggOpusEnc _pointer _int -> _int)))
|
||||
(define ope_encoder_drain (ffi-proc "ope_encoder_drain" (_fun _OggOpusEnc -> _int)))
|
||||
(define ope_encoder_destroy (ffi-proc "ope_encoder_destroy" (_fun _OggOpusEnc -> _void)))
|
||||
(define ope_strerror (ffi-proc "ope_strerror" (_fun _int -> _string/utf-8)))
|
||||
(define ope_encoder_ctl/int (ffi-proc "ope_encoder_ctl" (_fun #:varargs-after 2 _OggOpusEnc _int _int -> _int)))
|
||||
|
||||
(define OPUS_SET_BITRATE_REQUEST 4002)
|
||||
(define OPUS_SET_VBR_REQUEST 4006)
|
||||
(define OPUS_SET_COMPLEXITY_REQUEST 4010)
|
||||
(define OPUS_SET_VBR_CONSTRAINT_REQUEST 4020)
|
||||
(define OPUS_SET_SIGNAL_REQUEST 4024)
|
||||
(define OPUS_SET_LSB_DEPTH_REQUEST 4036)
|
||||
(define OPE_SET_COMMENT_PADDING_REQUEST 14004)
|
||||
|
||||
(define OPUS_AUTO -1000)
|
||||
(define OPUS_SIGNAL_VOICE 3001)
|
||||
(define OPUS_SIGNAL_MUSIC 3002)
|
||||
|
||||
(define (opus-encoder-available?)
|
||||
(and libogg libopus libopusenc ope_comments_create ope_comments_destroy ope_encoder_create_file
|
||||
ope_encoder_write_float ope_encoder_drain ope_encoder_destroy ope_strerror #t))
|
||||
|
||||
(define-struct opus-encoder-handle (enc comments settings format file) #:transparent)
|
||||
|
||||
(define (hash-ref/default h k default)
|
||||
(if (hash-has-key? h k) (hash-ref h k) default))
|
||||
|
||||
(define (copy-hash h)
|
||||
(let ((out (make-hash)))
|
||||
(for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h))
|
||||
out))
|
||||
|
||||
(define (hash-merge base override)
|
||||
(let ((out (copy-hash base)))
|
||||
(when (hash? override)
|
||||
(for-each (lambda (k) (hash-set! out k (hash-ref override k))) (hash-keys override)))
|
||||
out))
|
||||
|
||||
(define (opus-error-message code)
|
||||
(if ope_strerror (ope_strerror code) (format "libopusenc error ~a" code)))
|
||||
|
||||
(define (check-ope who r)
|
||||
(when (negative? r) (error who "~a" (opus-error-message r)))
|
||||
r)
|
||||
|
||||
(define (opus-encoder-default-settings)
|
||||
(make-hash '((bitrate . 160000)
|
||||
(vbr? . #t)
|
||||
(constrained-vbr? . #f)
|
||||
(complexity . 10)
|
||||
(comment-padding . 512))))
|
||||
|
||||
(define (signal->int v)
|
||||
(cond [(or (eq? v 'auto) (eq? v #f)) OPUS_AUTO]
|
||||
[(eq? v 'voice) OPUS_SIGNAL_VOICE]
|
||||
[(eq? v 'music) OPUS_SIGNAL_MUSIC]
|
||||
[else (raise-argument-error 'opus-signal "(or/c 'auto 'voice 'music)" v)]))
|
||||
|
||||
(define (source-value v source)
|
||||
(if (eq? v 'source) source v))
|
||||
|
||||
(define (opus-encoder-prepare-settings settings format)
|
||||
(let* ((h (hash-merge (opus-encoder-default-settings) settings))
|
||||
(rate (source-value (hash-ref/default h 'sample-rate (hash-ref format 'sample-rate))
|
||||
(hash-ref format 'sample-rate)))
|
||||
(channels (source-value (hash-ref/default h 'channels (hash-ref format 'channels))
|
||||
(hash-ref format 'channels))))
|
||||
;; Do not apply the low-level libopus sample-rate restriction here.
|
||||
;; libopusenc accepts the input rate and performs the required resampling
|
||||
;; internally; 44100 Hz input is therefore valid.
|
||||
(when (> channels 2)
|
||||
(error 'opus-encoder-open "this first direct libopusenc backend only supports mono/stereo input; got ~a channels" channels))
|
||||
(hash-set! h 'sample-rate rate)
|
||||
(hash-set! h 'channels channels)
|
||||
(hash-set! h 'family 0)
|
||||
h))
|
||||
|
||||
(define (apply-ctl! enc request value who)
|
||||
(when ope_encoder_ctl/int
|
||||
(check-ope who (ope_encoder_ctl/int enc request value))))
|
||||
|
||||
(define (apply-settings! enc settings)
|
||||
(apply-ctl! enc OPUS_SET_BITRATE_REQUEST (hash-ref settings 'bitrate) 'opus-bitrate)
|
||||
(apply-ctl! enc OPUS_SET_VBR_REQUEST (if (hash-ref/default settings 'vbr? #t) 1 0) 'opus-vbr)
|
||||
(apply-ctl! enc OPUS_SET_VBR_CONSTRAINT_REQUEST (if (hash-ref/default settings 'constrained-vbr? #f) 1 0) 'opus-constrained-vbr)
|
||||
(apply-ctl! enc OPUS_SET_COMPLEXITY_REQUEST (hash-ref/default settings 'complexity 10) 'opus-complexity)
|
||||
(apply-ctl! enc OPE_SET_COMMENT_PADDING_REQUEST (hash-ref/default settings 'comment-padding 512) 'opus-comment-padding)
|
||||
(when (hash-has-key? settings 'signal)
|
||||
(apply-ctl! enc OPUS_SET_SIGNAL_REQUEST (signal->int (hash-ref settings 'signal)) 'opus-signal))
|
||||
(when (hash-has-key? settings 'lsb-depth)
|
||||
(apply-ctl! enc OPUS_SET_LSB_DEPTH_REQUEST (hash-ref settings 'lsb-depth) 'opus-lsb-depth)))
|
||||
|
||||
(define (add-comments! comments settings)
|
||||
(when (hash-has-key? settings 'comments)
|
||||
(let ((ch (hash-ref settings 'comments)))
|
||||
(when (hash? ch)
|
||||
(for-each (lambda (k)
|
||||
(let ((v (hash-ref ch k)))
|
||||
(when (string? v)
|
||||
(check-ope 'opus-comment (ope_comments_add comments (string-upcase (symbol->string k)) v)))))
|
||||
(hash-keys ch))))))
|
||||
|
||||
(define (picture-kind->opus-int kind)
|
||||
(define s
|
||||
(cond [(number? kind) (number->string kind)]
|
||||
[(symbol? kind) (string-replace (string-downcase (symbol->string kind)) "-" " ")]
|
||||
[(string? kind) (string-downcase kind)]
|
||||
[else ""]))
|
||||
(cond [(or (string=? s "0") (string=? s "other")) 0]
|
||||
[(or (string=? s "1") (string=? s "file icon") (string=? s "32x32 icon")) 1]
|
||||
[(or (string=? s "2") (string=? s "other file icon")) 2]
|
||||
[(or (string=? s "3") (string=? s "front cover") (string=? s "cover front")
|
||||
(string=? s "cover (front)") (string=? s "front")) 3]
|
||||
[(or (string=? s "4") (string=? s "back cover") (string=? s "cover back")
|
||||
(string=? s "cover (back)") (string=? s "back")) 4]
|
||||
[(or (string=? s "5") (string=? s "leaflet page")) 5]
|
||||
[(or (string=? s "6") (string=? s "media") (string=? s "label side of media")) 6]
|
||||
[(or (string=? s "7") (string=? s "lead artist") (string=? s "lead performer")
|
||||
(string=? s "soloist")) 7]
|
||||
[(or (string=? s "8") (string=? s "artist") (string=? s "performer")) 8]
|
||||
[(or (string=? s "9") (string=? s "conductor")) 9]
|
||||
[(or (string=? s "10") (string=? s "band") (string=? s "orchestra")) 10]
|
||||
[(or (string=? s "11") (string=? s "composer")) 11]
|
||||
[(or (string=? s "12") (string=? s "lyricist") (string=? s "text writer")) 12]
|
||||
[(or (string=? s "13") (string=? s "recording location")) 13]
|
||||
[(or (string=? s "14") (string=? s "during recording")) 14]
|
||||
[(or (string=? s "15") (string=? s "during performance")) 15]
|
||||
[(or (string=? s "16") (string=? s "movie screen capture")) 16]
|
||||
[(or (string=? s "17") (string=? s "a bright coloured fish")
|
||||
(string=? s "bright coloured fish")) 17]
|
||||
[(or (string=? s "18") (string=? s "illustration")) 18]
|
||||
[(or (string=? s "19") (string=? s "band logo") (string=? s "artist logotype")) 19]
|
||||
[(or (string=? s "20") (string=? s "publisher logo") (string=? s "publisher logotype")) 20]
|
||||
[else 3]))
|
||||
|
||||
(define (add-picture! comments settings)
|
||||
(when (hash-has-key? settings 'picture)
|
||||
(unless ope_comments_add_picture_from_memory
|
||||
(error 'opus-picture "libopusenc does not provide ope_comments_add_picture_from_memory"))
|
||||
(let ((picture (hash-ref settings 'picture)))
|
||||
(when (id3-picture? picture)
|
||||
(let ((data (id3-picture-bytes picture)))
|
||||
(check-ope 'opus-picture
|
||||
(ope_comments_add_picture_from_memory
|
||||
comments
|
||||
data
|
||||
(bytes-length data)
|
||||
(picture-kind->opus-int (id3-picture-kind picture))
|
||||
(id3-picture-description picture))))))))
|
||||
|
||||
(define (opus-encoder-open output-file settings format)
|
||||
(unless (opus-encoder-available?)
|
||||
(error 'opus-encoder-open "libopusenc or one of its dependent libraries (ogg/opus) could not be loaded"))
|
||||
(let* ((file (if (path? output-file) (path->string output-file) output-file))
|
||||
(resolved (opus-encoder-prepare-settings settings format))
|
||||
(comments (ope_comments_create)))
|
||||
(add-comments! comments resolved)
|
||||
(add-picture! comments resolved)
|
||||
(let-values (((enc err) (ope_encoder_create_file file comments
|
||||
(hash-ref resolved 'sample-rate)
|
||||
(hash-ref resolved 'channels)
|
||||
(hash-ref resolved 'family))))
|
||||
(unless enc (error 'opus-encoder-open "could not create Opus file ~a: ~a" file (opus-error-message err)))
|
||||
(apply-settings! enc resolved)
|
||||
(make-opus-encoder-handle enc comments resolved format file))))
|
||||
|
||||
(define (native-signed-ref bs start bytes)
|
||||
;; Racket's integer-bytes->integer only supports 1, 2, 4 and 8 bytes.
|
||||
;; The FLAC decoder legitimately produces 24-bit PCM as three bytes per
|
||||
;; sample, so use the package helper that handles that case.
|
||||
(int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
|
||||
|
||||
(define (sample->float sample in-bits)
|
||||
(let* ((scale (expt 2 (sub1 in-bits)))
|
||||
(v (/ sample scale)))
|
||||
(cond [(< v -1.0) -1.0]
|
||||
[(> v 1.0) 1.0]
|
||||
[else (exact->inexact v)])))
|
||||
|
||||
(define (pcm-bytes->float-pointer buffer size in-bits)
|
||||
(let* ((in-bytes (quotient in-bits 8))
|
||||
(sample-count (quotient size in-bytes))
|
||||
(ptr (malloc _float sample-count 'atomic-interior)))
|
||||
(for ([i (in-range sample-count)])
|
||||
(let* ((in-off (* i in-bytes))
|
||||
(sample (native-signed-ref buffer in-off in-bytes)))
|
||||
(ptr-set! ptr _float i (sample->float sample in-bits))))
|
||||
(values ptr sample-count)))
|
||||
|
||||
(define (opus-encoder-write handle buf-info buffer buf-len)
|
||||
(let* ((settings (opus-encoder-handle-settings handle))
|
||||
(channels (hash-ref settings 'channels))
|
||||
(in-bits (hash-ref/default buf-info 'pcm-bits-per-sample
|
||||
(hash-ref/default buf-info 'bits-per-sample 16))))
|
||||
(let-values (((pcm sample-count) (pcm-bytes->float-pointer buffer buf-len in-bits)))
|
||||
(let ((frames (quotient sample-count channels)))
|
||||
(check-ope 'opus-encoder-write
|
||||
(ope_encoder_write_float (opus-encoder-handle-enc handle) pcm frames))
|
||||
frames))))
|
||||
|
||||
(define (opus-encoder-finish handle)
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda () (check-ope 'opus-encoder-finish (ope_encoder_drain (opus-encoder-handle-enc handle))))
|
||||
(lambda ()
|
||||
(ope_encoder_destroy (opus-encoder-handle-enc handle))
|
||||
(ope_comments_destroy (opus-encoder-handle-comments handle)))))
|
||||
|
||||
) ; end of module
|
||||
@@ -0,0 +1,316 @@
|
||||
(module opusfile-decoder racket/base
|
||||
|
||||
(require ffi/unsafe
|
||||
"private/utils.rkt")
|
||||
|
||||
(provide opusfile-open
|
||||
opusfile-valid?
|
||||
opusfile-read
|
||||
opusfile-stop
|
||||
opusfile-seek
|
||||
opusfile-available?
|
||||
current-opusfile-output-format
|
||||
opusfile-output-format?)
|
||||
|
||||
;; Xiph libopusfile backend for Ogg Opus streams.
|
||||
;;
|
||||
;; By default this backend uses op_read(), which returns signed 16-bit
|
||||
;; interleaved PCM. That is the most efficient path for direct libao
|
||||
;; playback. For users who prefer the wider decoder output path, set
|
||||
;; current-opusfile-output-format to 's24. In that mode the backend uses
|
||||
;; op_read_float() and converts the interleaved float output to packed signed
|
||||
;; 24-bit PCM in native byte order.
|
||||
;;
|
||||
;; Opus decode output is always 48 kHz PCM. The original input rate, if
|
||||
;; present in metadata, is not the actual decoder output rate.
|
||||
|
||||
|
||||
(define libogg (get-lib (case (system-type 'os)
|
||||
[(windows) '("ogg")]
|
||||
[else '("ogg" "libogg")])
|
||||
'(#f)))
|
||||
|
||||
(define libopus (get-lib (case (system-type 'os)
|
||||
[(windows) '("opus")]
|
||||
[else '("opus" "libopus")])
|
||||
'(#f)))
|
||||
|
||||
(define libopusfile (get-lib (case (system-type 'os)
|
||||
[(windows) '("opusfile")]
|
||||
[else '("opusfile" "libopusfile")])
|
||||
'(#f)))
|
||||
|
||||
(define _OggOpusFile _pointer)
|
||||
|
||||
(define default-frames-per-read 4096)
|
||||
(define opus-sample-rate 48000)
|
||||
|
||||
(define (opusfile-output-format? v)
|
||||
(or (eq? v 's16) (eq? v 's24)))
|
||||
|
||||
(define cur-output-format 's16)
|
||||
|
||||
(define (current-opusfile-output-format . args)
|
||||
(unless (null? args)
|
||||
(if (or (> (length args) 1)
|
||||
(not (opusfile-output-format? (car args))))
|
||||
(raise-argument-error 'current-opusfile-output-format
|
||||
"(or/c 's16 's24)")
|
||||
(set! cur-output-format (car args))))
|
||||
cur-output-format)
|
||||
|
||||
(define (opus-bits-per-sample)
|
||||
(case (current-opusfile-output-format)
|
||||
[(s16) 16]
|
||||
[(s24) 24]))
|
||||
|
||||
(define (opus-bytes-per-sample)
|
||||
(case (current-opusfile-output-format)
|
||||
[(s16) 2]
|
||||
[(s24) 3]))
|
||||
|
||||
(define (ffi-proc name type)
|
||||
(and libopusfile
|
||||
(with-handlers ([exn:fail? (lambda (_) #f)])
|
||||
(get-ffi-obj name libopusfile type))))
|
||||
|
||||
(define op_open_file
|
||||
(ffi-proc "op_open_file"
|
||||
(_fun _path (err : (_ptr o _int))
|
||||
-> (r : _OggOpusFile)
|
||||
-> (values r err))))
|
||||
|
||||
(define op_free
|
||||
(ffi-proc "op_free"
|
||||
(_fun _OggOpusFile -> _void)))
|
||||
|
||||
(define op_channel_count
|
||||
(ffi-proc "op_channel_count"
|
||||
(_fun _OggOpusFile _int -> _int)))
|
||||
|
||||
(define op_pcm_total
|
||||
(ffi-proc "op_pcm_total"
|
||||
(_fun _OggOpusFile _int -> _int64)))
|
||||
|
||||
(define op_pcm_seek
|
||||
(ffi-proc "op_pcm_seek"
|
||||
(_fun _OggOpusFile _int64 -> _int)))
|
||||
|
||||
(define op_read
|
||||
(ffi-proc "op_read"
|
||||
(_fun _OggOpusFile _bytes _int (li : (_ptr o _int))
|
||||
-> (r : _int)
|
||||
-> (values r li))))
|
||||
|
||||
(define op_read_float
|
||||
(ffi-proc "op_read_float"
|
||||
(_fun _OggOpusFile _pointer _int (li : (_ptr o _int))
|
||||
-> (r : _int)
|
||||
-> (values r li))))
|
||||
|
||||
(define (opusfile-available?)
|
||||
(and libopusfile
|
||||
op_open_file
|
||||
op_free
|
||||
op_channel_count
|
||||
op_pcm_total
|
||||
op_pcm_seek
|
||||
op_read
|
||||
op_read_float
|
||||
#t))
|
||||
|
||||
(define-struct opusfile-handle
|
||||
(of cb-info cb-audio
|
||||
(stop #:mutable)
|
||||
(seek #:mutable)
|
||||
(reading #:mutable)
|
||||
(format #:mutable)
|
||||
(pcm-pos #:mutable))
|
||||
#:transparent)
|
||||
|
||||
(define (raise-opus who fmt . args)
|
||||
(apply error who fmt args))
|
||||
|
||||
(define (check-libopusfile who)
|
||||
(unless (opusfile-available?)
|
||||
(raise-opus who "libopusfile could not be loaded")))
|
||||
|
||||
(define (correct-format-hash h)
|
||||
(unless (hash-ref h 'sample-rate #f)
|
||||
(hash-set! h 'sample-rate opus-sample-rate))
|
||||
(unless (hash-ref h 'bits-per-sample #f)
|
||||
(hash-set! h 'bits-per-sample (opus-bits-per-sample)))
|
||||
(unless (hash-ref h 'bytes-per-sample #f)
|
||||
(hash-set! h 'bytes-per-sample (opus-bytes-per-sample)))
|
||||
(unless (hash-ref h 'sample-format #f)
|
||||
(hash-set! h 'sample-format (current-opusfile-output-format)))
|
||||
(unless (hash-ref h 'total-samples #f)
|
||||
(hash-set! h 'total-samples 0)
|
||||
(hash-set! h 'duration 0)))
|
||||
|
||||
(define (report-format handle)
|
||||
(let ((cb (opusfile-handle-cb-info handle)))
|
||||
(when (procedure? cb)
|
||||
(cb (opusfile-handle-format handle)))))
|
||||
|
||||
(define (make-format channels total-samples)
|
||||
(let ((h (make-hash)))
|
||||
(hash-set! h 'duration (if (and (integer? total-samples) (>= total-samples 0))
|
||||
(exact->inexact (/ total-samples opus-sample-rate))
|
||||
0.0))
|
||||
(hash-set! h 'sample-rate opus-sample-rate)
|
||||
(hash-set! h 'channels channels)
|
||||
(hash-set! h 'bits-per-sample (opus-bits-per-sample))
|
||||
(hash-set! h 'bytes-per-sample (opus-bytes-per-sample))
|
||||
(hash-set! h 'sample-format (current-opusfile-output-format))
|
||||
(hash-set! h 'total-samples total-samples)
|
||||
h))
|
||||
|
||||
(define (give-audio handle buffer size)
|
||||
(let ((h (opusfile-handle-format handle)))
|
||||
(correct-format-hash h)
|
||||
(hash-set! h 'sample (opusfile-handle-pcm-pos handle))
|
||||
(hash-set! h 'current-time (exact->inexact (/ (opusfile-handle-pcm-pos handle)
|
||||
opus-sample-rate)))
|
||||
((opusfile-handle-cb-audio handle) h buffer size)))
|
||||
|
||||
(define s24-pos-scale #x7FFFFF)
|
||||
(define s24-neg-scale #x800000)
|
||||
|
||||
(define (clip-sample x)
|
||||
(cond [(< x -1.0) -1.0]
|
||||
[(> x 1.0) 1.0]
|
||||
[else x]))
|
||||
|
||||
(define (float->s24 x)
|
||||
(let ((y (clip-sample x)))
|
||||
(if (negative? y)
|
||||
(inexact->exact (round (* y s24-neg-scale)))
|
||||
(inexact->exact (round (* y s24-pos-scale))))))
|
||||
|
||||
(define (write-s24-native! bs offset sample)
|
||||
(let ((v (if (negative? sample) (+ sample #x1000000) sample)))
|
||||
(if (system-big-endian?)
|
||||
(begin
|
||||
(bytes-set! bs offset (bitwise-and (arithmetic-shift v -16) #xFF))
|
||||
(bytes-set! bs (+ offset 1) (bitwise-and (arithmetic-shift v -8) #xFF))
|
||||
(bytes-set! bs (+ offset 2) (bitwise-and v #xFF)))
|
||||
(begin
|
||||
(bytes-set! bs offset (bitwise-and v #xFF))
|
||||
(bytes-set! bs (+ offset 1) (bitwise-and (arithmetic-shift v -8) #xFF))
|
||||
(bytes-set! bs (+ offset 2) (bitwise-and (arithmetic-shift v -16) #xFF))))))
|
||||
|
||||
(define (opusfile-valid? audio-file)
|
||||
(and (opusfile-available?)
|
||||
(file-exists? audio-file)
|
||||
#t))
|
||||
|
||||
(define (opusfile-open audio-file* cb-stream-info cb-audio)
|
||||
(check-libopusfile 'opusfile-open)
|
||||
(let ((audio-file (if (path? audio-file*)
|
||||
(path->string audio-file*)
|
||||
audio-file*)))
|
||||
(if (file-exists? audio-file)
|
||||
(let-values (((of err) (op_open_file audio-file)))
|
||||
(if of
|
||||
(let* ((channels (op_channel_count of -1))
|
||||
(total-samples (op_pcm_total of -1))
|
||||
(fmt (make-format channels total-samples))
|
||||
(h (make-opusfile-handle of cb-stream-info cb-audio #f #f #f fmt 0)))
|
||||
(report-format h)
|
||||
h)
|
||||
(raise-opus 'opusfile-open
|
||||
"could not open Opus file ~a; opusfile error code: ~a"
|
||||
audio-file err)))
|
||||
#f)))
|
||||
|
||||
(define (handle-pending-seek! handle)
|
||||
(unless (eq? (opusfile-handle-seek handle) #f)
|
||||
(let ((sample (opusfile-handle-seek handle)))
|
||||
(dbg-sound "Seeking opusfile to sample ~a" sample)
|
||||
(let ((r (op_pcm_seek (opusfile-handle-of handle) sample)))
|
||||
(when (negative? r)
|
||||
(err-sound "opusfile seek error: ~a" r))
|
||||
(when (not (negative? r))
|
||||
(set-opusfile-handle-pcm-pos! handle sample)))
|
||||
(set-opusfile-handle-seek! handle #f))))
|
||||
|
||||
(define (read-s16 handle channels)
|
||||
(let* ((max-samples (* default-frames-per-read channels))
|
||||
(buffer (make-bytes (* max-samples 2))))
|
||||
(let-values (((read-frames link-index)
|
||||
(op_read (opusfile-handle-of handle) buffer max-samples)))
|
||||
(cond [(negative? read-frames)
|
||||
(values read-frames #f 0)]
|
||||
[(zero? read-frames)
|
||||
(values 0 #f 0)]
|
||||
[else
|
||||
(let* ((read-samples (* read-frames channels))
|
||||
(read-bytes (* read-samples 2))
|
||||
(out (if (= read-bytes (bytes-length buffer)) buffer (subbytes buffer 0 read-bytes))))
|
||||
(values read-frames out read-bytes))]))))
|
||||
|
||||
(define (read-s24 handle channels)
|
||||
(let* ((max-samples (* default-frames-per-read channels))
|
||||
(float-buffer (malloc _float max-samples 'atomic-interior)))
|
||||
(let-values (((read-frames link-index)
|
||||
(op_read_float (opusfile-handle-of handle) float-buffer max-samples)))
|
||||
(cond [(negative? read-frames)
|
||||
(values read-frames #f 0)]
|
||||
[(zero? read-frames)
|
||||
(values 0 #f 0)]
|
||||
[else
|
||||
(let* ((read-samples (* read-frames channels))
|
||||
(out (make-bytes (* read-samples 3))))
|
||||
(for ([i (in-range read-samples)])
|
||||
(write-s24-native! out (* i 3) (float->s24 (ptr-ref float-buffer _float i))))
|
||||
(values read-frames out (bytes-length out)))]))))
|
||||
|
||||
(define (read-audio-buffer handle channels)
|
||||
(case (current-opusfile-output-format)
|
||||
[(s16) (read-s16 handle channels)]
|
||||
[(s24) (read-s24 handle channels)]))
|
||||
|
||||
(define (opusfile-read handle)
|
||||
(set-opusfile-handle-stop! handle #f)
|
||||
(set-opusfile-handle-reading! handle #t)
|
||||
(let loop ()
|
||||
(cond
|
||||
[(opusfile-handle-stop handle)
|
||||
(dbg-sound "Stopping opusfile decoding")
|
||||
(set-opusfile-handle-reading! handle #f)
|
||||
'stopped-reading]
|
||||
[else
|
||||
(handle-pending-seek! handle)
|
||||
(let ((channels (hash-ref (opusfile-handle-format handle) 'channels 2)))
|
||||
(let-values (((read-frames out read-bytes) (read-audio-buffer handle channels)))
|
||||
(cond [(negative? read-frames)
|
||||
(err-sound "opusfile decode error: ~a" read-frames)
|
||||
(set-opusfile-handle-stop! handle #t)
|
||||
(loop)]
|
||||
[(zero? read-frames)
|
||||
(set-opusfile-handle-stop! handle #t)
|
||||
(loop)]
|
||||
[else
|
||||
(give-audio handle out read-bytes)
|
||||
(set-opusfile-handle-pcm-pos! handle (+ (opusfile-handle-pcm-pos handle) read-frames))
|
||||
(loop)])))]))
|
||||
(op_free (opusfile-handle-of handle))
|
||||
(set-opusfile-handle-reading! handle #f))
|
||||
|
||||
(define (opusfile-seek handle percentage)
|
||||
(let* ((fmt (opusfile-handle-format handle))
|
||||
(total-samples (hash-ref fmt 'total-samples 0)))
|
||||
(unless (or (eq? total-samples #f) (= total-samples -1) (= total-samples 0))
|
||||
(let* ((percentage (max 0 (min 100 percentage)))
|
||||
(sample (inexact->exact
|
||||
(round (* (exact->inexact (/ percentage 100.0))
|
||||
total-samples)))))
|
||||
(set-opusfile-handle-seek! handle sample)))))
|
||||
|
||||
(define (opusfile-stop handle)
|
||||
(set-opusfile-handle-stop! handle #t)
|
||||
(while (opusfile-handle-reading handle)
|
||||
(sleep 0.01)))
|
||||
|
||||
) ; end of module
|
||||
+67
-157
@@ -1,174 +1,84 @@
|
||||
#lang racket/base
|
||||
(require "libao.rkt"
|
||||
"audio-decoder.rkt"
|
||||
(require "audio-player.rkt"
|
||||
simple-log
|
||||
"private/utils.rkt"
|
||||
racket-sprintf
|
||||
racket/runtime-path
|
||||
;data/queue
|
||||
;racket-sound
|
||||
racket/path
|
||||
early-return
|
||||
"tests.rkt"
|
||||
)
|
||||
|
||||
(define-runtime-path tests "../racket-audio-test")
|
||||
(define place-mode #t)
|
||||
|
||||
(define test-file3 #f)
|
||||
(define test-file4 #f)
|
||||
(define test-file3-id 3)
|
||||
(define test-file4-id 4)
|
||||
(define run-queue #f)
|
||||
(define (set-test a)
|
||||
(set! run-queue a))
|
||||
|
||||
(set! test-file3 (build-path tests "mahler-1.mp3"))
|
||||
(set! test-file4 (build-path tests "mahler-2.mp3"))
|
||||
(define play-queue (list test-file2 test-file3 test-file4))
|
||||
|
||||
;(define fmt (ao-mk-format 24 48000 2 'big-endian))
|
||||
;(define ao-h (ao-open-live #f fmt))
|
||||
(define current-sec -1)
|
||||
|
||||
(define current-seconds 0)
|
||||
(define ao-h #f)
|
||||
(define current-file-id -1)
|
||||
(define current-audio-h #f)
|
||||
(define (to-time-str s*)
|
||||
(let* ((s (round s*))
|
||||
(minutes (quotient s 60))
|
||||
(seconds (remainder s 60))
|
||||
)
|
||||
(sprintf "%02d:%02d" minutes seconds)))
|
||||
|
||||
(define current-bits -1)
|
||||
(define current-rate -1)
|
||||
(define current-channels -1)
|
||||
(define (audio-player-state h s st)
|
||||
(early-return
|
||||
((? (not (audio-play? h)) => 'done))
|
||||
(let* ((f (audio-file h))
|
||||
(name (if (eq? f #f) "none" (file-name-from-path f)))
|
||||
(sec* (audio-at-second h))
|
||||
(sec (if (eq? sec* #f) 0 (round sec*)))
|
||||
(msg (hash-ref st 'msg "none"))
|
||||
(bs (hash-ref st 'buf-size 0))
|
||||
(dur* (audio-duration h))
|
||||
(dur (if (eq? dur* #f) 0 (round dur*)))
|
||||
)
|
||||
(unless (= current-sec sec)
|
||||
(displayln (format "~a (~a): ~a - ~a - ~a - ~a - ~a - ~a"
|
||||
name
|
||||
(audio-music-id h)
|
||||
(to-time-str sec)
|
||||
(to-time-str dur)
|
||||
(audio-state h)
|
||||
(audio-volume h)
|
||||
bs
|
||||
msg))
|
||||
(set! current-sec sec)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define (audio-player-eof h)
|
||||
(dbg-sound "audio-player-eof called")
|
||||
(when (eq? run-queue 'queue)
|
||||
(if (null? play-queue)
|
||||
(audio-quit! h)
|
||||
(begin
|
||||
(dbg-sound "audio-play! -> ~a" (audio-play! h (car play-queue)))
|
||||
(set! play-queue (cdr play-queue))
|
||||
)
|
||||
))
|
||||
(when (eq? run-queue 'once)
|
||||
(set! run-queue #f)
|
||||
(dbg-sound "audio-play! -> ~a" (audio-play! h (car play-queue))))
|
||||
)
|
||||
|
||||
(displayln "Making audio player")
|
||||
|
||||
(define h (make-audio-player audio-player-state
|
||||
audio-player-eof
|
||||
#:use-place place-mode))
|
||||
|
||||
(displayln "done")
|
||||
|
||||
(sl-log-to-display)
|
||||
(define wav-output-file #f)
|
||||
(define seeked #f)
|
||||
(audio-player-eof h)
|
||||
|
||||
(define (audio-play type ao-type handle buf-info buffer buf-len)
|
||||
;(dbg-sound "~a ~a ~a ~a ~a" type ao-type handle buf-info buf-len)
|
||||
(let* ((sample (hash-ref buf-info 'sample))
|
||||
(rate (hash-ref buf-info 'sample-rate))
|
||||
(second (/ (* sample 1.0) (* rate 1.0)))
|
||||
(bits-per-sample (hash-ref buf-info 'bits-per-sample))
|
||||
(bytes-per-sample (/ bits-per-sample 8))
|
||||
(channels (hash-ref buf-info 'channels))
|
||||
(bytes-per-sample-all-channels (* channels bytes-per-sample))
|
||||
(duration (hash-ref buf-info 'duration))
|
||||
(cond-seek (λ ()
|
||||
(when (>= (round current-seconds) 10)
|
||||
(when (and (= current-file-id 3) (not seeked))
|
||||
(set! seeked #t)
|
||||
(let ((perc (exact->inexact (* (/ (- duration 15) duration) 100.0))))
|
||||
(info-sound "Seeking to ~a%" perc)
|
||||
(audio-seek current-audio-h perc))))))
|
||||
(cond-volume (λ ()
|
||||
(when (= (round current-seconds) 20)
|
||||
(ao-set-volume! ao-h 70.0))
|
||||
(when (= (round current-seconds) 25)
|
||||
(ao-set-volume! ao-h 30))
|
||||
(when (= (round current-seconds) 30)
|
||||
(ao-set-volume! ao-h 100))
|
||||
(when (= (round current-seconds) 35)
|
||||
(ao-set-volume! ao-h 150))
|
||||
(when (= (round current-seconds) 40)
|
||||
(ao-set-volume! ao-h 100))))
|
||||
)
|
||||
|
||||
(when (not (eq? ao-h #f))
|
||||
(when (not (and
|
||||
(= current-bits bits-per-sample)
|
||||
(= current-rate rate)
|
||||
(= current-channels channels)))
|
||||
(ao-close ao-h)
|
||||
(set! ao-h #f)))
|
||||
|
||||
;(displayln buf-info)
|
||||
(when (eq? ao-h #f)
|
||||
|
||||
(info-sound "Opening ao handle")
|
||||
(info-sound "bits-per-sample: ~a" bits-per-sample)
|
||||
(info-sound "rate : ~a" rate)
|
||||
(info-sound "channels : ~a" channels)
|
||||
(info-sound "endian : ~a" 'native-endian)
|
||||
(info-sound "(optional) file: ~a" wav-output-file)
|
||||
(sync-log-sound)
|
||||
|
||||
(set! ao-h (ao-open-file bits-per-sample rate channels 'native-endian wav-output-file))
|
||||
|
||||
(set! current-bits bits-per-sample)
|
||||
(set! current-rate rate)
|
||||
(set! current-channels channels)
|
||||
(info-sound "ao bits per sample: ~a" (ao-device-bits ao-h))
|
||||
(sync-log-sound)
|
||||
)
|
||||
|
||||
;(displayln 'ao-play)
|
||||
;(dbg-sound "Playing audio at ~a" second)
|
||||
;(sync-log-sound)
|
||||
|
||||
(ao-play ao-h current-file-id second duration buffer buf-len ao-type)
|
||||
(set! duration (inexact->exact (round duration)))
|
||||
;(displayln 'done)
|
||||
(let ((second-printer (λ (buf-seconds)
|
||||
(let ((s (inexact->exact (round (ao-at-second ao-h)))))
|
||||
(unless (= s current-seconds)
|
||||
(set! current-seconds s)
|
||||
(let ((minutes (quotient s 60))
|
||||
(seconds (remainder s 60))
|
||||
(tminutes (quotient duration 60))
|
||||
(tseconds (remainder duration 60))
|
||||
(volume (ao-volume ao-h))
|
||||
)
|
||||
(info-sound
|
||||
(sprintf "At time: %02d:%02d (%02d:%02d) - %d - volume: %d"
|
||||
minutes seconds
|
||||
tminutes tseconds
|
||||
buf-seconds
|
||||
volume
|
||||
))))))))
|
||||
(let* ((buf-size (ao-bufsize-async ao-h))
|
||||
(buf-seconds (exact->inexact (/ buf-size bytes-per-sample-all-channels rate))))
|
||||
(second-printer buf-seconds)
|
||||
(cond-seek)
|
||||
(cond-volume)
|
||||
(when (> buf-seconds 10)
|
||||
(info-sound "Reuse buf/Sample queue: ~a/~a"
|
||||
(ao-reuse-buf-len-async ao-h)
|
||||
(ao-sample-queue-len-async ao-h))
|
||||
(letrec ((waiter (λ ()
|
||||
(let ((buf-seconds-left (exact->inexact
|
||||
(/ (ao-bufsize-async ao-h)
|
||||
bytes-per-sample-all-channels
|
||||
rate))))
|
||||
(if (< buf-seconds-left 3.0)
|
||||
(info-sound "Seconds in buffer left: ~a" buf-seconds-left)
|
||||
(begin
|
||||
(sleep 0.5)
|
||||
(second-printer buf-seconds)
|
||||
(cond-volume)
|
||||
(cond-seek)
|
||||
(waiter)))))
|
||||
))
|
||||
(waiter)
|
||||
(info-sound "Reuse buf/Sample queue: ~a/~a"
|
||||
(ao-reuse-buf-len-async ao-h)
|
||||
(ao-sample-queue-len-async ao-h))
|
||||
)))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define (audio-meta type ao-type handle meta)
|
||||
(dbg-sound "type: ~a" type)
|
||||
(dbg-sound "ao-type: ~a" ao-type)
|
||||
(dbg-sound "meta: ~a" meta))
|
||||
|
||||
(define (play)
|
||||
(set! ao-h #f)
|
||||
(let ((audio-h (audio-open test-file3 audio-meta audio-play)))
|
||||
(set! current-file-id test-file3-id)
|
||||
(set! current-audio-h audio-h)
|
||||
(audio-read audio-h)
|
||||
)
|
||||
(info-sound "Opening next file: ~a" test-file4)
|
||||
(let ((audio-h (audio-open test-file4 audio-meta audio-play)))
|
||||
(set! current-file-id test-file4-id)
|
||||
(set! current-audio-h audio-h)
|
||||
(audio-read audio-h)
|
||||
)
|
||||
(ao-close ao-h)
|
||||
(set! ao-h #f))
|
||||
|
||||
(play)
|
||||
|
||||
|
||||
@@ -9,6 +9,7 @@
|
||||
racket/system
|
||||
racket/string
|
||||
file/unzip
|
||||
early-return
|
||||
)
|
||||
|
||||
(provide download-soundlibs
|
||||
@@ -91,7 +92,9 @@
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (soundlibs-available?)
|
||||
(define/return (soundlibs-available?) return
|
||||
(unless (eq? (system-type 'os) 'windows) ; We only need to download libraries for windows.
|
||||
(return #t))
|
||||
(if (file-exists? version-file)
|
||||
(with-handlers ([exn:fail? (λ (e) #f)])
|
||||
(let ((v (file->value version-file)))
|
||||
|
||||
@@ -0,0 +1,187 @@
|
||||
(module pcm-converter racket/base
|
||||
|
||||
(require ffi/unsafe
|
||||
"utils.rkt"
|
||||
"../ffmpeg-definitions.rkt")
|
||||
|
||||
(provide pcm-conversion-needed?
|
||||
make-pcm-converter
|
||||
pcm-converter?
|
||||
pcm-converter-input-format
|
||||
pcm-converter-output-format
|
||||
pcm-converter-convert
|
||||
pcm-converter-drain
|
||||
pcm-converter-close!)
|
||||
|
||||
(define S32-BYTES 4)
|
||||
|
||||
(define-struct pcm-converter (swr-ctx in-layout out-layout input-format output-format channels in-rate out-rate closed?)
|
||||
#:mutable
|
||||
#:constructor-name make-raw-pcm-converter)
|
||||
|
||||
(define (hash-ref/default h k default)
|
||||
(if (and (hash? h) (hash-has-key? h k)) (hash-ref h k) default))
|
||||
|
||||
(define (copy-hash h)
|
||||
(let ((out (make-hash)))
|
||||
(when (hash? h)
|
||||
(for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h)))
|
||||
out))
|
||||
|
||||
(define (native-signed-ref bs start bytes)
|
||||
(int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
|
||||
|
||||
(define (native-signed-set! bs start bytes value)
|
||||
(integer->integer-bytes value bytes #t (system-big-endian?) bs start))
|
||||
|
||||
(define (clamp-s32 v)
|
||||
(cond [(< v -2147483648) -2147483648]
|
||||
[(> v 2147483647) 2147483647]
|
||||
[else v]))
|
||||
|
||||
(define (expand-sample-to-s32 sample in-bits)
|
||||
(clamp-s32 (if (< in-bits 32) (arithmetic-shift sample (- 32 in-bits)) sample)))
|
||||
|
||||
(define (pcm-bytes->s32-bytes buffer size in-bits)
|
||||
(cond [(= in-bits 32) (if (= size (bytes-length buffer)) buffer (subbytes buffer 0 size))]
|
||||
[else
|
||||
(let* ((in-bytes (quotient in-bits 8))
|
||||
(sample-count (quotient size in-bytes))
|
||||
(out (make-bytes (* sample-count S32-BYTES))))
|
||||
(for ([i (in-range sample-count)])
|
||||
(let* ((in-off (* i in-bytes))
|
||||
(out-off (* i S32-BYTES))
|
||||
(sample (native-signed-ref buffer in-off in-bytes)))
|
||||
(native-signed-set! out out-off S32-BYTES (expand-sample-to-s32 sample in-bits))))
|
||||
out)]))
|
||||
|
||||
(define (bytes->native bs size)
|
||||
(let ((p (malloc size 'atomic-interior)))
|
||||
(memcpy p 0 bs 0 size)
|
||||
p))
|
||||
|
||||
(define (native->bytes p size)
|
||||
(let ((bs (make-bytes size)))
|
||||
(memcpy bs 0 p 0 size)
|
||||
bs))
|
||||
|
||||
(define (make-plane ptr)
|
||||
(let ((planes (malloc _pointer 1 'atomic-interior)))
|
||||
(ptr-set! planes _pointer 0 ptr)
|
||||
planes))
|
||||
|
||||
(define (source-value v source)
|
||||
(if (eq? v 'source) source v))
|
||||
|
||||
(define (target-sample-rate settings input-format)
|
||||
(source-value
|
||||
(hash-ref/default settings 'target-sample-rate
|
||||
(hash-ref/default settings 'sample-rate
|
||||
(hash-ref input-format 'sample-rate)))
|
||||
(hash-ref input-format 'sample-rate)))
|
||||
|
||||
(define (target-channels settings input-format)
|
||||
(source-value
|
||||
(hash-ref/default settings 'target-channels
|
||||
(hash-ref/default settings 'channels
|
||||
(hash-ref input-format 'channels)))
|
||||
(hash-ref input-format 'channels)))
|
||||
|
||||
(define (target-bits settings input-format)
|
||||
(let ((source-bits (let ((bits (hash-ref/default input-format 'bits-per-sample 24)))
|
||||
(if (and (integer? bits) (<= bits 24)) bits 24))))
|
||||
(source-value
|
||||
(hash-ref/default settings 'target-bits-per-sample
|
||||
(hash-ref/default settings 'bits-per-sample source-bits))
|
||||
source-bits)))
|
||||
|
||||
(define (make-output-format input-format settings)
|
||||
(let* ((out (copy-hash input-format))
|
||||
(in-rate (hash-ref input-format 'sample-rate))
|
||||
(out-rate (target-sample-rate settings input-format))
|
||||
(total (hash-ref/default input-format 'total-samples #f)))
|
||||
(hash-set! out 'sample-rate out-rate)
|
||||
(hash-set! out 'channels (target-channels settings input-format))
|
||||
(hash-set! out 'bits-per-sample (target-bits settings input-format))
|
||||
(hash-set! out 'pcm-bits-per-sample 32)
|
||||
(hash-set! out 'type 'interleaved)
|
||||
(hash-set! out 'endianness 'native-endian)
|
||||
(when (and (integer? total) (>= total 0) (integer? in-rate) (> in-rate 0))
|
||||
(hash-set! out 'total-samples (inexact->exact (round (* total (/ out-rate in-rate))))))
|
||||
out))
|
||||
|
||||
(define (pcm-conversion-needed? input-format settings)
|
||||
(let ((in-rate (hash-ref input-format 'sample-rate))
|
||||
(in-channels (hash-ref input-format 'channels))
|
||||
(out-rate (target-sample-rate settings input-format))
|
||||
(out-channels (target-channels settings input-format)))
|
||||
(or (not (= in-rate out-rate))
|
||||
(not (= in-channels out-channels)))))
|
||||
|
||||
(define (make-pcm-converter input-format settings)
|
||||
(let* ((channels-in (hash-ref input-format 'channels))
|
||||
(channels-out (target-channels settings input-format))
|
||||
(rate-in (hash-ref input-format 'sample-rate))
|
||||
(rate-out (target-sample-rate settings input-format))
|
||||
(in-layout (ffmpeg-make-default-channel-layout channels-in))
|
||||
(out-layout (ffmpeg-make-default-channel-layout channels-out)))
|
||||
(let-values (((ret ctx) (swr_alloc_set_opts2 #f
|
||||
out-layout AV_SAMPLE_FMT_S32 rate-out
|
||||
in-layout AV_SAMPLE_FMT_S32 rate-in
|
||||
0 #f)))
|
||||
(when (< ret 0) (error 'make-pcm-converter "swr_alloc_set_opts2 failed: ~a" ret))
|
||||
(let ((ret-init (swr_init ctx)))
|
||||
(when (< ret-init 0) (error 'make-pcm-converter "swr_init failed: ~a" ret-init))
|
||||
(make-raw-pcm-converter ctx in-layout out-layout input-format (make-output-format input-format settings)
|
||||
channels-out rate-in rate-out #f)))))
|
||||
|
||||
(define (ensure-open! c who)
|
||||
(when (or (not (pcm-converter? c)) (pcm-converter-closed? c))
|
||||
(error who "PCM converter is closed")))
|
||||
|
||||
(define (convert* c in-bytes in-samples)
|
||||
(let* ((channels (pcm-converter-channels c))
|
||||
(max-out-samples (swr_get_out_samples (pcm-converter-swr-ctx c) in-samples)))
|
||||
(cond [(<= max-out-samples 0) (values #"" 0)]
|
||||
[else
|
||||
(let* ((out-size (* max-out-samples channels S32-BYTES))
|
||||
(out-ptr (malloc out-size 'atomic-interior))
|
||||
(out-planes (make-plane out-ptr))
|
||||
(in-ptr (and in-bytes (bytes->native in-bytes (bytes-length in-bytes))))
|
||||
(in-planes (and in-ptr (make-plane in-ptr)))
|
||||
(out-samples (swr_convert (pcm-converter-swr-ctx c) out-planes max-out-samples in-planes in-samples)))
|
||||
(when (< out-samples 0) (error 'pcm-converter-convert "swr_convert failed: ~a" out-samples))
|
||||
(values (native->bytes out-ptr (* out-samples channels S32-BYTES)) out-samples))])))
|
||||
|
||||
(define (pcm-converter-convert c buffer size buf-info)
|
||||
(ensure-open! c 'pcm-converter-convert)
|
||||
(let* ((in-bits (hash-ref/default buf-info 'bits-per-sample (hash-ref (pcm-converter-input-format c) 'bits-per-sample)))
|
||||
(in-bytes (quotient in-bits 8))
|
||||
(in-channels (hash-ref (pcm-converter-input-format c) 'channels))
|
||||
(in-samples (quotient (quotient size in-bytes) in-channels))
|
||||
(s32 (pcm-bytes->s32-bytes buffer size in-bits)))
|
||||
(convert* c s32 in-samples)))
|
||||
|
||||
(define (pcm-converter-drain c)
|
||||
(ensure-open! c 'pcm-converter-drain)
|
||||
(let* ((ctx (pcm-converter-swr-ctx c))
|
||||
(delay (swr_get_delay ctx (pcm-converter-out-rate c)))
|
||||
(channels (pcm-converter-channels c)))
|
||||
(cond [(<= delay 0) (values #"" 0)]
|
||||
[else
|
||||
(let* ((out-size (* delay channels S32-BYTES))
|
||||
(out-ptr (malloc out-size 'atomic-interior))
|
||||
(out-planes (make-plane out-ptr))
|
||||
(out-samples (swr_convert ctx out-planes delay #f 0)))
|
||||
(when (< out-samples 0) (error 'pcm-converter-drain "swr_convert drain failed: ~a" out-samples))
|
||||
(values (native->bytes out-ptr (* out-samples channels S32-BYTES)) out-samples))])))
|
||||
|
||||
(define (pcm-converter-close! c)
|
||||
(when (and (pcm-converter? c) (not (pcm-converter-closed? c)))
|
||||
(set-pcm-converter-swr-ctx! c (swr_free (pcm-converter-swr-ctx c)))
|
||||
(ffmpeg-channel-layout-uninit! (pcm-converter-in-layout c))
|
||||
(ffmpeg-channel-layout-uninit! (pcm-converter-out-layout c))
|
||||
(set-pcm-converter-closed?! c #t))
|
||||
#t)
|
||||
|
||||
) ; end of module
|
||||
@@ -22,6 +22,10 @@
|
||||
integer->int-bytes
|
||||
int-bytes->integer
|
||||
valid-ffmpeg-versions
|
||||
make-mutex
|
||||
mutex-lock
|
||||
mutex-unlock
|
||||
with-mutex
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -30,6 +34,57 @@
|
||||
|
||||
(sl-def-log racket-sound sound)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Mutex definitions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-struct mutex
|
||||
(thread count mut own) #:mutable)
|
||||
|
||||
(define make-mutex-struct make-mutex)
|
||||
|
||||
(set! make-mutex (λ ()
|
||||
(make-mutex-struct #f 0 (make-semaphore 1) (make-semaphore 1))))
|
||||
|
||||
(define (mutex-lock m)
|
||||
(semaphore-wait (mutex-own m))
|
||||
(if (eq? (mutex-thread m) (current-thread))
|
||||
(begin
|
||||
(set-mutex-count! m (+ (mutex-count m) 1))
|
||||
(semaphore-post (mutex-own m))
|
||||
)
|
||||
(begin
|
||||
(semaphore-post (mutex-own m))
|
||||
(semaphore-wait (mutex-mut m))
|
||||
(set-mutex-count! m 1)
|
||||
(set-mutex-thread! m (current-thread)))
|
||||
)
|
||||
)
|
||||
|
||||
(define (mutex-unlock m)
|
||||
(semaphore-wait (mutex-own m))
|
||||
(let ((count (mutex-count m)))
|
||||
(set! count (- count 1))
|
||||
(set-mutex-count! m count)
|
||||
(if (= count 0)
|
||||
(begin
|
||||
(set-mutex-thread! m #f)
|
||||
(semaphore-post (mutex-own m))
|
||||
(semaphore-post (mutex-mut m)))
|
||||
(semaphore-post (mutex-own m)))
|
||||
)
|
||||
)
|
||||
|
||||
(define-syntax with-mutex
|
||||
(syntax-rules ()
|
||||
((_ m b1 ...)
|
||||
(begin
|
||||
(dynamic-wind
|
||||
(λ () (mutex-lock m))
|
||||
(λ () b1 ...)
|
||||
(λ () (mutex-unlock m)))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provide some loop constructions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -157,8 +212,10 @@
|
||||
(cons (soundlibs-directory) p)))
|
||||
|
||||
(define (get-lib* libs-to-try orig-libs versions)
|
||||
|
||||
(unless (soundlibs-available?)
|
||||
(download-soundlibs))
|
||||
|
||||
(let ((libs-path (build-lib-path (get-lib-search-dirs))))
|
||||
(if (null? libs-to-try)
|
||||
(begin
|
||||
|
||||
@@ -67,7 +67,7 @@ available to @racket[audio-open].
|
||||
This procedure is the extension point for custom audio decoders.
|
||||
}
|
||||
|
||||
@section{Audio handles}
|
||||
@section[#:tag "audio-decoder-audio-handles"]{Audio handles}
|
||||
|
||||
@defproc[(audio-handle? [v any/c]) boolean?]{
|
||||
|
||||
|
||||
@@ -0,0 +1,230 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
racket/contract
|
||||
racket/path
|
||||
"../audio-encoder.rkt"))
|
||||
|
||||
@title{Audio Encoding}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@defmodule[racket-audio/audio-encoder]
|
||||
|
||||
The @racketmodname[racket-audio/audio-encoder] module provides the high level
|
||||
file-to-file encoding pipeline. It reuses the existing decoder environment to
|
||||
read the input file and sends the decoded PCM stream to a selected encoder
|
||||
backend. The built-in backends are Opus, implemented with @tt{libopusenc}, and
|
||||
FLAC, implemented with @tt{libFLAC}.
|
||||
|
||||
This module is intended as the public encoding API. The concrete backend
|
||||
modules are small FFI backends; applications normally call @racket[audio-encode]
|
||||
instead of using those modules directly.
|
||||
|
||||
@section{Pipeline}
|
||||
|
||||
Encoding is organised as a streaming pipeline:
|
||||
|
||||
@racketblock[
|
||||
input file
|
||||
;; decoded by audio-decoder.rkt
|
||||
-> PCM buffers
|
||||
;; optional conversion for FLAC
|
||||
-> encoder backend
|
||||
-> output file]
|
||||
|
||||
The encoder is selected from @racket[#:encoder] or, when that argument is not
|
||||
provided, from the output filename extension. The initial built-in encoders are
|
||||
@racket['opus] for @filepath{.opus} and @filepath{.oga} files, and
|
||||
@racket['flac] for @filepath{.flac} files.
|
||||
|
||||
The PCM stream is not collected in memory. Each decoded buffer is forwarded to
|
||||
the selected backend. FLAC encoding may insert a PCM conversion step when the
|
||||
settings request a different sample rate, channel count, or bit depth. Opus
|
||||
encoding feeds floating-point PCM to @tt{libopusenc}; sample-rate conversion for
|
||||
Opus is left to @tt{libopusenc}.
|
||||
|
||||
@section{Encoding a file}
|
||||
|
||||
@defproc[(audio-encode [input-file path-string?]
|
||||
[output-file path-string?]
|
||||
[settings hash?]
|
||||
[#:encoder encoder (or/c symbol? #f) #f]
|
||||
[#:copy-tags? copy-tags? boolean? #t]
|
||||
[#:progress-callback progress-callback
|
||||
(or/c procedure? #f) #f])
|
||||
hash?]{
|
||||
Encodes @racket[input-file] to @racket[output-file] and returns a result hash.
|
||||
The @racket[settings] hash is interpreted by the selected backend.
|
||||
|
||||
When @racket[encoder] is @racket[#f], the backend is inferred from the output
|
||||
file extension. Pass @racket['opus] or @racket['flac] to force a backend.
|
||||
|
||||
When @racket[copy-tags?] is true, common textual tags and an embedded picture
|
||||
are copied from the source file to the destination file. Opus comments and
|
||||
cover art are written before encoding starts through @tt{libopusenc}. FLAC
|
||||
metadata is copied after the encoded file has been written, using the
|
||||
read-write API from @racketmodname[racket-audio/taglib].
|
||||
|
||||
When @racket[progress-callback] is a procedure, it is called with a progress
|
||||
hash during encoding. Progress is based on the number of input frames read from
|
||||
the decoder, not on the number of frames written by the encoder. This matters
|
||||
for resampling, because output frame counts can differ from input frame counts.}
|
||||
|
||||
@racketblock[
|
||||
(audio-encode "input.flac"
|
||||
"output.opus"
|
||||
(hash 'bitrate 224000
|
||||
'vbr? #t
|
||||
'complexity 10)
|
||||
#:encoder 'opus)
|
||||
|
||||
(audio-encode "input-96k.flac"
|
||||
"output-48k.flac"
|
||||
(hash 'sample-rate 48000
|
||||
'bits-per-sample 24
|
||||
'compression-level 8)
|
||||
#:encoder 'flac)]
|
||||
|
||||
@section{Result hash}
|
||||
|
||||
The result hash contains the following keys:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket['encoder], the selected backend symbol;}
|
||||
@item{@racket['input] and @racket['output], the source and destination paths;}
|
||||
@item{@racket['input-format], the final decoded input format hash seen by the
|
||||
pipeline;}
|
||||
@item{@racket['output-format], the resolved backend output format hash;}
|
||||
@item{@racket['frames-read], the number of input frames consumed;}
|
||||
@item{@racket['frames-written], the number of frames accepted by the backend;}
|
||||
@item{@racket['tag-copy], a hash describing how metadata was handled.}]
|
||||
|
||||
The @racket['tag-copy] hash contains a @racket['method] key. For Opus the
|
||||
method is @racket['libopusenc-comments], because metadata must be supplied to
|
||||
@tt{libopusenc} before the encoder writes the OpusTags packet. For FLAC the
|
||||
method is @racket['taglib-post-copy], because the encoded file is tagged after
|
||||
encoding.
|
||||
|
||||
@section{Progress callback}
|
||||
|
||||
The progress callback receives a hash with at least these keys:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket['phase], such as @racket['format], @racket['audio],
|
||||
@racket['finished-encoding], or @racket['finished];}
|
||||
@item{@racket['frames-read] and @racket['frames-written];}
|
||||
@item{@racket['total-frames], when the decoder reported a known input length;}
|
||||
@item{@racket['progress], a number between @racket[0.0] and @racket[1.0] when
|
||||
@racket['total-frames] is known, otherwise @racket[#f];}
|
||||
@item{@racket['input-format] and, after the backend has opened,
|
||||
@racket['output-format].}]
|
||||
|
||||
A simple command-line style progress callback can print a percentage on one
|
||||
line:
|
||||
|
||||
@racketblock[
|
||||
(define (show-progress h)
|
||||
(let ((p (hash-ref h 'progress #f)))
|
||||
(when (number? p)
|
||||
(printf "\rprogress: ~a%" (round (* 100 p)))
|
||||
(flush-output))))]
|
||||
|
||||
@section{Opus settings}
|
||||
|
||||
The Opus backend uses @tt{libopusenc}. The input PCM is converted to interleaved
|
||||
floating-point samples in the range @racket[-1.0] to @racket[1.0] and written
|
||||
with @tt{ope_encoder_write_float}. The source sample rate is passed to
|
||||
@tt{libopusenc}; @tt{libopusenc} performs the required internal resampling for
|
||||
Opus output.
|
||||
|
||||
The following settings are recognised:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket['bitrate], bitrate in bits per second. The default is
|
||||
@racket[160000].}
|
||||
@item{@racket['vbr?], whether variable bitrate is enabled. The default is
|
||||
@racket[#t].}
|
||||
@item{@racket['constrained-vbr?], whether constrained VBR is enabled. The
|
||||
default is @racket[#f].}
|
||||
@item{@racket['complexity], encoder complexity. The default is @racket[10].}
|
||||
@item{@racket['comment-padding], Opus comment padding in bytes. The default
|
||||
is @racket[512].}
|
||||
@item{@racket['signal], optionally @racket['auto], @racket['voice], or
|
||||
@racket['music].}
|
||||
@item{@racket['lsb-depth], optionally passed to the encoder as the source
|
||||
least significant bit depth.}
|
||||
@item{@racket['comments], an optional hash of Opus comment strings. When
|
||||
@racket[#:copy-tags?] is true, @racket[audio-encode] fills this from the
|
||||
source tags.}
|
||||
@item{@racket['picture], an optional picture value from @racketmodname[racket-audio/taglib].
|
||||
When @racket[#:copy-tags?] is true, @racket[audio-encode] fills this
|
||||
from the source tags.}]
|
||||
|
||||
The first backend version supports mono and stereo input.
|
||||
|
||||
@section{FLAC settings}
|
||||
|
||||
The FLAC backend uses the @tt{libFLAC} stream encoder. It writes interleaved
|
||||
integer PCM samples through the FLAC encoder API. When the requested output
|
||||
format differs from the decoded input format, @racketmodname[racket-audio/private/pcm-converter]
|
||||
uses the existing FFmpeg @tt{swresample} layer from
|
||||
@racketmodname[racket-audio/ffmpeg-definitions] to perform PCM normalisation.
|
||||
|
||||
The following settings are recognised:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket['compression-level], FLAC compression level. The default is
|
||||
@racket[5].}
|
||||
@item{@racket['verify?], whether the FLAC encoder verifies encoded output. The
|
||||
default is @racket[#f].}
|
||||
@item{@racket['blocksize], explicit FLAC block size. The default is
|
||||
@racket[0], meaning the library default.}
|
||||
@item{@racket['sample-rate] or @racket['target-sample-rate], target sample rate
|
||||
in Hz. Use @racket['source] or omit the key to keep the source rate.}
|
||||
@item{@racket['channels] or @racket['target-channels], target channel count.
|
||||
Use @racket['source] or omit the key to keep the source channel count.}
|
||||
@item{@racket['bits-per-sample] or @racket['target-bits-per-sample], target
|
||||
bit depth. Use @racket['source] or omit the key to keep the source bit
|
||||
depth.}]
|
||||
|
||||
For example, a 24-bit 96 kHz FLAC file can be transcoded to 24-bit 48 kHz FLAC
|
||||
with:
|
||||
|
||||
@racketblock[
|
||||
(audio-encode "input-96k.flac"
|
||||
"output-48k.flac"
|
||||
(hash 'sample-rate 48000
|
||||
'bits-per-sample 24
|
||||
'compression-level 8)
|
||||
#:encoder 'flac)]
|
||||
|
||||
@section{Encoder registration}
|
||||
|
||||
@defproc[(audio-supported-encoder-extensions) (listof string?)]{
|
||||
Returns the extensions supported by the currently registered encoders. The
|
||||
initial list includes @racket["flac"], @racket["opus"], and @racket["oga"].}
|
||||
|
||||
@defproc[(make-audio-encoder [exts (listof string?)]
|
||||
[open procedure?]
|
||||
[write procedure?]
|
||||
[finish procedure?]
|
||||
[settings procedure?])
|
||||
audio-encoder?]{
|
||||
Creates an encoder descriptor. The descriptor is used by
|
||||
@racket[audio-register-encoder!] to register a backend.
|
||||
|
||||
The @racket[open] procedure receives the output file, settings hash, and input
|
||||
format hash. The @racket[write] procedure receives the backend handle, buffer
|
||||
format hash, byte buffer, and byte length, and returns the number of frames
|
||||
accepted by the backend. The @racket[finish] procedure finalises and releases
|
||||
the backend handle. The @racket[settings] procedure resolves backend defaults
|
||||
against the input format and returns the output format hash.}
|
||||
|
||||
@defproc[(audio-encoder? [v any/c]) boolean?]{
|
||||
Returns @racket[#t] when @racket[v] is an encoder descriptor.}
|
||||
|
||||
@defproc[(audio-register-encoder! [type symbol?]
|
||||
[encoder audio-encoder?])
|
||||
void?]{
|
||||
Registers @racket[encoder] under @racket[type]. The encoder's extensions are
|
||||
used for extension-based selection in @racket[audio-encode].}
|
||||
@@ -0,0 +1,292 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require racket/runtime-path
|
||||
(for-label racket/base
|
||||
racket/contract
|
||||
racket/place
|
||||
racket/async-channel
|
||||
"../audio-placed-player.rkt"
|
||||
"../audio-player.rkt"))
|
||||
|
||||
@(define-runtime-path placed-player-state-model-svg
|
||||
"placed-player-state-model.svg")
|
||||
@(define-runtime-path placed-player-worker-detail-model-svg
|
||||
"placed-player-worker-detail-model.svg")
|
||||
|
||||
@title{Placed Audio Player}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
|
||||
@defmodule[racket-audio/audio-placed-player]
|
||||
|
||||
The @racketmodname[racket-audio/audio-placed-player] module contains the worker side
|
||||
of the audio player. It is normally started by
|
||||
@racket[make-audio-player] from @racketmodname[racket-audio/audio-player], and user
|
||||
code should normally use that module's higher level procedures, such as
|
||||
@racket[audio-play!], @racket[audio-pause!], @racket[audio-stop!],
|
||||
@racket[audio-quit!], @racket[audio-seek!], and @racket[audio-volume!].
|
||||
|
||||
The placed player is implemented as a command loop around a decoder, an
|
||||
asynchronous libao output handle, and a small amount of state that is reported
|
||||
back to the controlling side. In normal use it runs in a Racket place, so that
|
||||
the audio side has a separate Racket VM. The same function can also run in a
|
||||
normal Racket thread with async channels. That mode is useful for debugging,
|
||||
because the player then stays in the same process and can be inspected more
|
||||
easily.
|
||||
|
||||
It is normally run in a separate place so that audio decoding and feeding are
|
||||
isolated from scheduling delays in the main Racket VM, such as GUI activity,
|
||||
debugging, or interaction with DrRacket.
|
||||
|
||||
@section{Interface}
|
||||
|
||||
@defproc[(placed-player [ch-in (or/c place-channel? async-channel?)]) void?]{
|
||||
Runs the placed-player command loop on @racket[ch-in]. The channel may be a
|
||||
place channel or an async channel. The command loop receives list commands,
|
||||
initializes its reply and event channels, and then processes playback commands
|
||||
until it receives @racket['quit].
|
||||
|
||||
The function is designed to be started either by @racket[dynamic-place] or by
|
||||
@racket[thread]. In place mode, all three channels are place channels. In
|
||||
thread mode, all three channels are async channels. The implementation detects
|
||||
the kind of channel and uses @racket[place-channel-put],
|
||||
@racket[place-channel-get], @racket[async-channel-put], or
|
||||
@racket[async-channel-get] as appropriate.}
|
||||
|
||||
The public wrapper in @racketmodname[racket-audio/audio-player] creates the channels,
|
||||
sends the initial @racket['init] command, starts an event thread, and exposes a
|
||||
contracted API. The placed player itself only exports @racket[placed-player].
|
||||
|
||||
@section{Overall state model}
|
||||
|
||||
The logical player state is deliberately small. The stored value of
|
||||
@racket[player-state] is one of @racket['stopped], @racket['playing], or
|
||||
@racket['paused]. The state diagram below also shows protocol states around
|
||||
initialization and termination.
|
||||
|
||||
@(image placed-player-state-model-svg)
|
||||
|
||||
The important command-level behaviour is:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket['init] installs the reply and event channels and moves the
|
||||
player into the initialized command loop.}
|
||||
@item{@racket['open] starts a decoder and a read worker. If another worker is
|
||||
still feeding audio, it is first interrupted and joined. Returns
|
||||
a @tt{music id} for the given file.}
|
||||
@item{@racket['pause] only changes @racket[player-state]. The worker observes
|
||||
that state and applies @racket[ao-pause] to the output side.}
|
||||
@item{@racket['seek] clears the async output queue and seeks the decoder, but
|
||||
does not change the logical player state.}
|
||||
@item{@racket['stop] performs cleanup and returns to @racket['stopped].}
|
||||
@item{@racket['quit] performs cleanup, emits a final forced state event, sends
|
||||
the @racket['quit] reply, and exits the command loop.}]
|
||||
|
||||
A @racket['quit] command is part of the valid protocol after initialization. A
|
||||
@racket['quit] before @racket['init] is not a normal use case: cleanup emits
|
||||
state information through the event channel, and that channel has not yet been
|
||||
installed.
|
||||
|
||||
@section{Command protocol}
|
||||
|
||||
The controlling side sends commands as lists on @racket[ch-in]. The result of
|
||||
an RPC-style command is sent on the reply channel installed by
|
||||
@racket['init]. Asynchronous events are sent on the event channel.
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket[(list 'init ch-out ch-evt)] installs @racket[ch-out] and
|
||||
@racket[ch-evt], and replies with @racket['(initialized)].}
|
||||
@item{@racket[(list 'open file)] opens @racket[file], starts the decoder
|
||||
worker, and replies with @racket[(list ok music-id)], where
|
||||
@tt{music-id} is the given music id to the file to play.}
|
||||
@item{@racket[(list 'pause paused?)] sets @racket[player-state] to
|
||||
@racket['paused] or @racket['playing] when the player is already active,
|
||||
and replies with @racket['(ok)].}
|
||||
@item{@racket[(list 'paused)] replies with a one-element list containing a
|
||||
boolean.}
|
||||
@item{@racket[(list 'seek percentage)] clears the output queue, seeks the
|
||||
decoder if present, and replies with @racket['(ok)].}
|
||||
@item{@racket[(list 'volume percentage)] stores a requested volume percentage,
|
||||
and replies with @racket['(ok)]. The worker applies the change when it
|
||||
next feeds audio.}
|
||||
@item{@racket[(list 'get-volume)] replies with the current volume in a
|
||||
one-element list.}
|
||||
@item{@racket[(list 'buf-seconds min max)] configures the output buffering
|
||||
range. The values are clamped by the placed player.}
|
||||
@item{@racket[(list 'stop)] calls the cleanup path, returns to
|
||||
@racket['stopped], and replies with @racket['(ok)].}
|
||||
@item{@racket[(list 'state)] builds a forced state snapshot and replies with
|
||||
the state event payload.}
|
||||
@item{@racket[(list 'quit)] calls the cleanup path, emits a final state event,
|
||||
replies with @racket['(quit)], and terminates the loop.}]
|
||||
|
||||
Unknown commands are caught inside the initialized loop and receive an
|
||||
@racket['error] reply. Exceptions during an RPC command are reported both as an
|
||||
@racket['exception] event and, when possible, as an @racket['error] reply for
|
||||
the current RPC.
|
||||
|
||||
@section{Worker and decoder lifecycle}
|
||||
|
||||
Opening a file creates a decoder with @racket[audio-open]. The decoder is
|
||||
called with two callbacks: one for metadata and one for audio buffers. Metadata
|
||||
is stored for later state reporting. Audio buffers are passed to the libao
|
||||
asynchronous player by @racket[ao-play].
|
||||
|
||||
The decoder is read by a Racket thread created by @racket[audio-read-worker].
|
||||
That thread is separate from the command loop, even when the whole placed player
|
||||
is already running inside a Racket place. This lets the command loop continue
|
||||
to receive commands while decoding and output buffering are active.
|
||||
|
||||
@(image placed-player-worker-detail-model-svg)
|
||||
|
||||
The most important internal flags are:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket[feeding-audio] records that a worker is still active. The
|
||||
command loop uses it when replacing the current file.}
|
||||
@item{@racket[feed-interrupted] tells the worker that its current read was
|
||||
intentionally aborted by @racket['open], @racket['stop], or cleanup.}
|
||||
@item{@racket[current-file-id] identifies the latest file. A worker that is
|
||||
draining old audio may clean itself up, but only the current worker may
|
||||
move the global state to @racket['stopped].}
|
||||
@item{@racket[play-thread] is the Racket thread that runs the decoder read.}
|
||||
@item{@racket[ao-h] is the asynchronous output handle. Access is protected by
|
||||
@racket[ao-mutex] and by the local @racket[with-ao-h] form.}]
|
||||
|
||||
When @racket[audio-read] returns normally, the worker emits an
|
||||
@racket['audio-done] event and then waits for the asynchronous output queue to
|
||||
finish playing. This is necessary because the decoder may be done while libao
|
||||
still has queued PCM samples. If the queue becomes empty and the worker still
|
||||
belongs to the current file id, the worker changes @racket[player-state] to
|
||||
@racket['stopped] and emits a state update.
|
||||
|
||||
If a new file is opened while a worker is still feeding audio, the command loop
|
||||
sets @racket[feed-interrupted], clears the output queue, stops the decoder, and
|
||||
waits for the worker to finish before starting the next decoder. This prevents
|
||||
old decoder data and new decoder data from being mixed in the output queue.
|
||||
|
||||
@section{Audio output and buffering}
|
||||
|
||||
The @racket[audio-play] callback is called by the decoder for each decoded audio
|
||||
buffer. It updates the current decoder buffer information, opens or reopens the
|
||||
libao output handle when the sample format changes, applies pending volume
|
||||
changes, queues the buffer, and publishes state updates when the playback second
|
||||
changes.
|
||||
|
||||
The player keeps a minimum and maximum buffer target. When the asynchronous
|
||||
output queue grows above the configured maximum, the callback waits until the
|
||||
queue drops below the configured minimum. During that wait it still observes
|
||||
pause changes and continues to publish coarse-grained position updates.
|
||||
|
||||
A format change requires special care. If the sample width, rate, or channel
|
||||
count changes, the existing output queue must drain before the output handle is
|
||||
closed and reopened with the new format. The code waits for the buffer to
|
||||
become empty before closing the old handle.
|
||||
|
||||
@section{Pause, seek, and volume}
|
||||
|
||||
Pause is represented only as logical player state. The command loop changes
|
||||
@racket[player-state], and the worker checks that state while feeding or
|
||||
waiting. When the state is @racket['paused], the worker calls
|
||||
@racket[ao-pause] with @racket[#t] and waits until the state changes. When the
|
||||
state changes away from @racket['paused], it calls @racket[ao-pause] with
|
||||
@racket[#f].
|
||||
|
||||
Seek does not change @racket[player-state]. It clears the output queue and
|
||||
asks the decoder to seek to the given percentage. If the player was playing, it
|
||||
continues as playing. If it was paused, it remains paused.
|
||||
|
||||
Volume changes are staged in @racket[req-volume]. The audio callback compares
|
||||
@racket[req-volume] with @racket[current-volume] and applies the change to the
|
||||
output handle when audio is being processed.
|
||||
|
||||
@section{State snapshots and events}
|
||||
|
||||
The placed player has two outgoing channels after initialization:
|
||||
@racket[ch-out] for synchronous RPC replies, and @racket[ch-evt] for
|
||||
asynchronous events. The high-level wrapper in @racketmodname["audio-player.rkt"]
|
||||
uses a separate event thread to consume @racket[ch-evt], cache the latest state
|
||||
hash in the audio-player handle, and call the user-supplied callbacks.
|
||||
|
||||
State snapshots are built by the internal @racket[state] procedure. The hash
|
||||
contains operational information such as:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket['state], @racket['msg], @racket['file], and
|
||||
@racket['valid-ao-handle];}
|
||||
@item{@racket['duration], @racket['at-second], and @racket['at-music-id];}
|
||||
@item{@racket['volume], @racket['buf-size], @racket['sample-queue-len], and
|
||||
@racket['reuse-buf-len];}
|
||||
@item{@racket['bits], @racket['rate], @racket['channels],
|
||||
@racket['decoder], @racket['decoder-meta], and
|
||||
@racket['decoder-buf-info].}]
|
||||
|
||||
Most state events are suppressed until there is a valid music id. Forced state
|
||||
snapshots bypass that suppression. Forced snapshots are used for the explicit
|
||||
@racket['state] command and for cleanup paths such as @racket['stop] and
|
||||
@racket['quit].
|
||||
|
||||
The asynchronous event stream currently uses these event shapes:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racket[(list 'state hash)] for state updates;}
|
||||
@item{@racket['(audio-done)] when the decoder has finished reading the current
|
||||
stream;}
|
||||
@item{@racket[(list 'exception message)] when the worker or command loop
|
||||
reports an exception.}]
|
||||
|
||||
@section{Stop, cleanup, and quit}
|
||||
|
||||
@racket[stop-and-cleanup] is shared by @racket['stop] and @racket['quit]. It
|
||||
marks the feed as interrupted, clears the output queue, moves the logical state
|
||||
to @racket['stopped], stops the decoder when present, waits for the play thread,
|
||||
closes the output handle, resets the internal bookkeeping fields, and emits a
|
||||
forced state event.
|
||||
|
||||
The difference between @racket['stop] and @racket['quit] is what happens after
|
||||
cleanup. @racket['stop] replies with @racket['(ok)] and continues the command
|
||||
loop. @racket['quit] emits an additional forced state event with the message
|
||||
@racket["quit"], replies with @racket['(quit)], and returns from the loop. The
|
||||
place or thread then terminates.
|
||||
|
||||
@section{Running in a place or in a thread}
|
||||
|
||||
The normal path in @racket[make-audio-player] uses @racket[dynamic-place] when
|
||||
places are enabled. This gives the audio side its own Racket VM and isolates
|
||||
it from the main controller, while the command and event protocol stays the
|
||||
same.
|
||||
|
||||
For debugging, @racket[make-audio-player] can be called with
|
||||
@racket[#:use-place #f]. In that mode, the placed player is started in a
|
||||
normal Racket thread and communicates through async channels:
|
||||
|
||||
@racketblock[
|
||||
(define player
|
||||
(make-audio-player
|
||||
(lambda (handle state-hash)
|
||||
(void))
|
||||
(lambda (handle)
|
||||
(void))
|
||||
#:use-place #f))
|
||||
|
||||
(audio-play! player "track.flac")
|
||||
(audio-pause! player #t)
|
||||
(audio-pause! player #f)
|
||||
(audio-stop! player)
|
||||
(audio-quit! player)]
|
||||
|
||||
The thread mode uses the same command protocol and the same worker code. It is
|
||||
therefore useful for reproducing and debugging player behaviour before moving
|
||||
back to the place-based configuration.
|
||||
|
||||
The place-based mode is the preferred mode for playback. A place runs in a
|
||||
separate Racket virtual machine, with its own scheduler state, and communicates
|
||||
with the main program only through explicit messages. This matters for audio:
|
||||
the audio backend must be fed regularly, and small scheduling delays can already
|
||||
show up as clicks, gaps, or stuttering playback. When the player runs in the
|
||||
same VM as DrRacket, a GUI application, logging, debugging, or other active
|
||||
threads, those activities can delay the audio feeder at the wrong moment. By
|
||||
running the player in a place, the playback pipeline gets a quieter execution
|
||||
environment. Running the same command loop in an ordinary thread is useful for
|
||||
debugging, because normal asynchronous channels are easier to inspect, but it is
|
||||
not the preferred mode for robust playback.
|
||||
@@ -0,0 +1,357 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
racket/contract
|
||||
racket/path
|
||||
racket/place
|
||||
"../audio-player.rkt"))
|
||||
|
||||
@title{Audio Player}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
|
||||
@defmodule[racket-audio/audio-player]
|
||||
|
||||
The @racketmodname[racket-audio/audio-player] module is the high level interface for
|
||||
audio playback. It hides the command protocol of
|
||||
@racketmodname[racket-audio/audio-placed-player], creates the playback place or
|
||||
thread, receives asynchronous events, and exposes a small handle-based API for
|
||||
starting, pausing, seeking, stopping, and observing playback.
|
||||
|
||||
The player is asynchronous. Playback commands are sent to a worker side and
|
||||
normally return after the command has been accepted, not after all audio has
|
||||
finished playing. State changes and end-of-stream notifications are delivered
|
||||
through callbacks supplied when the player is created.
|
||||
|
||||
@section{Creating a player}
|
||||
|
||||
@defproc[(make-audio-player
|
||||
[cb-state procedure?]
|
||||
[cb-eof-stream procedure?]
|
||||
[#:use-place use-place boolean?])
|
||||
audio-play?]{
|
||||
Creates an audio player and returns a player handle. The handle is passed to
|
||||
all other procedures in this module.
|
||||
|
||||
The @racket[cb-state] callback is called as:
|
||||
|
||||
@racketblock[
|
||||
(cb-state player current-player-state state-hash)]
|
||||
|
||||
where @racket[player] is the player handle,
|
||||
@racket[current-player-state] is the logical player state reported by the
|
||||
worker, and @racket[state-hash] is the most recent state snapshot received from
|
||||
the worker side. The callback is called from the event thread created by
|
||||
@racket[make-audio-player].
|
||||
|
||||
The worker-side player state is one of the following symbols:
|
||||
|
||||
@itemlist[
|
||||
#:style 'compact
|
||||
|
||||
@item{@racket['stopped] -- no stream is currently playing. This is the
|
||||
initial state of the placed player. The player also enters this state after
|
||||
@racket[audio-stop!] or after the decoder has reached the end of the stream
|
||||
and the libao output queue has drained.}
|
||||
|
||||
@item{@racket['playing] -- a stream is active. The decoder may still be
|
||||
reading from the input file, or the decoder may already have finished while
|
||||
libao is still playing queued PCM samples.}
|
||||
|
||||
@item{@racket['paused] -- playback is paused. The current stream is retained
|
||||
and the libao output side is paused. Resuming playback moves the player back
|
||||
to @racket['playing].}
|
||||
|
||||
@item{@racket['quit] -- the placed player has been asked to terminate. This
|
||||
is the terminal state of the worker.}
|
||||
]
|
||||
|
||||
The wrapper around the placed player may also report these states through
|
||||
@racket[audio-state]:
|
||||
|
||||
@itemlist[
|
||||
#:style 'compact
|
||||
|
||||
@item{@racket['initialized] -- the audio handle has been created, but no
|
||||
worker-side state snapshot has been received yet.}
|
||||
|
||||
@item{@racket['invalid] -- the audio handle is no longer valid. This happens
|
||||
after @racket[audio-quit!] or when the underlying place or thread has stopped.}
|
||||
]
|
||||
|
||||
The @racket[state-hash] contains the detailed playback state reported by the
|
||||
worker. It includes values such as the current playback position, stream
|
||||
duration, buffer status, music id, and libao handle validity. Code that only
|
||||
needs the logical playback state should use @racket[current-player-state]
|
||||
instead of extracting it from the hash.
|
||||
|
||||
The @racket[cb-eof-stream] callback is called as:
|
||||
|
||||
@racketblock[
|
||||
(cb-eof-stream player)]
|
||||
|
||||
when the decoder reports that the current stream has been read. This means
|
||||
that the decoder has finished queueing the stream. The audio device may still
|
||||
have buffered samples to play, and the logical player state may move to
|
||||
@racket['stopped] slightly later when the output queue has drained.
|
||||
|
||||
End-of-stream is not represented as a separate player state.
|
||||
|
||||
When @racket[use-place] is true, @racket[make-audio-player] starts
|
||||
@racket[placed-player] with @racket[dynamic-place] and communicates with it
|
||||
through place channels. When @racket[use-place] is false, the same command loop
|
||||
is started in an ordinary Racket thread and communicates through async channels.
|
||||
The default value is @racket[(place-enabled?)].
|
||||
|
||||
The place-based mode is the normal playback mode. A place gives the audio side
|
||||
a separate Racket VM, so decoding and buffer feeding are less exposed to
|
||||
scheduling delays caused by DrRacket, GUI event handling, debugging, logging, or
|
||||
other active threads in the main VM. Those delays can otherwise be heard as
|
||||
clicks, gaps, or stuttering playback. Thread mode is useful for debugging the
|
||||
protocol and callbacks, but it is not the preferred mode for robust playback.}
|
||||
|
||||
|
||||
@defproc[(audio-play? [v any/c]) boolean?]{
|
||||
Returns @racket[#t] when @racket[v] is a currently valid audio player handle.
|
||||
|
||||
The predicate is intentionally stricter than merely recognizing the underlying
|
||||
structure. After @racket[audio-quit!] or after the worker has died, the handle
|
||||
is invalidated and @racket[audio-play?] returns @racket[#f].}
|
||||
|
||||
@section{Basic playback}
|
||||
|
||||
@defproc[(audio-play! [player audio-play?]
|
||||
[audio-file path-string?])
|
||||
number?]{
|
||||
Starts playback of @racket[audio-file]. The file is opened by the worker side,
|
||||
a decoder is selected, and audio feeding begins asynchronously. In normal use
|
||||
the return value is @racket[music-id], where @tt{music-id} is the
|
||||
given @tt{id}, a @tt{number? >= 1} to the file to play, which will be used when reporting in
|
||||
callbacks about e.g. state.
|
||||
|
||||
Calling @racket[audio-play!] while another file is still active replaces the
|
||||
current stream. The worker side interrupts the old decoder, clears the output
|
||||
queue, waits for the old worker thread, and then starts the new stream.}
|
||||
|
||||
@defproc[(audio-pause! [player audio-play?]
|
||||
[paused? boolean?])
|
||||
symbol?]{
|
||||
Pauses or resumes playback. Passing @racket[#t] moves the logical player state
|
||||
to @racket['paused]. Passing @racket[#f] moves it back to @racket['playing].
|
||||
In normal use the return value is @racket['ok].
|
||||
|
||||
Pause is implemented as player state observed by the worker. The worker
|
||||
translates the state to calls to the asynchronous audio backend.}
|
||||
|
||||
@defproc[(audio-paused? [player audio-play?]) boolean?]{
|
||||
Returns whether the worker currently reports the logical player state as
|
||||
@racket['paused]. This is an RPC-style query to the worker side.}
|
||||
|
||||
@defproc[(audio-stop! [player audio-play?]) symbol?]{
|
||||
Stops the current stream, clears the audio output queue, closes the active
|
||||
decoder and output handle when present, and returns the logical state to
|
||||
@racket['stopped]. In normal use the return value is @racket['ok].
|
||||
|
||||
The player remains valid after @racket[audio-stop!], so another
|
||||
@racket[audio-play!] call can be used to start a new file.}
|
||||
|
||||
@defproc[(audio-quit! [player audio-play?])
|
||||
(or/c number? boolean? symbol?)]{
|
||||
Stops playback, performs the same cleanup as @racket[audio-stop!], sends a
|
||||
@racket['quit] command to the worker side, and invalidates the handle. In
|
||||
normal use the return value is @racket['quit].
|
||||
|
||||
After this procedure returns, the command loop in the place or thread is
|
||||
expected to terminate. Most other operations require @racket[audio-play?] and
|
||||
therefore should not be used on the handle after quitting. The implementation
|
||||
also registers a finalizer that sends @racket['quit] when a still-valid handle
|
||||
is collected, but explicit shutdown with @racket[audio-quit!] is preferred.}
|
||||
|
||||
@section{Position, volume, and buffering}
|
||||
|
||||
@defproc[(audio-seek! [player audio-play?]
|
||||
[percentage (and/c number? (>=/c 0) (<=/c 100))])
|
||||
symbol?]{
|
||||
Seeks the current stream to @racket[percentage], where @racket[0] is the start
|
||||
and @racket[100] is the end. The output queue is cleared before the decoder is
|
||||
asked to seek. In normal use the return value is @racket['ok].
|
||||
|
||||
Seeking does not change the logical playback state. A playing stream remains
|
||||
playing, and a paused stream remains paused.}
|
||||
|
||||
@defproc[(audio-volume! [player audio-play?]
|
||||
[percentage (and/c number? (>=/c 0))])
|
||||
symbol?]{
|
||||
Requests a new playback volume. The value is stored by the worker and applied
|
||||
to the audio output side when audio is processed. In normal use the return
|
||||
value is @racket['ok].}
|
||||
|
||||
@defproc[(audio-volume [player audio-play?]) number?]{
|
||||
Returns the current volume value known by the worker.}
|
||||
|
||||
@defproc[(audio-buf-seconds! [player audio-play?]
|
||||
[min number?]
|
||||
[max number?])
|
||||
(or/c symbol? boolean?)]{
|
||||
Configures the output buffering range, in seconds. The worker tries to keep
|
||||
the queued audio between the requested lower and upper bounds while decoding.
|
||||
|
||||
The wrapper normalizes the values before sending the command. A @racket[min]
|
||||
below @racket[1] is raised to @racket[1], and a @racket[min] above @racket[10]
|
||||
is lowered to @racket[10]. A @racket[max] below @racket[min] is changed to
|
||||
@racket[(+ min 1)], and a @racket[max] above @racket[30] is lowered to
|
||||
@racket[30]. The worker side applies its own safe ordering and clamping before
|
||||
using the values. In normal use the return value is @racket['ok].}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(audio-ao-buf-ms! [handle audio-play?]
|
||||
[ms integer?])
|
||||
(or/c integer? boolean?)]
|
||||
@defproc[(audio-ao-buf-ms [handle audio-play?])
|
||||
(or/c integer? boolean?)])
|
||||
]{
|
||||
|
||||
Sets or queries the libao output buffer size, expressed in milliseconds.
|
||||
|
||||
The @racket[audio-ao-buf-ms!] procedure forwards @racket[ms] to the audio
|
||||
player backend by sending the @racket['ao-buf-ms] RPC command. This hooks
|
||||
into the libao-side buffer configuration and can be used to tune the amount of
|
||||
audio data that the output layer keeps ahead of playback.
|
||||
|
||||
The @racket[audio-ao-buf-ms] procedure queries the currently configured value
|
||||
by sending the same RPC command without a new value.
|
||||
|
||||
The returned value is the value reported by the backend. Normally this is an
|
||||
integer number of milliseconds. A boolean result indicates that the value could
|
||||
not be set or queried, or that the backend reported a non-numeric status.
|
||||
|
||||
Larger buffer values can make playback more robust against short scheduling
|
||||
delays, but also increase latency. Smaller values reduce latency, but may make
|
||||
drop-outs more likely when the decoder or GUI thread is temporarily delayed.
|
||||
|
||||
The value is clamped between 50 and 1000ms.
|
||||
|
||||
@racketblock[
|
||||
(audio-ao-buf-ms! player 500)
|
||||
(audio-ao-buf-ms player)
|
||||
]
|
||||
}
|
||||
|
||||
@section{State snapshots}
|
||||
|
||||
The player keeps a local cache of the most recent state snapshot received from
|
||||
the worker. The cache is updated by an event thread created by
|
||||
@racket[make-audio-player]. The state accessor procedures below read this
|
||||
local cache; they do not synchronously ask the worker for a fresh state.
|
||||
|
||||
Before the first state event has arrived, most accessors return @racket[#f].
|
||||
The logical state accessor returns @racket['initialized] for a valid handle
|
||||
whose state hash does not yet contain a @racket['state] entry. If the worker
|
||||
dies or the handle is explicitly invalidated, @racket[audio-state] returns
|
||||
@racket['invalid].
|
||||
|
||||
@defproc[(audio-full-state [player audio-play?]) hash?]{
|
||||
Returns the complete cached state hash. The hash is the payload of the most
|
||||
recent @racket['state] event. It may contain keys such as @racket['state],
|
||||
@racket['file], @racket['duration], @racket['at-second],
|
||||
@racket['at-music-id], @racket['volume], @racket['bits], @racket['rate],
|
||||
@racket['channels], @racket['decoder], @racket['decoder-meta], and
|
||||
@racket['decoder-buf-info].}
|
||||
|
||||
@defproc[(audio-state [player audio-play?]) symbol?]{
|
||||
Returns the cached logical player state. Typical values are
|
||||
@racket['initialized], @racket['stopped], @racket['playing],
|
||||
@racket['paused], and @racket['invalid].}
|
||||
|
||||
@defproc[(audio-at-second [player audio-play?]) (or/c number? boolean?)]{
|
||||
Returns the cached playback position in seconds, or @racket[#f] when no
|
||||
position is known yet.}
|
||||
|
||||
@defproc[(audio-duration [player audio-play?]) (or/c number? boolean?)]{
|
||||
Returns the cached stream duration in seconds, or @racket[#f] when the duration
|
||||
is not known.}
|
||||
|
||||
@defproc[(audio-file [player audio-play?]) (or/c path-string? boolean?)]{
|
||||
Returns the cached path of the file currently associated with the active music
|
||||
id, or @racket[#f] when no such file is known.}
|
||||
|
||||
@defproc[(audio-music-id [player audio-play?]) (or/c number? boolean?)]{
|
||||
Returns the cached music id used by the asynchronous output side, or
|
||||
@racket[#f] when no output handle is active.}
|
||||
|
||||
@defproc[(audio-bits [player audio-play?]) (or/c number? boolean?)]{
|
||||
Returns the cached sample width in bits, or @racket[#f] when the format is not
|
||||
known.}
|
||||
|
||||
@defproc[(audio-rate [player audio-play?]) (or/c number? boolean?)]{
|
||||
Returns the cached sample rate, or @racket[#f] when the format is not known.}
|
||||
|
||||
@defproc[(audio-channels [player audio-play?]) (or/c number? boolean?)]{
|
||||
Returns the cached channel count, or @racket[#f] when the format is not known.}
|
||||
|
||||
@defproc[(audio-decoder [player audio-play?]) (or/c symbol? boolean?)]{
|
||||
Returns the cached decoder kind, or @racket[#f] when no decoder kind is known.}
|
||||
|
||||
@section{Events and callbacks}
|
||||
|
||||
The wrapper receives asynchronous events from the worker side. A state event
|
||||
updates the cached state hash and calls @racket[cb-state]. An
|
||||
@racket['audio-done] event calls @racket[cb-eof-stream]. Unknown events are
|
||||
reported through the module's warning mechanism.
|
||||
|
||||
Callbacks run in the event thread owned by the player handle. They should
|
||||
therefore be quick, should not block for long periods, and should avoid
|
||||
performing complicated UI work directly. A GUI program can use the callbacks
|
||||
to enqueue work onto the GUI eventspace instead.
|
||||
|
||||
The RPC command path is protected by a mutex in the wrapper. This allows
|
||||
different application threads to call playback procedures on the same handle
|
||||
without interleaving the command and reply parts of a single RPC.
|
||||
|
||||
@section[#:tag "audio-player-example"]{Example}
|
||||
|
||||
The following example creates a player, prints state changes, plays a file, and
|
||||
then shuts the player down explicitly.
|
||||
|
||||
For a larger integration example, see @filepath{play-test.rkt}. The queue
|
||||
variant in that file, selected with @code{(set-test 'queue)}, is documented separately in @filepath{play-test.scrbl}.
|
||||
|
||||
|
||||
@codeblock{
|
||||
#lang racket/base
|
||||
|
||||
(require "audio-player.rkt")
|
||||
|
||||
(define player
|
||||
(make-audio-player
|
||||
(lambda (p st)
|
||||
(printf "state: ~a at ~a seconds\n"
|
||||
(hash-ref st 'state #f)
|
||||
(hash-ref st 'at-second #f)))
|
||||
(lambda (p)
|
||||
(printf "decoder reached end of stream\n"))))
|
||||
|
||||
(audio-play! player "track.flac")
|
||||
|
||||
;; Later, for example in response to user input:
|
||||
(audio-pause! player #t)
|
||||
(audio-pause! player #f)
|
||||
(audio-seek! player 50)
|
||||
(audio-volume! player 80)
|
||||
(audio-stop! player)
|
||||
|
||||
;; When the player is no longer needed:
|
||||
(audio-quit! player)}
|
||||
|
||||
For debugging the worker in the same Racket VM, create the player with
|
||||
@racket[#:use-place #f]:
|
||||
|
||||
@racketblock[
|
||||
(define debug-player
|
||||
(make-audio-player
|
||||
(lambda (p st) (void))
|
||||
(lambda (p) (void))
|
||||
#:use-place #f))]
|
||||
|
||||
This uses the same command loop and event handling, but starts the worker side
|
||||
in a normal Racket thread instead of a place.
|
||||
@@ -15,7 +15,7 @@ file contents (signature sniffing) and, optionally, file extensions.
|
||||
The sniffer prefers binary inspection over extensions and only falls back
|
||||
to extensions when detection is inconclusive.
|
||||
|
||||
@section{Overview}
|
||||
@section[#:tag "audio-sniffer-overview"]{Overview}
|
||||
|
||||
The detection strategy is as follows:
|
||||
|
||||
|
||||
@@ -0,0 +1,91 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
racket/path
|
||||
"../encoder-test.rkt"))
|
||||
|
||||
@title{Encoder Test Program}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@defmodule[racket-audio/encoder-test]
|
||||
|
||||
The @racketmodname[racket-audio/encoder-test] module is a small integration test
|
||||
and command-line wrapper around @racketmodname[racket-audio/audio-encoder]. It
|
||||
is useful for checking that the native encoder libraries are available and that
|
||||
a concrete source file can be transcoded to Opus or FLAC.
|
||||
|
||||
The module depends on @filepath{tests.rkt} for its default input file. For
|
||||
portable tests, pass an explicit input file.
|
||||
|
||||
@section{Program use}
|
||||
|
||||
Run the test module directly to encode the default test file to a temporary
|
||||
Opus file:
|
||||
|
||||
@verbatim{
|
||||
racket encoder-test.rkt
|
||||
}
|
||||
|
||||
Useful command-line examples:
|
||||
|
||||
@verbatim{
|
||||
racket encoder-test.rkt --encoder opus --input input.flac --output output.opus --bitrate-kbps 224
|
||||
|
||||
racket encoder-test.rkt --encoder flac --input input-96k.flac --output output-48k.flac --sample-rate 48000 --bits-per-sample 24 --compression-level 8
|
||||
}
|
||||
|
||||
The program prints the selected encoder, settings, percentage progress, and a
|
||||
summary of the result hash returned by @racket[audio-encode]. Progress is based
|
||||
on input frames read from the decoder.
|
||||
|
||||
@section{Program options}
|
||||
|
||||
The command-line wrapper accepts these options:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@tt{-e}, @tt{--encoder}: @tt{opus} or @tt{flac}.}
|
||||
@item{@tt{-i}, @tt{--input}: input audio file.}
|
||||
@item{@tt{-o}, @tt{--output}: output audio file.}
|
||||
@item{@tt{--sample-rate}: target sample rate or @tt{source}.}
|
||||
@item{@tt{--bits-per-sample}: target FLAC bit depth or @tt{source}.}
|
||||
@item{@tt{--bitrate-kbps}: Opus bitrate in kbit/s.}
|
||||
@item{@tt{--compression-level}: FLAC compression level.}
|
||||
@item{@tt{--no-tags}: disable copying tags and embedded pictures.}]
|
||||
|
||||
@section{Racket functions}
|
||||
|
||||
@defproc[(encoder-test [input-file path-string?]
|
||||
[output-file (or/c path-string? #f)]
|
||||
[encoder (or/c symbol? string?)]
|
||||
[settings hash?]
|
||||
[#:copy-tags? copy-tags? boolean? #t])
|
||||
hash?]{
|
||||
Runs one encode test and prints a human-readable summary. The return value is
|
||||
the result hash produced by @racket[audio-encode]. When @racket[output-file] is
|
||||
@racket[#f], a temporary output path is chosen from the encoder kind.}
|
||||
|
||||
@defproc[(encoder-test-opus [input-file path-string?]
|
||||
[output-file (or/c path-string? #f) #f]
|
||||
[#:bitrate-kbps bitrate-kbps exact-positive-integer? 160]
|
||||
[#:sample-rate sample-rate (or/c exact-positive-integer? 'source) 'source]
|
||||
[#:copy-tags? copy-tags? boolean? #t])
|
||||
hash?]{
|
||||
Encodes @racket[input-file] to an Opus file using @racket[encoder-test]. The
|
||||
bitrate argument is expressed in kbit/s and is converted to the @racket['bitrate]
|
||||
setting used by the Opus backend.
|
||||
|
||||
The @racket[sample-rate] argument is normally @racket['source]. Opus encoding
|
||||
passes the input rate to @tt{libopusenc}; @tt{libopusenc} performs the internal
|
||||
resampling required for Opus output.}
|
||||
|
||||
@defproc[(encoder-test-flac [input-file path-string?]
|
||||
[output-file (or/c path-string? #f) #f]
|
||||
[#:compression-level compression-level exact-nonnegative-integer? 8]
|
||||
[#:sample-rate sample-rate (or/c exact-positive-integer? 'source) 'source]
|
||||
[#:bits-per-sample bits-per-sample (or/c exact-positive-integer? 'source) 'source]
|
||||
[#:copy-tags? copy-tags? boolean? #t])
|
||||
hash?]{
|
||||
Encodes @racket[input-file] to a FLAC file using @racket[encoder-test]. When
|
||||
@racket[sample-rate] or @racket[bits-per-sample] is not @racket['source], the
|
||||
FLAC pipeline requests the corresponding output format from
|
||||
@racketmodname[racket-audio/audio-encoder].}
|
||||
@@ -121,7 +121,7 @@ Seeking is asynchronous with respect to @racket[ffmpeg-seek]: the
|
||||
function only records the requested target sample. The read loop applies
|
||||
the pending seek request before decoding the next block.
|
||||
|
||||
@section{Notes}
|
||||
@section[#:tag "ffmpeg-decoder-notes"]{Notes}
|
||||
|
||||
The FFmpeg shim output is expected to be signed 32-bit interleaved PCM.
|
||||
This keeps the decoder interface suitable for a playback pipeline that
|
||||
|
||||
@@ -0,0 +1,441 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
;racket/contract
|
||||
racket/path
|
||||
ffi/unsafe
|
||||
let-assert
|
||||
early-return
|
||||
"../ffmpeg-definitions.rkt"
|
||||
"../private/cstruct-helper.rkt"))
|
||||
|
||||
@title[#:tag "ffmpeg-definitions"]{FFmpeg Decoder Definitions}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@defmodule[racket-audio/ffmpeg-definitions]
|
||||
|
||||
This module provides the direct FFmpeg-backed decoder layer used by the audio
|
||||
pipeline. It is deliberately small and stateful. A caller creates one decoder
|
||||
instance, opens one file on it, queries the selected audio stream, repeatedly
|
||||
asks for the next PCM block, and closes the instance again.
|
||||
|
||||
The module does not expose FFmpeg metadata. It only exposes the information
|
||||
needed for playback: stream count, sample rate, channel count, duration,
|
||||
bitrate, decoded PCM data, and sample positions. The output format is fixed:
|
||||
interleaved signed 32-bit PCM, four bytes per sample, using FFmpeg's
|
||||
@tt{AV_SAMPLE_FMT_S32} sample format.
|
||||
|
||||
The FFmpeg libraries are loaded when the module is required. The module checks
|
||||
that the runtime FFmpeg major versions are in the supported range configured by
|
||||
the implementation. This binding targets the FFmpeg library major versions
|
||||
used by FFmpeg 6, 7, and 8: @tt{libavutil} 58 to 60, @tt{libavcodec} 60 to 62,
|
||||
@tt{libavformat} 60 to 62, and @tt{libswresample} 4 to 6. Unsupported runtime
|
||||
versions fail early, before a decoder instance is used.
|
||||
|
||||
On Windows, the private library loader may download the bundled sound-library
|
||||
set into Racket's add-on directory before the FFI libraries are opened. On
|
||||
Unix-like systems, the FFmpeg libraries are expected to be installed by the
|
||||
operating system or platform package manager and to be reachable by Racket's
|
||||
FFI library search path.
|
||||
|
||||
@section{Layering}
|
||||
|
||||
This module is the low-level Racket FFI layer. It is normally wrapped by
|
||||
@filepath{ffmpeg-ffi.rkt} and then by @filepath{ffmpeg-decoder.rkt}. The first
|
||||
wrapper adapts this module to the command protocol used by the audio decoder
|
||||
frontend. The second wrapper exposes the callback-oriented decoder interface
|
||||
used by the rest of the playback pipeline.
|
||||
|
||||
The distinction matters for buffer lifetime. At this level,
|
||||
@racket[fmpg-buffer] returns the current buffer owned by the decoder instance.
|
||||
The adapter in @filepath{ffmpeg-ffi.rkt} copies that buffer before passing it to
|
||||
@filepath{ffmpeg-decoder.rkt}. Code that uses this module directly must copy
|
||||
the buffer itself when the bytes must survive the next decoder operation.
|
||||
|
||||
@section{FFmpeg version information}
|
||||
|
||||
@defproc[(ffmpeg-version [lib (or/c 'avutil 'avcodec 'avformat
|
||||
'swr 'swresample)])
|
||||
(list/c exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?)]{
|
||||
Returns the runtime version of one FFmpeg library as a three-element list
|
||||
containing the major, minor, and micro version numbers. The symbols
|
||||
@racket['swr] and @racket['swresample] both refer to @tt{libswresample}.
|
||||
|
||||
The version is read from FFmpeg's packed integer value. For example, a runtime
|
||||
value corresponding to @tt{62.28.100} is returned as @racket['(62 28 100)].
|
||||
The function raises an exception for an unknown library symbol.
|
||||
}
|
||||
|
||||
The runtime versions determine which partial FFmpeg struct layouts are safe to
|
||||
use. If a future FFmpeg major release changes a layout before one of the
|
||||
fields read by this module, the supported range should be extended only after
|
||||
the affected partial definitions have been checked.
|
||||
|
||||
@section[#:tag "ffmpeg-definitions-implementation-strategy"]{Implementation strategy}
|
||||
|
||||
This module talks directly to the FFmpeg shared libraries through Racket's FFI.
|
||||
There is no C shim that hides FFmpeg's structs or normalizes their layout. The
|
||||
price of that choice is that the Racket side must know enough of the relevant C
|
||||
struct layouts to read the fields used by the decoder. The benefit is that the
|
||||
binding remains a Racket module with direct access to the platform FFmpeg
|
||||
libraries.
|
||||
|
||||
@subsection{C structs and offsets}
|
||||
|
||||
Small and stable structures, such as @tt{AVRational} and
|
||||
@tt{AVChannelLayout}, are described with @racket[define-cstruct]. A
|
||||
@racket[define-cstruct] form describes the C fields to Racket's FFI. Racket
|
||||
then calculates the correct field offsets for the current platform ABI and
|
||||
creates the corresponding pointer type, constructor, accessors and mutators.
|
||||
|
||||
The larger FFmpeg structures are handled by @racket[def-cstruct] from
|
||||
@filepath{private/cstruct-helper.rkt}. Structures such as
|
||||
@tt{AVCodecParameters}, @tt{AVStream}, @tt{AVFormatContext}, @tt{AVFrame} and
|
||||
@tt{AVPacket} are large and may differ between FFmpeg major versions. The
|
||||
decoder only needs a few fields from each one, but those fields must still be
|
||||
read from their exact native offsets.
|
||||
|
||||
The helper solves this by describing the complete field sequence up to the last
|
||||
field the backend needs. Unnamed entries are used only to advance the offset.
|
||||
Named entries become generated accessors. Repeated entries such as
|
||||
@racket[(6 _int)] keep the definition compact while still allowing Racket's FFI
|
||||
to compute alignment, padding and pointer size correctly. Tail fields after
|
||||
the last required member are not described.
|
||||
|
||||
The right layout is selected when the module is required, after the runtime
|
||||
FFmpeg major versions have been read from the libraries. For the supported
|
||||
range, @tt{_AVCodecParameters} uses one layout for @tt{libavcodec} major
|
||||
version 60 and another for major versions 61 and 62. Likewise,
|
||||
@tt{_AVFrame} uses one layout for @tt{libavutil} major version 58 and
|
||||
another for major versions 59 and 60. The other partial structs used by this
|
||||
module are defined with a single layout across the supported versions.
|
||||
|
||||
@subsection{Defensive control flow}
|
||||
|
||||
Most FFmpeg calls report ordinary failure through C-style return values or null
|
||||
pointers. The implementation treats those results as normal control flow. The
|
||||
@racket[let/assert] form is used for setup paths where each native result must
|
||||
be checked before the next native call is made. It behaves like a sequential
|
||||
binding form: each binding can be checked immediately, and a failed check
|
||||
returns the specified failure value for the whole form.
|
||||
|
||||
That style is used for opening a file, selecting stream information, allocating
|
||||
the codec context, and initializing the resampler. Predicates such as
|
||||
@tt{a-!nullptr?}, @tt{a-nullptr?}, @tt{a-true?}, and @tt{a->=?} express the
|
||||
usual FFmpeg checks directly next to the binding that produced the value.
|
||||
|
||||
The decode and seek paths also use @racket[early-return] where processing must
|
||||
stop immediately from a nested position. This keeps the normal FFmpeg outcomes
|
||||
away from exception-based control flow while still making cleanup actions local
|
||||
to the point where a failure can occur.
|
||||
|
||||
@section{Decoder instances}
|
||||
|
||||
A decoder instance is an opaque value returned by @racket[fmpg-init]. Its
|
||||
structure type and predicate are not exported. Pass the value back to the
|
||||
functions in this module and do not inspect it directly. The contracts below
|
||||
therefore use @racket[any/c] for the instance argument. Operationally, that
|
||||
argument must be a value returned by @racket[fmpg-init].
|
||||
|
||||
The instance owns native FFmpeg resources: a format context, a codec context,
|
||||
an audio frame, a resampler, and the Racket byte string used for the current
|
||||
PCM block. Finalizers are installed as a last line of defence, but callers
|
||||
should still call @racket[fmpg-close!] explicitly when playback stops or when
|
||||
the file is no longer needed. Explicit close keeps the lifetime of native
|
||||
resources predictable.
|
||||
|
||||
@defproc[(fmpg-init) any/c]{
|
||||
Creates a new decoder instance. The result is an opaque instance value, or
|
||||
@racket[#f] if the instance could not be created.
|
||||
|
||||
Creating the instance does not open a file. Use @racket[fmpg-open-file!]
|
||||
before querying stream information or decoding audio.
|
||||
}
|
||||
|
||||
@defproc[(fmpg-open-file! [instance any/c]
|
||||
[filename (or/c path? string?)])
|
||||
(integer-in 0 1)]{
|
||||
Opens @racket[filename] on @racket[instance], reads the stream information,
|
||||
selects the best audio stream, initializes the codec context, and initializes
|
||||
the resampler.
|
||||
|
||||
The function returns @racket[1] on success and @racket[0] on failure. On
|
||||
failure, partially initialized native state is closed again. A non-string,
|
||||
non-path filename is treated as an open failure and returns @racket[0].
|
||||
|
||||
An instance can only have one file open. Close it with @racket[fmpg-close!]
|
||||
before opening another file on the same instance.
|
||||
}
|
||||
|
||||
@defproc[(fmpg-close! [instance any/c]) void?]{
|
||||
Closes @racket[instance] if it is open and releases the native FFmpeg resources
|
||||
owned by the instance. The codec context, frame and resampler are freed before
|
||||
the format context is closed. This order avoids keeping decoder pointers that
|
||||
refer to streams from an already closed container.
|
||||
|
||||
The stored audio information is reset. Calling this function with @racket[#f]
|
||||
or with an already closed instance is harmless.
|
||||
}
|
||||
|
||||
@defproc[(fmpg-is-open [instance any/c]) (integer-in 0 1)]{
|
||||
Returns @racket[1] when @racket[instance] is ready for decoding and @racket[0]
|
||||
otherwise. An instance is ready only after a file has been opened, a usable
|
||||
audio stream has been selected, and the decoder and resampler have been
|
||||
initialized.
|
||||
}
|
||||
|
||||
@section{Audio stream information}
|
||||
|
||||
The decoder selects one audio stream for playback using FFmpeg's best-stream
|
||||
selection. The stream count reports how many audio streams were found in the
|
||||
container, but decoding is performed only for the selected stream.
|
||||
|
||||
The term @italic{sample} in this module means a sample frame: one time step in
|
||||
the audio stream, across all channels. For stereo 32-bit output, one sample
|
||||
frame therefore occupies @racket[(* 2 4)] bytes in the returned PCM buffer.
|
||||
|
||||
@defproc[(fmpg-audio-stream-count [instance any/c])
|
||||
exact-nonnegative-integer?]{
|
||||
Returns the number of audio streams in the open container. If the instance is
|
||||
not open, the result is @racket[0]. This count is informational; actual stream
|
||||
selection is performed during @racket[fmpg-open-file!].
|
||||
}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(fmpg-audio-sample-rate [instance any/c])
|
||||
exact-nonnegative-integer?]
|
||||
@defproc[(fmpg-audio-channels [instance any/c])
|
||||
exact-nonnegative-integer?])]{
|
||||
Return the sample rate and channel count of the selected audio stream. If the
|
||||
instance is not ready, both functions return @racket[0].
|
||||
}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(fmpg-audio-bits-per-sample [instance any/c])
|
||||
exact-positive-integer?]
|
||||
@defproc[(fmpg-audio-bytes-per-sample [instance any/c])
|
||||
exact-positive-integer?])]{
|
||||
Return the fixed output sample width in bits and bytes. The current output
|
||||
format is 32-bit signed PCM, so @racket[fmpg-audio-bits-per-sample] returns
|
||||
@racket[32] and @racket[fmpg-audio-bytes-per-sample] returns @racket[4]. The
|
||||
values are independent of the input file's original sample format and do not
|
||||
depend on the instance state.
|
||||
}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(fmpg-duration-ms [instance any/c]) exact-integer?]
|
||||
@defproc[(fmpg-duration-samples [instance any/c]) exact-integer?])]{
|
||||
Return the duration of the selected audio stream in milliseconds and in sample
|
||||
frames. If the stream duration is not available, the container duration is
|
||||
used as a fallback. If no duration can be determined, or when the instance is
|
||||
not ready, the result is @racket[-1].
|
||||
}
|
||||
|
||||
@defproc[(fmpg-file-bitrate [instance any/c]) exact-integer?]{
|
||||
Returns the container bitrate in bits per second. If the bitrate is unavailable
|
||||
or if the instance is not open, the result is @racket[-1]. Only positive
|
||||
FFmpeg bitrates are passed through as reliable.
|
||||
}
|
||||
|
||||
@section{Output format}
|
||||
|
||||
The decoder output format is intentionally fixed:
|
||||
|
||||
@itemlist[
|
||||
#:style 'compact
|
||||
@item{sample format: signed 32-bit PCM, @tt{AV_SAMPLE_FMT_S32}}
|
||||
@item{layout: interleaved}
|
||||
@item{sample rate: the selected stream's sample rate}
|
||||
@item{channels: the selected stream's channel count}
|
||||
]
|
||||
|
||||
This keeps the playback layer simple. The FFmpeg input format may be planar,
|
||||
floating point, compressed, or otherwise different; @tt{libswresample} converts
|
||||
the decoded frames to the fixed output format before the bytes are exposed to
|
||||
Racket.
|
||||
|
||||
@section{Decoding}
|
||||
|
||||
Decoding is block oriented. Each call to @racket[fmpg-decode-next!] clears the
|
||||
previous PCM block and attempts to produce the next decoded block for the
|
||||
selected audio stream. When the call returns @racket[1], the block can be read
|
||||
with @racket[fmpg-buffer] and described with the buffer query functions.
|
||||
|
||||
@defproc[(fmpg-decode-next! [instance any/c]) exact-integer?]{
|
||||
Decodes until a block of PCM output is available, end of stream is reached, or
|
||||
an error occurs. The return values are:
|
||||
|
||||
@itemlist[
|
||||
#:style 'compact
|
||||
@item{@racket[1]: a new PCM buffer is available through @racket[fmpg-buffer].}
|
||||
@item{@racket[0]: decoding is complete and no more PCM is available.}
|
||||
@item{A negative value: decoding failed or the instance was not ready.}
|
||||
]
|
||||
|
||||
Internally, the decoder first tries to receive frames that FFmpeg may already
|
||||
have buffered. If no frame is ready, it reads packets until it finds a packet
|
||||
for the selected audio stream. Packets from other streams are skipped and
|
||||
immediately unreferenced. Sent packets are unreferenced after
|
||||
@tt{avcodec_send_packet}, because the codec has then taken what it needs.
|
||||
|
||||
At end of input, the function drains both the codec and the resampler. This is
|
||||
necessary because FFmpeg and @tt{libswresample} may still hold delayed samples
|
||||
even after the demuxer has no more packets.
|
||||
}
|
||||
|
||||
@section{Decoded buffers}
|
||||
|
||||
The PCM buffer belongs to the decoder instance. It is replaced by the next
|
||||
call to @racket[fmpg-decode-next!], @racket[fmpg-seek-ms!], or
|
||||
@racket[fmpg-close!]. Treat the returned byte string as read-only. Copy it if
|
||||
it must outlive the next decoder operation or if another component may mutate
|
||||
it.
|
||||
|
||||
@defproc[(fmpg-buffer [instance any/c]) (or/c bytes? #f)]{
|
||||
Returns the current decoded PCM block as a byte string, or @racket[#f] when no
|
||||
PCM block is available.
|
||||
|
||||
The byte string contains interleaved signed 32-bit samples. Its logical frame
|
||||
count is available as the difference between @racket[fmpg-buffer-end-sample]
|
||||
and @racket[fmpg-buffer-start-sample]. Its byte size is also available through
|
||||
@racket[fmpg-buffer-size].
|
||||
}
|
||||
|
||||
@defproc[(fmpg-buffer-size [instance any/c]) exact-nonnegative-integer?]{
|
||||
Returns the number of valid bytes in the current PCM buffer. If no decoder
|
||||
state is available, or if the size would not fit in the internal integer range,
|
||||
the function returns @racket[0].
|
||||
}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(fmpg-buffer-start-sample [instance any/c])
|
||||
exact-nonnegative-integer?]
|
||||
@defproc[(fmpg-buffer-end-sample [instance any/c])
|
||||
exact-nonnegative-integer?]
|
||||
@defproc[(fmpg-sample-position [instance any/c])
|
||||
exact-nonnegative-integer?])]{
|
||||
Return sample-frame positions for the current decoder state.
|
||||
|
||||
@racket[fmpg-buffer-start-sample] returns the first sample frame represented by
|
||||
the current PCM buffer. @racket[fmpg-buffer-end-sample] returns the half-open
|
||||
end position: the first sample frame after the current buffer.
|
||||
@racket[fmpg-sample-position] returns the next sample position the decoder
|
||||
expects to produce.
|
||||
|
||||
These values count sample frames, not individual channel samples. For stereo
|
||||
audio, one sample frame contains one sample for the left channel and one sample
|
||||
for the right channel.
|
||||
}
|
||||
|
||||
@section[#:tag "ffmpeg-definitions-seeking"]{Seeking}
|
||||
|
||||
@defproc[(fmpg-seek-ms! [instance any/c]
|
||||
[target-pos-ms exact-nonnegative-integer?])
|
||||
(integer-in 0 1)]{
|
||||
Seeks the selected audio stream to @racket[target-pos-ms] milliseconds and
|
||||
resets the decoder and resampler state. The function returns @racket[1] on
|
||||
success and @racket[0] on failure. Seeking is allowed only when the instance
|
||||
is already ready for decoding and the target position is non-negative.
|
||||
|
||||
Seeking uses FFmpeg's backward seek flag. FFmpeg may therefore seek to a packet
|
||||
position before the requested target. The decoder stores a discard target in
|
||||
sample frames. During the following decode calls, frames before the target are
|
||||
dropped, and frames that overlap the target are trimmed so the exposed PCM
|
||||
buffer starts at, or as close as FFmpeg can provide to, the requested position.
|
||||
|
||||
After a successful seek, the codec buffers are flushed, the resampler is closed
|
||||
and reinitialized, EOF state is cleared, and sample bookkeeping is reset to the
|
||||
target position.
|
||||
}
|
||||
|
||||
@section{Resource ownership}
|
||||
|
||||
The decoder instance owns the native FFmpeg objects it allocates. The codec
|
||||
pointer returned by FFmpeg is not owned by the instance, but the codec context,
|
||||
frame, resampler and format context are. They are released by
|
||||
@racket[fmpg-close!]. Finalizers are registered as a safety net, but callers
|
||||
should close decoder instances explicitly.
|
||||
|
||||
Temporary native buffers used during resampling are allocated only for the
|
||||
duration of a conversion step and are always freed before control returns to the
|
||||
caller. The public PCM buffer is a Racket byte string, so it can safely be
|
||||
passed to the Racket-side playback backend.
|
||||
|
||||
@section{Use through the decoder frontend}
|
||||
|
||||
The direct API above is normally wrapped by @filepath{ffmpeg-ffi.rkt} and by
|
||||
@filepath{ffmpeg-decoder.rkt}. The frontend function @tt{ffmpeg-open} returns
|
||||
a handle or @racket[#f] when the file does not exist. Its stream-info callback
|
||||
receives a mutable hash with at least these playback keys:
|
||||
|
||||
@racketblock[
|
||||
(list 'sample-rate
|
||||
'channels
|
||||
'bits-per-sample
|
||||
'bytes-per-sample
|
||||
'total-samples
|
||||
'duration)]
|
||||
|
||||
The audio callback receives the same hash extended for the current buffer with
|
||||
these keys:
|
||||
|
||||
@racketblock[
|
||||
(list 'sample
|
||||
'current-time)]
|
||||
|
||||
The hash is followed by a copied byte string and its valid byte count. The
|
||||
copy is made by @filepath{ffmpeg-ffi.rkt}, not by the low-level buffer function
|
||||
itself.
|
||||
|
||||
The frontend's seek function accepts a percentage of the stream and translates
|
||||
that percentage to a sample position. The adapter then translates the sample
|
||||
position to milliseconds and calls @racket[fmpg-seek-ms!]. This is why the
|
||||
low-level module exposes millisecond seeking while the frontend exposes
|
||||
percentage seeking.
|
||||
|
||||
@section{Examples}
|
||||
|
||||
The following example opens a file, decodes all PCM blocks, and reports their
|
||||
byte ranges and sample ranges. A real playback loop would pass each buffer to
|
||||
the audio output layer before requesting the next block.
|
||||
|
||||
@racketblock[
|
||||
(define dec (fmpg-init))
|
||||
|
||||
(when (and dec (= (fmpg-open-file! dec "track.ogg") 1))
|
||||
(printf "~a Hz, ~a channels, ~a ms\n"
|
||||
(fmpg-audio-sample-rate dec)
|
||||
(fmpg-audio-channels dec)
|
||||
(fmpg-duration-ms dec))
|
||||
|
||||
(let loop ()
|
||||
(case (fmpg-decode-next! dec)
|
||||
[(1)
|
||||
(define pcm (fmpg-buffer dec))
|
||||
(define size (fmpg-buffer-size dec))
|
||||
(define start (fmpg-buffer-start-sample dec))
|
||||
(define end (fmpg-buffer-end-sample dec))
|
||||
(printf "decoded ~a bytes, samples [~a, ~a)\n"
|
||||
size start end)
|
||||
;; Pass pcm to the audio output layer here, or copy it if needed.
|
||||
(loop)]
|
||||
[(0)
|
||||
(printf "done\n")]
|
||||
[else
|
||||
(error "decode error")]))
|
||||
|
||||
(fmpg-close! dec))
|
||||
]
|
||||
|
||||
A simple seek flow looks the same after the seek succeeds. The following code
|
||||
moves to 30 seconds and then requests the next decoded buffer.
|
||||
|
||||
@racketblock[
|
||||
(when (= (fmpg-seek-ms! dec 30000) 1)
|
||||
(when (= (fmpg-decode-next! dec) 1)
|
||||
(define pcm (fmpg-buffer dec))
|
||||
(define start (fmpg-buffer-start-sample dec))
|
||||
(printf "first buffer after seek starts at sample ~a\n" start)))
|
||||
]
|
||||
@@ -0,0 +1,441 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
(except-in racket/contract ->)
|
||||
racket/path
|
||||
ffi/unsafe
|
||||
let-assert
|
||||
early-return
|
||||
"../ffmpeg-definitions.rkt"
|
||||
"../private/cstruct-helper.rkt"))
|
||||
|
||||
@title[#:tag "ffmpeg-definitions"]{FFmpeg Decoder Definitions}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@defmodule[racket-audio/ffmpeg-definitions]
|
||||
|
||||
This module provides the direct FFmpeg-backed decoder layer used by the audio
|
||||
pipeline. It is deliberately small and stateful. A caller creates one decoder
|
||||
instance, opens one file on it, queries the selected audio stream, repeatedly
|
||||
asks for the next PCM block, and closes the instance again.
|
||||
|
||||
The module does not expose FFmpeg metadata. It only exposes the information
|
||||
needed for playback: stream count, sample rate, channel count, duration,
|
||||
bitrate, decoded PCM data, and sample positions. The output format is fixed:
|
||||
interleaved signed 32-bit PCM, four bytes per sample, using FFmpeg's
|
||||
@tt{AV_SAMPLE_FMT_S32} sample format.
|
||||
|
||||
The FFmpeg libraries are loaded when the module is required. The module checks
|
||||
that the runtime FFmpeg major versions are in the supported range configured by
|
||||
the implementation. This binding targets the FFmpeg library major versions
|
||||
used by FFmpeg 6, 7, and 8: @tt{libavutil} 58 to 60, @tt{libavcodec} 60 to 62,
|
||||
@tt{libavformat} 60 to 62, and @tt{libswresample} 4 to 6. Unsupported runtime
|
||||
versions fail early, before a decoder instance is used.
|
||||
|
||||
On Windows, the private library loader may download the bundled sound-library
|
||||
set into Racket's add-on directory before the FFI libraries are opened. On
|
||||
Unix-like systems, the FFmpeg libraries are expected to be installed by the
|
||||
operating system or platform package manager and to be reachable by Racket's
|
||||
FFI library search path.
|
||||
|
||||
@section{Layering}
|
||||
|
||||
This module is the low-level Racket FFI layer. It is normally wrapped by
|
||||
@filepath{ffmpeg-ffi.rkt} and then by @filepath{ffmpeg-decoder.rkt}. The first
|
||||
wrapper adapts this module to the command protocol used by the audio decoder
|
||||
frontend. The second wrapper exposes the callback-oriented decoder interface
|
||||
used by the rest of the playback pipeline.
|
||||
|
||||
The distinction matters for buffer lifetime. At this level,
|
||||
@racket[fmpg-buffer] returns the current buffer owned by the decoder instance.
|
||||
The adapter in @filepath{ffmpeg-ffi.rkt} copies that buffer before passing it to
|
||||
@filepath{ffmpeg-decoder.rkt}. Code that uses this module directly must copy
|
||||
the buffer itself when the bytes must survive the next decoder operation.
|
||||
|
||||
@section{FFmpeg version information}
|
||||
|
||||
@defproc[(ffmpeg-version [lib (or/c 'avutil 'avcodec 'avformat
|
||||
'swr 'swresample)])
|
||||
(list/c exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?)]{
|
||||
Returns the runtime version of one FFmpeg library as a three-element list
|
||||
containing the major, minor, and micro version numbers. The symbols
|
||||
@racket['swr] and @racket['swresample] both refer to @tt{libswresample}.
|
||||
|
||||
The version is read from FFmpeg's packed integer value. For example, a runtime
|
||||
value corresponding to @tt{62.28.100} is returned as @racket['(62 28 100)].
|
||||
The function raises an exception for an unknown library symbol.
|
||||
}
|
||||
|
||||
The runtime versions determine which partial FFmpeg struct layouts are safe to
|
||||
use. If a future FFmpeg major release changes a layout before one of the
|
||||
fields read by this module, the supported range should be extended only after
|
||||
the affected partial definitions have been checked.
|
||||
|
||||
@section{Implementation strategy}
|
||||
|
||||
This module talks directly to the FFmpeg shared libraries through Racket's FFI.
|
||||
There is no C shim that hides FFmpeg's structs or normalizes their layout. The
|
||||
price of that choice is that the Racket side must know enough of the relevant C
|
||||
struct layouts to read the fields used by the decoder. The benefit is that the
|
||||
binding remains a Racket module with direct access to the platform FFmpeg
|
||||
libraries.
|
||||
|
||||
@subsection{C structs and offsets}
|
||||
|
||||
Small and stable structures, such as @tt{AVRational} and
|
||||
@tt{AVChannelLayout}, are described with @racket[define-cstruct]. A
|
||||
@racket[define-cstruct] form describes the C fields to Racket's FFI. Racket
|
||||
then calculates the correct field offsets for the current platform ABI and
|
||||
creates the corresponding pointer type, constructor, accessors and mutators.
|
||||
|
||||
The larger FFmpeg structures are handled by @racket[def-cstruct] from
|
||||
@filepath{private/cstruct-helper.rkt}. Structures such as
|
||||
@tt{AVCodecParameters}, @tt{AVStream}, @tt{AVFormatContext}, @tt{AVFrame} and
|
||||
@tt{AVPacket} are large and may differ between FFmpeg major versions. The
|
||||
decoder only needs a few fields from each one, but those fields must still be
|
||||
read from their exact native offsets.
|
||||
|
||||
The helper solves this by describing the complete field sequence up to the last
|
||||
field the backend needs. Unnamed entries are used only to advance the offset.
|
||||
Named entries become generated accessors. Repeated entries such as
|
||||
@racket[(6 _int)] keep the definition compact while still allowing Racket's FFI
|
||||
to compute alignment, padding and pointer size correctly. Tail fields after
|
||||
the last required member are not described.
|
||||
|
||||
The right layout is selected when the module is required, after the runtime
|
||||
FFmpeg major versions have been read from the libraries. For the supported
|
||||
range, @tt{_AVCodecParameters} uses one layout for @tt{libavcodec} major
|
||||
version 60 and another for major versions 61 and 62. Likewise,
|
||||
@tt{_AVFrame} uses one layout for @tt{libavutil} major version 58 and
|
||||
another for major versions 59 and 60. The other partial structs used by this
|
||||
module are defined with a single layout across the supported versions.
|
||||
|
||||
@subsection{Defensive control flow}
|
||||
|
||||
Most FFmpeg calls report ordinary failure through C-style return values or null
|
||||
pointers. The implementation treats those results as normal control flow. The
|
||||
@racket[let/assert] form is used for setup paths where each native result must
|
||||
be checked before the next native call is made. It behaves like a sequential
|
||||
binding form: each binding can be checked immediately, and a failed check
|
||||
returns the specified failure value for the whole form.
|
||||
|
||||
That style is used for opening a file, selecting stream information, allocating
|
||||
the codec context, and initializing the resampler. Predicates such as
|
||||
@tt{a-!nullptr?}, @tt{a-nullptr?}, @tt{a-true?}, and @tt{a->=?} express the
|
||||
usual FFmpeg checks directly next to the binding that produced the value.
|
||||
|
||||
The decode and seek paths also use @racket[early-return] where processing must
|
||||
stop immediately from a nested position. This keeps the normal FFmpeg outcomes
|
||||
away from exception-based control flow while still making cleanup actions local
|
||||
to the point where a failure can occur.
|
||||
|
||||
@section{Decoder instances}
|
||||
|
||||
A decoder instance is an opaque value returned by @racket[fmpg-init]. Its
|
||||
structure type and predicate are not exported. Pass the value back to the
|
||||
functions in this module and do not inspect it directly. The contracts below
|
||||
therefore use @racket[any/c] for the instance argument. Operationally, that
|
||||
argument must be a value returned by @racket[fmpg-init].
|
||||
|
||||
The instance owns native FFmpeg resources: a format context, a codec context,
|
||||
an audio frame, a resampler, and the Racket byte string used for the current
|
||||
PCM block. Finalizers are installed as a last line of defence, but callers
|
||||
should still call @racket[fmpg-close!] explicitly when playback stops or when
|
||||
the file is no longer needed. Explicit close keeps the lifetime of native
|
||||
resources predictable.
|
||||
|
||||
@defproc[(fmpg-init) any/c]{
|
||||
Creates a new decoder instance. The result is an opaque instance value, or
|
||||
@racket[#f] if the instance could not be created.
|
||||
|
||||
Creating the instance does not open a file. Use @racket[fmpg-open-file!]
|
||||
before querying stream information or decoding audio.
|
||||
}
|
||||
|
||||
@defproc[(fmpg-open-file! [instance any/c]
|
||||
[filename (or/c path? string?)])
|
||||
(integer-in 0 1)]{
|
||||
Opens @racket[filename] on @racket[instance], reads the stream information,
|
||||
selects the best audio stream, initializes the codec context, and initializes
|
||||
the resampler.
|
||||
|
||||
The function returns @racket[1] on success and @racket[0] on failure. On
|
||||
failure, partially initialized native state is closed again. A non-string,
|
||||
non-path filename is treated as an open failure and returns @racket[0].
|
||||
|
||||
An instance can only have one file open. Close it with @racket[fmpg-close!]
|
||||
before opening another file on the same instance.
|
||||
}
|
||||
|
||||
@defproc[(fmpg-close! [instance any/c]) void?]{
|
||||
Closes @racket[instance] if it is open and releases the native FFmpeg resources
|
||||
owned by the instance. The codec context, frame and resampler are freed before
|
||||
the format context is closed. This order avoids keeping decoder pointers that
|
||||
refer to streams from an already closed container.
|
||||
|
||||
The stored audio information is reset. Calling this function with @racket[#f]
|
||||
or with an already closed instance is harmless.
|
||||
}
|
||||
|
||||
@defproc[(fmpg-is-open [instance any/c]) (integer-in 0 1)]{
|
||||
Returns @racket[1] when @racket[instance] is ready for decoding and @racket[0]
|
||||
otherwise. An instance is ready only after a file has been opened, a usable
|
||||
audio stream has been selected, and the decoder and resampler have been
|
||||
initialized.
|
||||
}
|
||||
|
||||
@section{Audio stream information}
|
||||
|
||||
The decoder selects one audio stream for playback using FFmpeg's best-stream
|
||||
selection. The stream count reports how many audio streams were found in the
|
||||
container, but decoding is performed only for the selected stream.
|
||||
|
||||
The term @italic{sample} in this module means a sample frame: one time step in
|
||||
the audio stream, across all channels. For stereo 32-bit output, one sample
|
||||
frame therefore occupies @racket[(* 2 4)] bytes in the returned PCM buffer.
|
||||
|
||||
@defproc[(fmpg-audio-stream-count [instance any/c])
|
||||
exact-nonnegative-integer?]{
|
||||
Returns the number of audio streams in the open container. If the instance is
|
||||
not open, the result is @racket[0]. This count is informational; actual stream
|
||||
selection is performed during @racket[fmpg-open-file!].
|
||||
}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(fmpg-audio-sample-rate [instance any/c])
|
||||
exact-nonnegative-integer?]
|
||||
@defproc[(fmpg-audio-channels [instance any/c])
|
||||
exact-nonnegative-integer?])]{
|
||||
Return the sample rate and channel count of the selected audio stream. If the
|
||||
instance is not ready, both functions return @racket[0].
|
||||
}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(fmpg-audio-bits-per-sample [instance any/c])
|
||||
exact-positive-integer?]
|
||||
@defproc[(fmpg-audio-bytes-per-sample [instance any/c])
|
||||
exact-positive-integer?])]{
|
||||
Return the fixed output sample width in bits and bytes. The current output
|
||||
format is 32-bit signed PCM, so @racket[fmpg-audio-bits-per-sample] returns
|
||||
@racket[32] and @racket[fmpg-audio-bytes-per-sample] returns @racket[4]. The
|
||||
values are independent of the input file's original sample format and do not
|
||||
depend on the instance state.
|
||||
}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(fmpg-duration-ms [instance any/c]) exact-integer?]
|
||||
@defproc[(fmpg-duration-samples [instance any/c]) exact-integer?])]{
|
||||
Return the duration of the selected audio stream in milliseconds and in sample
|
||||
frames. If the stream duration is not available, the container duration is
|
||||
used as a fallback. If no duration can be determined, or when the instance is
|
||||
not ready, the result is @racket[-1].
|
||||
}
|
||||
|
||||
@defproc[(fmpg-file-bitrate [instance any/c]) exact-integer?]{
|
||||
Returns the container bitrate in bits per second. If the bitrate is unavailable
|
||||
or if the instance is not open, the result is @racket[-1]. Only positive
|
||||
FFmpeg bitrates are passed through as reliable.
|
||||
}
|
||||
|
||||
@section{Output format}
|
||||
|
||||
The decoder output format is intentionally fixed:
|
||||
|
||||
@itemlist[
|
||||
#:style 'compact
|
||||
@item{sample format: signed 32-bit PCM, @tt{AV_SAMPLE_FMT_S32}}
|
||||
@item{layout: interleaved}
|
||||
@item{sample rate: the selected stream's sample rate}
|
||||
@item{channels: the selected stream's channel count}
|
||||
]
|
||||
|
||||
This keeps the playback layer simple. The FFmpeg input format may be planar,
|
||||
floating point, compressed, or otherwise different; @tt{libswresample} converts
|
||||
the decoded frames to the fixed output format before the bytes are exposed to
|
||||
Racket.
|
||||
|
||||
@section{Decoding}
|
||||
|
||||
Decoding is block oriented. Each call to @racket[fmpg-decode-next!] clears the
|
||||
previous PCM block and attempts to produce the next decoded block for the
|
||||
selected audio stream. When the call returns @racket[1], the block can be read
|
||||
with @racket[fmpg-buffer] and described with the buffer query functions.
|
||||
|
||||
@defproc[(fmpg-decode-next! [instance any/c]) exact-integer?]{
|
||||
Decodes until a block of PCM output is available, end of stream is reached, or
|
||||
an error occurs. The return values are:
|
||||
|
||||
@itemlist[
|
||||
#:style 'compact
|
||||
@item{@racket[1]: a new PCM buffer is available through @racket[fmpg-buffer].}
|
||||
@item{@racket[0]: decoding is complete and no more PCM is available.}
|
||||
@item{A negative value: decoding failed or the instance was not ready.}
|
||||
]
|
||||
|
||||
Internally, the decoder first tries to receive frames that FFmpeg may already
|
||||
have buffered. If no frame is ready, it reads packets until it finds a packet
|
||||
for the selected audio stream. Packets from other streams are skipped and
|
||||
immediately unreferenced. Sent packets are unreferenced after
|
||||
@tt{avcodec_send_packet}, because the codec has then taken what it needs.
|
||||
|
||||
At end of input, the function drains both the codec and the resampler. This is
|
||||
necessary because FFmpeg and @tt{libswresample} may still hold delayed samples
|
||||
even after the demuxer has no more packets.
|
||||
}
|
||||
|
||||
@section{Decoded buffers}
|
||||
|
||||
The PCM buffer belongs to the decoder instance. It is replaced by the next
|
||||
call to @racket[fmpg-decode-next!], @racket[fmpg-seek-ms!], or
|
||||
@racket[fmpg-close!]. Treat the returned byte string as read-only. Copy it if
|
||||
it must outlive the next decoder operation or if another component may mutate
|
||||
it.
|
||||
|
||||
@defproc[(fmpg-buffer [instance any/c]) (or/c bytes? #f)]{
|
||||
Returns the current decoded PCM block as a byte string, or @racket[#f] when no
|
||||
PCM block is available.
|
||||
|
||||
The byte string contains interleaved signed 32-bit samples. Its logical frame
|
||||
count is available as the difference between @racket[fmpg-buffer-end-sample]
|
||||
and @racket[fmpg-buffer-start-sample]. Its byte size is also available through
|
||||
@racket[fmpg-buffer-size].
|
||||
}
|
||||
|
||||
@defproc[(fmpg-buffer-size [instance any/c]) exact-nonnegative-integer?]{
|
||||
Returns the number of valid bytes in the current PCM buffer. If no decoder
|
||||
state is available, or if the size would not fit in the internal integer range,
|
||||
the function returns @racket[0].
|
||||
}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(fmpg-buffer-start-sample [instance any/c])
|
||||
exact-nonnegative-integer?]
|
||||
@defproc[(fmpg-buffer-end-sample [instance any/c])
|
||||
exact-nonnegative-integer?]
|
||||
@defproc[(fmpg-sample-position [instance any/c])
|
||||
exact-nonnegative-integer?])]{
|
||||
Return sample-frame positions for the current decoder state.
|
||||
|
||||
@racket[fmpg-buffer-start-sample] returns the first sample frame represented by
|
||||
the current PCM buffer. @racket[fmpg-buffer-end-sample] returns the half-open
|
||||
end position: the first sample frame after the current buffer.
|
||||
@racket[fmpg-sample-position] returns the next sample position the decoder
|
||||
expects to produce.
|
||||
|
||||
These values count sample frames, not individual channel samples. For stereo
|
||||
audio, one sample frame contains one sample for the left channel and one sample
|
||||
for the right channel.
|
||||
}
|
||||
|
||||
@section{Seeking}
|
||||
|
||||
@defproc[(fmpg-seek-ms! [instance any/c]
|
||||
[target-pos-ms exact-nonnegative-integer?])
|
||||
(integer-in 0 1)]{
|
||||
Seeks the selected audio stream to @racket[target-pos-ms] milliseconds and
|
||||
resets the decoder and resampler state. The function returns @racket[1] on
|
||||
success and @racket[0] on failure. Seeking is allowed only when the instance
|
||||
is already ready for decoding and the target position is non-negative.
|
||||
|
||||
Seeking uses FFmpeg's backward seek flag. FFmpeg may therefore seek to a packet
|
||||
position before the requested target. The decoder stores a discard target in
|
||||
sample frames. During the following decode calls, frames before the target are
|
||||
dropped, and frames that overlap the target are trimmed so the exposed PCM
|
||||
buffer starts at, or as close as FFmpeg can provide to, the requested position.
|
||||
|
||||
After a successful seek, the codec buffers are flushed, the resampler is closed
|
||||
and reinitialized, EOF state is cleared, and sample bookkeeping is reset to the
|
||||
target position.
|
||||
}
|
||||
|
||||
@section{Resource ownership}
|
||||
|
||||
The decoder instance owns the native FFmpeg objects it allocates. The codec
|
||||
pointer returned by FFmpeg is not owned by the instance, but the codec context,
|
||||
frame, resampler and format context are. They are released by
|
||||
@racket[fmpg-close!]. Finalizers are registered as a safety net, but callers
|
||||
should close decoder instances explicitly.
|
||||
|
||||
Temporary native buffers used during resampling are allocated only for the
|
||||
duration of a conversion step and are always freed before control returns to the
|
||||
caller. The public PCM buffer is a Racket byte string, so it can safely be
|
||||
passed to the Racket-side playback backend.
|
||||
|
||||
@section{Use through the decoder frontend}
|
||||
|
||||
The direct API above is normally wrapped by @filepath{ffmpeg-ffi.rkt} and by
|
||||
@filepath{ffmpeg-decoder.rkt}. The frontend function @tt{ffmpeg-open} returns
|
||||
a handle or @racket[#f] when the file does not exist. Its stream-info callback
|
||||
receives a mutable hash with at least these playback keys:
|
||||
|
||||
@racketblock[
|
||||
(list 'sample-rate
|
||||
'channels
|
||||
'bits-per-sample
|
||||
'bytes-per-sample
|
||||
'total-samples
|
||||
'duration)]
|
||||
|
||||
The audio callback receives the same hash extended for the current buffer with
|
||||
these keys:
|
||||
|
||||
@racketblock[
|
||||
(list 'sample
|
||||
'current-time)]
|
||||
|
||||
The hash is followed by a copied byte string and its valid byte count. The
|
||||
copy is made by @filepath{ffmpeg-ffi.rkt}, not by the low-level buffer function
|
||||
itself.
|
||||
|
||||
The frontend's seek function accepts a percentage of the stream and translates
|
||||
that percentage to a sample position. The adapter then translates the sample
|
||||
position to milliseconds and calls @racket[fmpg-seek-ms!]. This is why the
|
||||
low-level module exposes millisecond seeking while the frontend exposes
|
||||
percentage seeking.
|
||||
|
||||
@section{Examples}
|
||||
|
||||
The following example opens a file, decodes all PCM blocks, and reports their
|
||||
byte ranges and sample ranges. A real playback loop would pass each buffer to
|
||||
the audio output layer before requesting the next block.
|
||||
|
||||
@racketblock[
|
||||
(define dec (fmpg-init))
|
||||
|
||||
(when (and dec (= (fmpg-open-file! dec "track.ogg") 1))
|
||||
(printf "~a Hz, ~a channels, ~a ms\n"
|
||||
(fmpg-audio-sample-rate dec)
|
||||
(fmpg-audio-channels dec)
|
||||
(fmpg-duration-ms dec))
|
||||
|
||||
(let loop ()
|
||||
(case (fmpg-decode-next! dec)
|
||||
[(1)
|
||||
(define pcm (fmpg-buffer dec))
|
||||
(define size (fmpg-buffer-size dec))
|
||||
(define start (fmpg-buffer-start-sample dec))
|
||||
(define end (fmpg-buffer-end-sample dec))
|
||||
(printf "decoded ~a bytes, samples [~a, ~a)\n"
|
||||
size start end)
|
||||
;; Pass pcm to the audio output layer here, or copy it if needed.
|
||||
(loop)]
|
||||
[(0)
|
||||
(printf "done\n")]
|
||||
[else
|
||||
(error "decode error")]))
|
||||
|
||||
(fmpg-close! dec))
|
||||
]
|
||||
|
||||
A simple seek flow looks the same after the seek succeeds. The following code
|
||||
moves to 30 seconds and then requests the next decoded buffer.
|
||||
|
||||
@racketblock[
|
||||
(when (= (fmpg-seek-ms! dec 30000) 1)
|
||||
(when (= (fmpg-decode-next! dec) 1)
|
||||
(define pcm (fmpg-buffer dec))
|
||||
(define start (fmpg-buffer-start-sample dec))
|
||||
(printf "first buffer after seek starts at sample ~a\n" start)))
|
||||
]
|
||||
@@ -105,7 +105,7 @@ When the stream ends, the callback is called as:
|
||||
|
||||
The command returns @racket[#t].
|
||||
|
||||
@section{Seeking}
|
||||
@section[#:tag "ffmpeg-ffi-seeking"]{Seeking}
|
||||
|
||||
The @racket['seek] command takes an absolute PCM sample position:
|
||||
|
||||
|
||||
@@ -145,7 +145,7 @@ processing.
|
||||
The block size of the most recently processed frame.
|
||||
}
|
||||
|
||||
@section{Notes}
|
||||
@section[#:tag "flac-decoder-notes"]{Notes}
|
||||
|
||||
The frame-header hash passed to the audio callback is produced
|
||||
by @racket[flac-ffi-frame-header]. In this module it is extended
|
||||
|
||||
@@ -0,0 +1,96 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require racket/runtime-path
|
||||
scribble/core
|
||||
scribble/html-properties
|
||||
(for-label racket/base
|
||||
racket/path
|
||||
"../audio-player.rkt"
|
||||
"../taglib.rkt"
|
||||
"../audio-sniffer.rkt"
|
||||
"../audio-decoder.rkt"
|
||||
"../audio-placed-player.rkt"
|
||||
"../libao.rkt"
|
||||
"../mp3-decoder.rkt"
|
||||
"../flac-decoder.rkt"
|
||||
"../ffmpeg-decoder.rkt"))
|
||||
|
||||
@(define-runtime-path rktplayer-logo "rktplayer.svg")
|
||||
|
||||
@(define title-logo-style
|
||||
(style #f
|
||||
(list (attributes
|
||||
'((style . "float: right; margin-left: 1.5em; margin-bottom: 0.5em;"))))))
|
||||
|
||||
@elem[#:style title-logo-style]{@image[#:scale 0.25 rktplayer-logo]}
|
||||
|
||||
@title{@elem{Introduction racket-audio}}
|
||||
|
||||
|
||||
@;;title{racket-audio}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@racketmodname[racket-audio] is a small audio playback toolkit for Racket. It
|
||||
combines high-level asynchronous playback, optional metadata reading, file type
|
||||
sniffing, decoder backends, and libao based output. Most applications should
|
||||
start with the high-level player API and only use the lower-level modules when
|
||||
they need to add a decoder, inspect the playback pipeline, or debug the native
|
||||
FFI boundary.
|
||||
|
||||
@section{APIs for normal users}
|
||||
|
||||
For ordinary playback, use @racketmodname[racket-audio/audio-player]. It
|
||||
creates an audio player, starts the worker side, and exposes procedures such as
|
||||
@racket[make-audio-player], @racket[audio-play!], @racket[audio-pause!],
|
||||
@racket[audio-stop!], @racket[audio-seek!], and @racket[audio-quit!]. The
|
||||
player is asynchronous: commands return after they have been accepted, while
|
||||
state updates and end-of-stream notifications are delivered through callbacks.
|
||||
|
||||
Use @racketmodname[racket-audio/taglib] when an application needs metadata such
|
||||
as title, artist, album, duration-related properties, generic TagLib properties,
|
||||
or embedded cover art. The module reads metadata into a Racket-side snapshot
|
||||
and does not keep the native TagLib file handle open.
|
||||
|
||||
Use @racketmodname[racket-audio/audio-sniffer] when file type detection should
|
||||
be based on file contents rather than only on extensions. The sniffer is useful
|
||||
before choosing a decoder, validating input, or presenting a likely media type
|
||||
to the user.
|
||||
|
||||
The @racketmodname[racket-audio/play-test] module is not a library API, but it
|
||||
is a useful integration example. In particular, its queue mode, selected with
|
||||
@racket[(set-test 'queue)], shows how an EOF callback can start the next item
|
||||
in a simple playback queue.
|
||||
|
||||
@section{Lower-level modules for geeks}
|
||||
|
||||
The modules below are normally used by the player implementation rather than by
|
||||
application code. They are documented because they are useful when extending,
|
||||
debugging, or replacing parts of the pipeline.
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{@racketmodname[racket-audio/audio-placed-player] implements the worker
|
||||
side of the high-level player. It is normally run in a Racket place, so
|
||||
the timing-sensitive audio feeder runs in a separate VM, but it can also
|
||||
be run in a thread with async channels for easier debugging.}
|
||||
@item{@racketmodname[racket-audio/audio-decoder] provides the decoder registry
|
||||
and a uniform open/read/seek/stop interface over concrete decoder
|
||||
backends.}
|
||||
@item{@racketmodname[racket-audio/mp3-decoder],
|
||||
@racketmodname[racket-audio/flac-decoder], and
|
||||
@racketmodname[racket-audio/ffmpeg-decoder] are concrete decoder
|
||||
frontends. The FFmpeg path is the general-purpose fallback for formats
|
||||
not handled by the specialised decoders.}
|
||||
@item{@racketmodname[racket-audio/libao] and
|
||||
@racketmodname[racket-audio/libao-async-ffi-racket] form the output side:
|
||||
they open the native audio device, queue PCM buffers, apply volume, and
|
||||
feed libao asynchronously.}
|
||||
@item{@racketmodname[racket-audio/ffmpeg-ffi],
|
||||
@racketmodname[racket-audio/ffmpeg-definitions], and the FFmpeg C backend
|
||||
documentation describe the native FFmpeg boundary, the direct FFI
|
||||
definitions, version-sensitive structures, and the fixed PCM format used
|
||||
by the decoder pipeline.}]
|
||||
|
||||
In short: applications should usually combine
|
||||
@racketmodname[racket-audio/audio-player] with @racketmodname[racket-audio/taglib].
|
||||
The other modules document the machinery underneath: format detection, decoder
|
||||
selection, place-based playback, buffering, native output, and FFmpeg access.
|
||||
@@ -0,0 +1,320 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
racket/contract
|
||||
"../libao-async-ffi-racket.rkt"))
|
||||
|
||||
@title{Asynchronous libao playback in Racket}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@defmodule[racket-audio/libao-async-ffi-racket]
|
||||
|
||||
This module implements the asynchronous libao playback backend used by
|
||||
@racketmodname[racket-audio]. It is a pure Racket replacement for the older C
|
||||
based @filepath{ao_playasync.c} backend. It exports the same Racket-level API
|
||||
as @filepath{libao-async-ffi.rkt} and still sends PCM to Xiph libao, but the
|
||||
queue, worker thread, buffering, format conversion and volume scaling are all
|
||||
implemented in Racket.
|
||||
|
||||
The module is intended as a low-level backend below the higher-level sound
|
||||
player. Client code creates one asynchronous audio handle, queues decoded PCM
|
||||
buffers together with playback position information, and lets a Racket worker
|
||||
thread feed libao. Higher-level player code should normally use the public
|
||||
player interface instead of calling this module directly.
|
||||
|
||||
@section[#:tag "libao-async-overview"]{Overview}
|
||||
|
||||
The backend accepts decoded PCM buffers, converts them when needed, groups small
|
||||
buffers into larger playback chunks, and sends those chunks to libao from a
|
||||
dedicated Racket worker thread. The foreign @racket[ao_play] call is declared
|
||||
with @racket[#:blocking?], so a blocking write to the audio device does not
|
||||
unnecessarily hold up other Racket threads.
|
||||
|
||||
Incoming buffers may be interleaved or planar. Planar buffers, such as those
|
||||
commonly produced by a FLAC decoder, are converted to interleaved PCM before
|
||||
playback. If the requested sample width cannot be opened on the selected audio
|
||||
device, the backend tries lower-width output formats and converts samples before
|
||||
they are sent to libao.
|
||||
|
||||
The backend also maintains playback position metadata. Each queued buffer is
|
||||
tagged with a music id, a current playback position and a duration. These
|
||||
values are used by the higher-level player to report which track the output
|
||||
thread has reached.
|
||||
|
||||
@section{Basic example}
|
||||
|
||||
The normal live playback path opens the default libao driver. The output bit
|
||||
format may be lower than the requested bit format when libao cannot open the
|
||||
device with the requested precision.
|
||||
|
||||
@racketblock[
|
||||
(define h
|
||||
(ao_create_async 32 44100 2 'native-endian #f))
|
||||
|
||||
(define info
|
||||
(make-buffer-info 'interleaved 32 44100 2 'native-endian))
|
||||
|
||||
(when h
|
||||
(ao_play_async h 1 0.0 180.0 (bytes-length pcm) pcm info)
|
||||
(ao_set_volume_async h 80.0)
|
||||
(ao_pause_async h #t)
|
||||
(ao_pause_async h #f)
|
||||
(ao_stop_async h))]
|
||||
|
||||
To write to a WAV file instead of the default live device, pass a path string
|
||||
as the last argument to @racket[ao_create_async] instead of @racket[#f].
|
||||
|
||||
@racketblock[
|
||||
(define h
|
||||
(ao_create_async 16 48000 2 'little-endian "test-output.wav"))]
|
||||
|
||||
@section{Playback handles}
|
||||
|
||||
@defproc[(ao_version_async) exact-integer?]{
|
||||
Returns the implementation version of this asynchronous backend. The current
|
||||
module returns @racket[3]. The value is useful for diagnostics when multiple
|
||||
asynchronous backends exist.
|
||||
}
|
||||
|
||||
@defproc[(ao_create_async
|
||||
[bits exact-positive-integer?]
|
||||
[rate exact-positive-integer?]
|
||||
[channels exact-positive-integer?]
|
||||
[byte-format (or/c 'little-endian 'big-endian 'native-endian)]
|
||||
[wav-output-file (or/c #f path-string?)])
|
||||
any/c]{
|
||||
Creates an asynchronous audio handle. When @racket[wav-output-file] is
|
||||
@racket[#f], the default live libao driver is opened. Otherwise the libao
|
||||
@tt{wav} driver is opened and samples are written to the named file.
|
||||
|
||||
The requested format is described by @racket[bits], @racket[rate],
|
||||
@racket[channels] and @racket[byte-format]. If the requested number of bits
|
||||
cannot be opened and the request is wider than 24 or 16 bits, the module tries
|
||||
24-bit and then 16-bit output. The resulting device precision can be queried
|
||||
with @racket[ao_real_output_bits_async].
|
||||
|
||||
The result is an asynchronous audio handle, or @racket[#f] when no suitable
|
||||
libao device or output file could be opened. Handles should be closed with
|
||||
@racket[ao_stop_async]. A finalizer is also registered as a safety net, but
|
||||
explicit stopping is the intended lifecycle.
|
||||
}
|
||||
|
||||
@defproc[(ao_stop_async [handle any/c]) any/c]{
|
||||
Stops playback, clears queued data, wakes the worker thread when it is paused,
|
||||
queues a stop command, waits for the worker thread to finish, closes the libao
|
||||
device and marks the handle as invalid. The function returns the handle.
|
||||
Calling the other playback functions on an invalid handle is an error.
|
||||
}
|
||||
|
||||
@defproc[(ao_clear_async [handle any/c]) any/c]{
|
||||
Clears queued audio data without closing the device. The buffer that is being
|
||||
assembled for the next queued play item is also discarded. Already playing
|
||||
audio may still finish at the device level, depending on what libao and the
|
||||
operating system have accepted. This operation is used when playback is
|
||||
stopped, when the higher layer seeks, or when the current stream is replaced.
|
||||
}
|
||||
|
||||
@defproc[(ao_pause_async [handle any/c]
|
||||
[paused (or/c boolean? integer?)])
|
||||
any/c]{
|
||||
Pauses or resumes the worker thread. A boolean value is used directly. An
|
||||
integer value is accepted for compatibility with the old FFI layer, where
|
||||
@racket[0] means resume and any other integer means pause.
|
||||
|
||||
Pausing does not prevent producers from queueing additional buffers. It only
|
||||
prevents the worker thread from taking more data from the queue.
|
||||
}
|
||||
|
||||
@section{Buffer descriptions}
|
||||
|
||||
@defproc[(make-buffer-info
|
||||
[type symbol?]
|
||||
[sample-bits exact-positive-integer?]
|
||||
[sample-rate exact-positive-integer?]
|
||||
[channels exact-positive-integer?]
|
||||
[endianness (or/c 'little-endian 'big-endian 'native-endian)])
|
||||
any/c]{
|
||||
Constructs the format description passed to @racket[ao_play_async]. Only the
|
||||
constructor is exported. The struct predicate and accessors remain private to
|
||||
this module, because the value is primarily a compatibility object for the
|
||||
audio backend.
|
||||
|
||||
The @racket[type] field controls whether the incoming buffer is already
|
||||
interleaved. Use @racket['interleaved] or the older name @racket['ao] for
|
||||
ordinary PCM in frame order. Use @racket['planar] or the older name
|
||||
@racket['flac] when each channel is stored as a separate plane. Planar input
|
||||
is copied to an interleaved buffer before it is queued.
|
||||
|
||||
The @racket[sample-bits], @racket[sample-rate] and @racket[channels] fields
|
||||
describe the format of the supplied buffer, not necessarily the format that will
|
||||
eventually be accepted by the device. Samples are treated as signed integer
|
||||
PCM. @racket[sample-bits] must describe whole bytes, such as 16, 24 or 32
|
||||
bits. The conversion code uses the supplied endianness when reading input
|
||||
samples and when writing converted output samples.
|
||||
}
|
||||
|
||||
@defproc[(make-BufferInfo_t
|
||||
[type symbol?]
|
||||
[sample-bits exact-positive-integer?]
|
||||
[sample-rate exact-positive-integer?]
|
||||
[channels exact-positive-integer?]
|
||||
[endianness (or/c 'little-endian 'big-endian 'native-endian)])
|
||||
any/c]{
|
||||
Compatibility alias for @racket[make-buffer-info]. The name is kept so code
|
||||
that used the older FFI module can keep constructing buffer descriptions
|
||||
without changing call sites.
|
||||
}
|
||||
|
||||
@section{Queuing audio}
|
||||
|
||||
@defproc[(ao_play_async
|
||||
[handle any/c]
|
||||
[music-id any/c]
|
||||
[at-second real?]
|
||||
[music-duration real?]
|
||||
[buf-size exact-nonnegative-integer?]
|
||||
[audio-buffer (or/c bytes? any/c)]
|
||||
[buffer-info any/c])
|
||||
any/c]{
|
||||
Queues a PCM buffer for asynchronous playback. @racket[audio-buffer] may be a
|
||||
byte string, or an internal reusable memory object produced by this backend.
|
||||
External callers normally pass a byte string. @racket[buf-size] is the number
|
||||
of valid bytes in the buffer.
|
||||
|
||||
The position values @racket[music-id], @racket[at-second] and
|
||||
@racket[music-duration] are copied into the queue element. When the worker
|
||||
thread starts playing that element, these values become visible through
|
||||
@racket[ao_is_at_music_id_async], @racket[ao_is_at_second_async] and
|
||||
@racket[ao_music_duration_async]. They do not affect sample conversion.
|
||||
|
||||
If the input buffer is planar, it is first converted to interleaved PCM. If the
|
||||
input sample width or endianness differs from the opened output device, the
|
||||
sample data is converted before queueing. Small input chunks are collected into
|
||||
larger queue elements. The target chunk size is controlled by
|
||||
@racket[ao-playback-buf-ms] and defaults to 150 milliseconds. Buffers with
|
||||
different @racket[music-id] values are not merged into the same output chunk.
|
||||
}
|
||||
|
||||
@section[#:tag "libao-async-playback-state"]{Playback state}
|
||||
|
||||
@defproc[(ao_is_at_second_async [handle any/c]) real?]{
|
||||
Returns the playback position, in seconds, associated with the queue element
|
||||
most recently taken by the worker thread. This value is not measured by libao;
|
||||
it is the @racket[at-second] value supplied by the producer of the PCM buffer.
|
||||
}
|
||||
|
||||
@defproc[(ao_is_at_music_id_async [handle any/c]) any/c]{
|
||||
Returns the music id associated with the queue element most recently taken by
|
||||
the worker thread. The value is whatever was passed as @racket[music-id] to
|
||||
@racket[ao_play_async].
|
||||
}
|
||||
|
||||
@defproc[(ao_music_duration_async [handle any/c]) real?]{
|
||||
Returns the duration value associated with the queue element most recently
|
||||
taken by the worker thread. The value is copied from the
|
||||
@racket[music-duration] argument passed to @racket[ao_play_async].
|
||||
}
|
||||
|
||||
@defproc[(ao_bufsize_async [handle any/c]) exact-nonnegative-integer?]{
|
||||
Returns the number of audio bytes currently counted as buffered by the async
|
||||
queue administration. The value is updated when buffers are queued, combined,
|
||||
taken by the worker thread or cleared. It is a backend queue size, not the size
|
||||
of the operating-system or hardware audio buffer.
|
||||
}
|
||||
|
||||
@defproc[(ao_sample_queue_len [handle any/c]) exact-nonnegative-integer?]{
|
||||
Returns the number of queue elements currently counted by the async queue
|
||||
administration. Since the module combines small input buffers into larger
|
||||
playback chunks, this is not the same as the number of calls made to
|
||||
@racket[ao_play_async].
|
||||
}
|
||||
|
||||
@defproc[(ao_reuse_buf_len [handle any/c]) exact-nonnegative-integer?]{
|
||||
Returns the number of reusable byte buffers currently kept by the backend. This
|
||||
is an implementation diagnostic. It is useful for checking whether the reuse
|
||||
pool is being exercised, but it is not an audio latency measurement.
|
||||
}
|
||||
|
||||
@section{Volume and output format}
|
||||
|
||||
@defproc[(ao_set_volume_async [handle any/c]
|
||||
[percentage real?])
|
||||
any/c]{
|
||||
Sets the software volume. @racket[100.0] is normal volume, @racket[50.0] is
|
||||
half volume and values above @racket[100.0] amplify the samples. The
|
||||
implementation stores the setting as an integer scaled by 100, so normal volume
|
||||
is represented internally as @racket[10000]. Values very close to
|
||||
@racket[100.0] are normalized to exactly @racket[10000] to avoid unnecessary
|
||||
sample processing.
|
||||
|
||||
Volume is applied by the worker thread immediately before copying the playback
|
||||
chunk to the foreign buffer passed to libao. Scaled samples are clipped to the
|
||||
signed range of the opened output sample width.
|
||||
}
|
||||
|
||||
@defproc[(ao_volume_async [handle any/c]) real?]{
|
||||
Returns the current software volume percentage. A result of @racket[100.0]
|
||||
means normal volume.
|
||||
}
|
||||
|
||||
@defproc[(ao_real_output_bits_async [handle any/c])
|
||||
exact-nonnegative-integer?]{
|
||||
Returns the actual number of bits per sample used by the opened libao device.
|
||||
This may be lower than the requested width if device opening fell back from
|
||||
32-bit to 24-bit or 16-bit output. In that case, @racket[ao_play_async]
|
||||
converts the incoming samples before playback.
|
||||
}
|
||||
|
||||
@section{Playback buffer tuning}
|
||||
|
||||
@defproc[(ao-playback-buf-ms) exact-nonnegative-integer?]{
|
||||
Returns the target size, in milliseconds, of the playback chunks that the
|
||||
backend sends to libao. The default is @racket[150].
|
||||
}
|
||||
|
||||
@defproc[(ao-set-playback-buf-ms! [ms exact-nonnegative-integer?])
|
||||
void?]{
|
||||
Sets the target playback chunk size in milliseconds.
|
||||
|
||||
Larger values reduce the number of calls to libao and may help prevent audible
|
||||
glitches when decoders produce many small buffers. Smaller values reduce
|
||||
latency but increase scheduling pressure on the Racket worker thread and on the
|
||||
audio backend.
|
||||
}
|
||||
|
||||
@section[#:tag "libao-async-implementation-strategy"]{Implementation strategy}
|
||||
|
||||
The module keeps libao as the only native audio backend, but moves the async
|
||||
queue and playback thread from C to Racket. It initializes libao lazily when
|
||||
the first handle or temporary driver query is opened. A small reference count
|
||||
is used so @racket[ao_shutdown] is called when the last opened handle is closed.
|
||||
A custodian and exit finalizer call shutdown as a last resort.
|
||||
|
||||
The worker thread waits for queue elements, observes the pause lock, applies
|
||||
volume when necessary, copies the chunk into foreign memory allocated as
|
||||
@racket['atomic-interior], and calls libao. The foreign @racket[ao_play]
|
||||
binding is marked as blocking. The combination matters: libao may retain the
|
||||
pointer for the duration of the call, and a blocking foreign call should not
|
||||
receive movable Racket byte storage directly.
|
||||
|
||||
Small decoder buffers are combined before reaching libao. The target chunk
|
||||
size is controlled by @racket[ao-playback-buf-ms]. The buffer reuse pool keeps
|
||||
allocated byte strings around for future chunks, reducing allocation churn in
|
||||
long playback sessions.
|
||||
|
||||
The conversion path is intentionally narrow. Planar input is converted to
|
||||
interleaved PCM. Sample width conversion is done with arithmetic shifts, and
|
||||
endianness conversion is handled through Racket byte operations. This backend
|
||||
therefore expects integer PCM with byte-aligned sample widths.
|
||||
|
||||
@section{Compatibility notes}
|
||||
|
||||
The exported names are kept compatible with the old
|
||||
@filepath{libao-async-ffi.rkt} layer. In particular,
|
||||
@racket[make-BufferInfo_t] remains available even though the actual value is a
|
||||
Racket struct, not a C struct. The higher layers can therefore select this
|
||||
module as an implementation backend without changing the playback API.
|
||||
|
||||
The queue state functions report the backend's own administration. They do not
|
||||
query libao for device latency, and they do not know how many samples are
|
||||
already buffered by the operating system or the audio driver.
|
||||
@@ -0,0 +1,306 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
racket/contract
|
||||
"../libao-async-ffi-racket.rkt"))
|
||||
|
||||
@title{Pure Racket Asynchronous libao Backend}
|
||||
|
||||
@defmodule[racket-audio/libao-async-ffi-racket]
|
||||
|
||||
This module implements the asynchronous libao playback backend used by
|
||||
@racketmodname[racket-audio]. It provides the same public Racket API as the
|
||||
older C-backed asynchronous player, but keeps the queueing, buffering,
|
||||
conversion and worker-thread logic in Racket. The only foreign calls made by
|
||||
this module are the direct calls into Xiph's libao library.
|
||||
|
||||
The module is intended as a low-level backend. Higher-level player code should
|
||||
normally use the public audio-player interface instead of calling this module
|
||||
directly. It is documented here because it defines the exact contract between
|
||||
decoded PCM data and the libao output path.
|
||||
|
||||
@section{Overview}
|
||||
|
||||
The backend accepts decoded PCM buffers, converts them when needed, groups small
|
||||
buffers into larger playback chunks, and sends those chunks to libao from a
|
||||
dedicated Racket worker thread. The worker thread calls @racket[ao_play] as a
|
||||
blocking foreign call, so other Racket threads and places do not have to wait
|
||||
for the audio device to accept more data.
|
||||
|
||||
Incoming buffers may be interleaved or planar. Planar buffers, such as those
|
||||
commonly produced by a FLAC decoder, are converted to interleaved PCM before
|
||||
playback. If the requested sample width cannot be opened on the selected audio
|
||||
device, the backend tries lower-width output formats and converts samples before
|
||||
they are sent to libao.
|
||||
|
||||
The backend also maintains playback position metadata. Each queued buffer is
|
||||
tagged with a music id, a current playback position and a duration. These
|
||||
values are used by the higher-level player to report where the audio device is
|
||||
in the current track.
|
||||
|
||||
@section{Buffer information}
|
||||
|
||||
@defproc[(make-buffer-info [type symbol?]
|
||||
[sample-bits exact-positive-integer?]
|
||||
[sample-rate exact-positive-integer?]
|
||||
[channels exact-positive-integer?]
|
||||
[endianness symbol?])
|
||||
any/c]{
|
||||
|
||||
Creates a buffer description object for PCM data passed to
|
||||
@racket[ao_play_async].
|
||||
|
||||
The @racket[type] field describes the memory layout. The supported values are
|
||||
@racket['interleaved] for normal interleaved PCM and @racket['planar] for planar
|
||||
PCM. For compatibility with older code, @racket['ao] is treated as interleaved
|
||||
by convention and @racket['flac] is accepted as planar input.
|
||||
|
||||
The @racket[sample-bits], @racket[sample-rate] and @racket[channels] fields
|
||||
describe the format of the supplied buffer, not necessarily the format that will
|
||||
eventually be accepted by the device. The backend may convert the sample width
|
||||
to the actual device width.
|
||||
|
||||
The @racket[endianness] field must be one of @racket['little-endian],
|
||||
@racket['big-endian] or @racket['native-endian]. It is used when samples are
|
||||
converted between different sample widths or byte orders.}
|
||||
|
||||
@defproc[(make-BufferInfo_t [type symbol?]
|
||||
[sample-bits exact-positive-integer?]
|
||||
[sample-rate exact-positive-integer?]
|
||||
[channels exact-positive-integer?]
|
||||
[endianness symbol?])
|
||||
any/c]{
|
||||
|
||||
Compatibility alias for @racket[make-buffer-info]. The name matches the older
|
||||
FFI module and the former C structure naming convention.}
|
||||
|
||||
@section{Creating and closing a backend}
|
||||
|
||||
@defproc[(ao_version_async) exact-integer?]{
|
||||
|
||||
Returns the version number of this asynchronous backend implementation. The
|
||||
current implementation returns @racket[3]. The value is useful for diagnostics
|
||||
when multiple asynchronous backend implementations exist.}
|
||||
|
||||
@defproc[(ao_create_async [bits exact-positive-integer?]
|
||||
[rate exact-positive-integer?]
|
||||
[channels exact-positive-integer?]
|
||||
[byte-format symbol?]
|
||||
[wav-output-file (or/c #f path-string?)])
|
||||
any/c]{
|
||||
|
||||
Opens a libao output device and creates an asynchronous playback handle.
|
||||
|
||||
The @racket[bits], @racket[rate], @racket[channels] and @racket[byte-format]
|
||||
arguments describe the preferred output format. The byte format must be one of
|
||||
@racket['little-endian], @racket['big-endian] or @racket['native-endian].
|
||||
|
||||
When @racket[wav-output-file] is @racket[#f], the default live libao driver is
|
||||
used. When it is a path string, the backend opens libao's @tt{wav} driver and
|
||||
writes the audio stream to that file instead.
|
||||
|
||||
The backend first tries to open the requested sample width. If that fails and
|
||||
the requested width is greater than 24 bits, it tries 24-bit output. If that
|
||||
also fails and the requested width is greater than 16 bits, it tries 16-bit
|
||||
output. The actual device width can be queried with
|
||||
@racket[ao_real_output_bits_async].
|
||||
|
||||
The function returns a playback handle on success and @racket[#f] when no
|
||||
suitable libao device could be opened.}
|
||||
|
||||
@defproc[(ao_stop_async [handle any/c]) any/c]{
|
||||
|
||||
Stops the worker thread, clears pending audio, closes the libao device and
|
||||
invalidates @racket[handle].
|
||||
|
||||
The stop operation first clears all queued buffers, then queues an internal stop
|
||||
command, waits for the playback thread to terminate, and finally closes the
|
||||
underlying libao handle. Calling this function on an already invalid handle is
|
||||
an error.}
|
||||
|
||||
@section{Submitting audio}
|
||||
|
||||
@defproc[(ao_play_async [handle any/c]
|
||||
[music-id any/c]
|
||||
[at-second real?]
|
||||
[music-duration real?]
|
||||
[buf-size exact-nonnegative-integer?]
|
||||
[au-buf (or/c bytes? any/c)]
|
||||
[info any/c])
|
||||
void?]{
|
||||
|
||||
Queues a PCM buffer for asynchronous playback.
|
||||
|
||||
The @racket[music-id], @racket[at-second] and @racket[music-duration] values are
|
||||
stored together with the queued buffer. They do not affect sample conversion,
|
||||
but they allow the player to report the current track id, playback position and
|
||||
track duration while the worker thread is playing the queued data.
|
||||
|
||||
The @racket[buf-size] argument gives the number of valid bytes in
|
||||
@racket[au-buf]. The input buffer is copied into backend-owned memory before
|
||||
the function returns, so the caller may reuse or discard the original byte
|
||||
string after the call.
|
||||
|
||||
The @racket[info] argument should be created with @racket[make-buffer-info]. If
|
||||
the buffer is planar, it is converted to interleaved PCM. If the buffer's
|
||||
sample width or byte order differs from the actual libao device format, the
|
||||
backend converts it before queueing.
|
||||
|
||||
The backend groups smaller buffers into larger playback chunks. This reduces
|
||||
the number of calls to libao and helps prevent underruns. Buffers with
|
||||
different @racket[music-id] values are not merged into the same output chunk.}
|
||||
|
||||
@defproc[(ao_clear_async [handle any/c]) any/c]{
|
||||
|
||||
Clears all queued audio buffers that have not yet been played.
|
||||
|
||||
The current aggregation buffer is also cleared. Already playing audio may still
|
||||
finish at the device level, depending on what libao and the operating system
|
||||
have accepted. This operation is used by higher-level code when stopping,
|
||||
seeking or replacing the current stream.}
|
||||
|
||||
@section{Playback state}
|
||||
|
||||
@defproc[(ao_is_at_second_async [handle any/c]) real?]{
|
||||
|
||||
Returns the playback position associated with the most recently dequeued buffer.
|
||||
This value is the @racket[at-second] value supplied to @racket[ao_play_async],
|
||||
not a sample-accurate query into the audio device.}
|
||||
|
||||
@defproc[(ao_is_at_music_id_async [handle any/c]) any/c]{
|
||||
|
||||
Returns the music id associated with the most recently dequeued buffer. The
|
||||
higher-level player uses this value to determine which track the output thread
|
||||
has reached.}
|
||||
|
||||
@defproc[(ao_music_duration_async [handle any/c]) real?]{
|
||||
|
||||
Returns the duration associated with the most recently dequeued buffer. This is
|
||||
the @racket[music-duration] value supplied to @racket[ao_play_async].}
|
||||
|
||||
@defproc[(ao_bufsize_async [handle any/c]) exact-nonnegative-integer?]{
|
||||
|
||||
Returns the number of queued PCM bytes that have been accepted by the backend
|
||||
but not yet removed from the asynchronous queue. This is a backend queue size,
|
||||
not the size of the operating-system or hardware audio buffer.}
|
||||
|
||||
@defproc[(ao_sample_queue_len [handle any/c]) exact-nonnegative-integer?]{
|
||||
|
||||
Returns the number of queued playback elements waiting in the backend queue.
|
||||
This is mainly useful for diagnostics and tuning.}
|
||||
|
||||
@defproc[(ao_reuse_buf_len [handle any/c]) exact-nonnegative-integer?]{
|
||||
|
||||
Returns the number of reusable internal buffers currently kept by the backend.
|
||||
This is a diagnostic value that can help detect excessive allocation or
|
||||
unexpected buffer retention.}
|
||||
|
||||
@section{Pause and volume}
|
||||
|
||||
@defproc[(ao_pause_async [handle any/c]
|
||||
[paused (or/c boolean? integer?)])
|
||||
void?]{
|
||||
|
||||
Pauses or resumes the playback worker.
|
||||
|
||||
When @racket[paused] is @racket[#t], or an integer other than @racket[0], the
|
||||
worker thread is blocked before it dequeues the next element. When
|
||||
@racket[paused] is @racket[#f] or @racket[0], playback is resumed.
|
||||
|
||||
Pausing does not prevent producers from queueing additional buffers. It only
|
||||
prevents the worker thread from taking more data from the queue.}
|
||||
|
||||
@defproc[(ao_set_volume_async [handle any/c]
|
||||
[percentage real?])
|
||||
void?]{
|
||||
|
||||
Sets the output volume as a percentage.
|
||||
|
||||
A value of @racket[100.0] means unchanged volume. Values below
|
||||
@racket[100.0] attenuate the signal. Values above @racket[100.0] amplify the
|
||||
signal and are clipped to the signed range of the actual device sample width.
|
||||
|
||||
Internally the value is stored as an integer in hundredths of a percent: for
|
||||
example, @racket[100.0] becomes @racket[10000]. Values very close to
|
||||
@racket[100.0] are normalized to exactly @racket[10000] to avoid unnecessary
|
||||
sample processing.}
|
||||
|
||||
@defproc[(ao_volume_async [handle any/c]) real?]{
|
||||
|
||||
Returns the currently configured output volume percentage.}
|
||||
|
||||
@section{Output format}
|
||||
|
||||
@defproc[(ao_real_output_bits_async [handle any/c])
|
||||
exact-nonnegative-integer?]{
|
||||
|
||||
Returns the actual sample width opened on the libao device.
|
||||
|
||||
This may be lower than the requested width passed to @racket[ao_create_async].
|
||||
For example, a request for 32-bit output may result in a 24-bit or 16-bit device
|
||||
when the default libao driver cannot open the preferred format. In that case,
|
||||
@racket[ao_play_async] converts the incoming samples before playback.}
|
||||
|
||||
@section{Playback buffer tuning}
|
||||
|
||||
@defproc[(ao-playback-buf-ms) exact-nonnegative-integer?]{
|
||||
|
||||
Returns the target size, in milliseconds, of the playback chunks that the
|
||||
backend sends to libao. The default is @racket[150].}
|
||||
|
||||
@defproc[(ao-set-playback-buf-ms! [ms exact-nonnegative-integer?])
|
||||
void?]{
|
||||
|
||||
Sets the target playback chunk size in milliseconds.
|
||||
|
||||
Larger values reduce the number of calls to libao and may help prevent audible
|
||||
glitches when decoders produce many small buffers. Smaller values reduce
|
||||
latency but increase scheduling pressure on the Racket worker thread and on the
|
||||
audio backend.}
|
||||
|
||||
@section{Implementation notes}
|
||||
|
||||
The worker thread is created with its own thread pool and uses libao's
|
||||
@racket[ao_play] through a blocking FFI call. Before calling libao, the worker
|
||||
copies the queued bytes into memory allocated with @racket['atomic-interior].
|
||||
This is important because a blocking foreign call must not be handed a pointer
|
||||
to movable Racket memory that could be relocated by the garbage collector while
|
||||
the foreign function is still using it.
|
||||
|
||||
The backend keeps a small pool of previously allocated buffers. Buffers created
|
||||
internally for conversion or aggregation can be reused after playback. This
|
||||
reduces allocation pressure during continuous playback.
|
||||
|
||||
The module initializes libao when the first handle is opened and shuts libao
|
||||
down when the last handle is closed. This keeps libao lifetime management local
|
||||
to the backend and avoids repeated global initialization during normal playback.
|
||||
|
||||
@section{Example}
|
||||
|
||||
@racketblock[
|
||||
(define h
|
||||
(ao_create_async 32 44100 2 'native-endian #f))
|
||||
|
||||
(define info
|
||||
(make-buffer-info 'interleaved 32 44100 2 'native-endian))
|
||||
|
||||
(when h
|
||||
(ao_play_async h
|
||||
1
|
||||
0.0
|
||||
180.0
|
||||
(bytes-length pcm-bytes)
|
||||
pcm-bytes
|
||||
info)
|
||||
|
||||
(ao_set_volume_async h 80.0)
|
||||
|
||||
(ao_pause_async h #t)
|
||||
(ao_pause_async h #f)
|
||||
|
||||
(ao_stop_async h))
|
||||
]
|
||||
|
||||
The example opens the default live libao device, queues one interleaved
|
||||
32-bit PCM buffer, lowers the volume to 80 percent, briefly pauses and resumes
|
||||
the worker, and finally closes the backend.
|
||||
+3
-3
@@ -23,7 +23,7 @@ stores the requested playback configuration together with a native
|
||||
asynchronous player handle. It also records the real bit depth accepted
|
||||
by the selected libao output device.
|
||||
|
||||
@section{Audio handles}
|
||||
@section[#:tag "libao-audio-handles"]{Audio handles}
|
||||
|
||||
@defproc[(ao-handle? [v any/c]) boolean?]{
|
||||
|
||||
@@ -216,7 +216,7 @@ A true value pauses playback. @racket[#f] resumes playback.
|
||||
Clears buffered asynchronous playback data for @racket[handle].
|
||||
}
|
||||
|
||||
@section{Playback state}
|
||||
@section[#:tag "libao-playback-state"]{Playback state}
|
||||
|
||||
@defproc[(ao-at-second [handle ao-handle?]) number?]{
|
||||
|
||||
@@ -259,7 +259,7 @@ Returns the current playback volume as reported by the native
|
||||
asynchronous player.
|
||||
}
|
||||
|
||||
@section{Notes}
|
||||
@section[#:tag "libao-notes"]{Notes}
|
||||
|
||||
This module is a higher-level wrapper around the asynchronous FFI layer.
|
||||
It stores the playback configuration in the handle, and reuses that
|
||||
|
||||
@@ -104,7 +104,7 @@ After termination, the underlying decoder is closed and released.
|
||||
The return value is otherwise unspecified.
|
||||
}
|
||||
|
||||
@section{Seeking}
|
||||
@section[#:tag "mp3-decoder-seeking"]{Seeking}
|
||||
|
||||
@defproc[(mp3-seek [handle struct?]
|
||||
[percentage number?])
|
||||
@@ -137,7 +137,7 @@ The procedure sets an internal stop flag and waits until the read loop
|
||||
has terminated, sleeping briefly between checks.
|
||||
}
|
||||
|
||||
@section{Notes}
|
||||
@section[#:tag "mp3-decoder-notes"]{Notes}
|
||||
|
||||
The stream-info hash is shared between initialization and decoding and
|
||||
is updated in place during playback.
|
||||
|
||||
@@ -0,0 +1,91 @@
|
||||
@startuml
|
||||
!theme plain
|
||||
hide empty description
|
||||
top to bottom direction
|
||||
|
||||
title Placed audio player - public state model
|
||||
|
||||
skinparam backgroundColor transparent
|
||||
skinparam shadowing false
|
||||
skinparam roundcorner 14
|
||||
skinparam ArrowThickness 1.2
|
||||
skinparam DefaultFontName "DejaVu Sans"
|
||||
skinparam DefaultFontSize 13
|
||||
|
||||
skinparam state {
|
||||
BackgroundColor #F8F8F8
|
||||
BorderColor #555555
|
||||
FontColor #222222
|
||||
StartColor #555555
|
||||
EndColor #555555
|
||||
|
||||
BackgroundColor<<blue>> #DCEEFF
|
||||
BorderColor<<blue>> #3A7FC4
|
||||
FontColor<<blue>> #123A63
|
||||
|
||||
BackgroundColor<<green>> #E3F6E3
|
||||
BorderColor<<green>> #3C9D40
|
||||
FontColor<<green>> #1E5C22
|
||||
|
||||
BackgroundColor<<purple>> #F0E6FF
|
||||
BorderColor<<purple>> #8A5CC2
|
||||
FontColor<<purple>> #4B2A73
|
||||
|
||||
BackgroundColor<<orange>> #FFE8CC
|
||||
BorderColor<<orange>> #D8842A
|
||||
FontColor<<orange>> #7A4A12
|
||||
|
||||
BackgroundColor<<red>> #FFE5E5
|
||||
BorderColor<<red>> #CC3333
|
||||
FontColor<<red>> #7A1F1F
|
||||
}
|
||||
|
||||
state NotInitialized <<purple>>
|
||||
state FatalError <<red>>
|
||||
state Terminated <<purple>>
|
||||
|
||||
[*] -[#8A5CC2]-> NotInitialized
|
||||
|
||||
NotInitialized -[#3A7FC4]-> Initialized : init
|
||||
NotInitialized -[#CC3333]-> FatalError : command before init
|
||||
|
||||
state Initialized {
|
||||
|
||||
[*] -[#3A7FC4]-> Stopped
|
||||
|
||||
state Stopped <<blue>> {
|
||||
Stopped : volume(p) / set volume
|
||||
Stopped : stop / ignore
|
||||
}
|
||||
|
||||
state Playing <<orange>> {
|
||||
Playing : seek(p) / seek decoder
|
||||
Playing : volume(p) / set volume
|
||||
}
|
||||
|
||||
state Paused <<green>> {
|
||||
Paused : seek(p) / seek decoder
|
||||
Paused : volume(p) / set volume
|
||||
}
|
||||
|
||||
Stopped -[#D8842A]-> Playing : open(file)
|
||||
|
||||
Playing -[#3C9D40]-> Paused : pause #t
|
||||
Paused -[#D8842A]-> Playing : pause #f
|
||||
|
||||
Playing -[#3A7FC4]-> Stopped : audio done
|
||||
Playing -[#3A7FC4]-> Stopped : stop
|
||||
Paused -[#3A7FC4]-> Stopped : stop
|
||||
|
||||
Playing -[#D8842A]-> Playing : open(new-file)
|
||||
|
||||
Playing -[#3A7FC4]-> Stopped : worker exception
|
||||
Paused -[#3A7FC4]-> Stopped : worker exception
|
||||
}
|
||||
|
||||
Initialized -[#8A5CC2]-> Terminated : quit / cleanup
|
||||
|
||||
FatalError -[#555555]-> [*]
|
||||
Terminated -[#555555]-> [*]
|
||||
|
||||
@enduml
|
||||
File diff suppressed because one or more lines are too long
|
After Width: | Height: | Size: 16 KiB |
File diff suppressed because one or more lines are too long
|
After Width: | Height: | Size: 22 KiB |
@@ -0,0 +1,206 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
racket/path
|
||||
early-return
|
||||
simple-log
|
||||
"../audio-player.rkt"))
|
||||
|
||||
@title{Playback Test Program}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
|
||||
@defmodule[racket-audio/play-test]
|
||||
|
||||
The @racketmodname[racket-audio/play-test.rkt] module is a small integration test and
|
||||
usage example for @racketmodname[racket-audio/audio-player]. It is not the public
|
||||
playback API itself; normal applications should use @racketmodname[racket-audio/audio-player]
|
||||
directly. This module shows how a program can create an audio player, observe
|
||||
state updates, react to end-of-stream events, and use the EOF callback to drive
|
||||
a simple playback queue.
|
||||
|
||||
The test is intentionally close to the way an application would use the high
|
||||
level player API. It creates one player handle with @racket[make-audio-player],
|
||||
prints compact progress information from the state callback, and starts the
|
||||
next file from the EOF callback when queue mode is enabled.
|
||||
|
||||
@section{Purpose}
|
||||
|
||||
The test exercises three parts of the player wrapper:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{state callback handling, including cached position, duration, buffer
|
||||
size, volume, and logical player state;}
|
||||
@item{EOF callback handling, including starting another file after the
|
||||
current stream has reached decoder end-of-stream;}
|
||||
@item{place based playback through @racket[make-audio-player]'s
|
||||
@racket[#:use-place] argument.}]
|
||||
|
||||
The file depends on @filepath{tests.rkt} for the concrete test files, such as
|
||||
@racket[test-file2], @racket[test-file3], and @racket[test-file4]. The test
|
||||
therefore documents the integration pattern rather than a portable standalone
|
||||
program.
|
||||
|
||||
@section{Selecting the test mode}
|
||||
|
||||
The module contains a small mode variable:
|
||||
|
||||
@racketblock[
|
||||
(define run-queue #f)
|
||||
|
||||
(define (set-test a)
|
||||
(set! run-queue a))]
|
||||
|
||||
When @racket[run-queue] is @racket['queue], the EOF callback consumes files
|
||||
from @racket[play-queue]. When it is @racket['once], the first EOF callback
|
||||
starts @racket[test-file3] once and then disables that mode. With the default
|
||||
@racket[#f] value, the final kickoff call does not start playback.
|
||||
|
||||
For queue playback, select queue mode before the kickoff call:
|
||||
|
||||
@racketblock[
|
||||
(set-test 'queue)]
|
||||
|
||||
In the current test file the kickoff is performed by calling the EOF callback
|
||||
manually at the end of the module. That is a convenient test idiom: the same
|
||||
callback that advances the queue after a stream has finished is also reused to
|
||||
start the first stream.
|
||||
|
||||
@section{Queue setup}
|
||||
|
||||
The queue itself is a simple list of path values supplied by
|
||||
@filepath{tests.rkt}:
|
||||
|
||||
@racketblock[
|
||||
(define play-queue (list test-file2 test-file3 test-file4))]
|
||||
|
||||
The queue is destructive in the ordinary Racket sense: each successful EOF
|
||||
advance starts @racket[(car play-queue)] and then updates @racket[play-queue]
|
||||
to @racket[(cdr play-queue)]. When the queue is empty, the callback shuts the
|
||||
player down with @racket[audio-quit!].
|
||||
|
||||
@section{Formatting state output}
|
||||
|
||||
The helper @racket[to-time-str] turns a second count into a compact
|
||||
@tt{mm:ss} string:
|
||||
|
||||
@racketblock[
|
||||
(define (to-time-str s*)
|
||||
(let* ((s (round s*))
|
||||
(minutes (quotient s 60))
|
||||
(seconds (remainder s 60)))
|
||||
(sprintf "%02d:%02d" minutes seconds)))]
|
||||
|
||||
The state callback uses this helper to print progress lines that are easier to
|
||||
read than raw seconds.
|
||||
|
||||
@section{State callback}
|
||||
|
||||
The state callback has the shape expected by @racket[make-audio-player]:
|
||||
|
||||
@racketblock[
|
||||
(define (audio-player-state h st)
|
||||
...)]
|
||||
|
||||
The first argument is the player handle and the second argument is the state
|
||||
hash received from the worker side. The callback begins with an
|
||||
@racket[early-return] guard:
|
||||
|
||||
@racketblock[
|
||||
(early-return
|
||||
((? (not (audio-play? h)) => 'done))
|
||||
...)]
|
||||
|
||||
This avoids using a handle after it has been invalidated, for example after
|
||||
@racket[audio-quit!]. The rest of the callback reads the current file name,
|
||||
position, duration, logical player state, volume, buffer size, and diagnostic
|
||||
message. It prints at most one line per rounded second by comparing the
|
||||
current second with @racket[current-sec].
|
||||
|
||||
The output line is deliberately compact. It contains the current file name,
|
||||
music id, playback time, duration, logical state, volume, buffer size, and the
|
||||
message stored in the state hash.
|
||||
|
||||
@section{EOF callback and queue advancement}
|
||||
|
||||
The EOF callback is where the queue behaviour is implemented:
|
||||
|
||||
@racketblock[
|
||||
(define (audio-player-eof h)
|
||||
(dbg-sound "audio-player-eof called")
|
||||
(when (eq? run-queue 'queue)
|
||||
(if (null? play-queue)
|
||||
(audio-quit! h)
|
||||
(begin
|
||||
(audio-play! h (car play-queue))
|
||||
(set! play-queue (cdr play-queue))))))]
|
||||
|
||||
In queue mode, an empty queue means that playback is finished and the player is
|
||||
closed with @racket[audio-quit!]. Otherwise the next file is started with
|
||||
@racket[audio-play!] and removed from the queue.
|
||||
|
||||
The same callback also contains a small @racket['once] mode:
|
||||
|
||||
@racketblock[
|
||||
(when (eq? run-queue 'once)
|
||||
(set! run-queue #f)
|
||||
(audio-play! h test-file3))]
|
||||
|
||||
That mode is useful when testing a single explicit transition from an EOF event
|
||||
to a new file.
|
||||
|
||||
@section{Creating the player}
|
||||
|
||||
The test creates the player with the two callbacks and an explicit place-mode
|
||||
flag:
|
||||
|
||||
@racketblock[
|
||||
(define place-mode #t)
|
||||
|
||||
(define h
|
||||
(make-audio-player audio-player-state
|
||||
audio-player-eof
|
||||
#:use-place place-mode))]
|
||||
|
||||
With @racket[place-mode] set to @racket[#t], the player runs the playback side
|
||||
in a separate place. This is the normal robustness mode for audio playback,
|
||||
because the decoder and audio feeder run in a separate Racket VM. Setting
|
||||
@racket[place-mode] to @racket[#f] runs the same command loop in a Racket
|
||||
thread with ordinary asynchronous channels, which can be easier to debug from
|
||||
DrRacket.
|
||||
|
||||
@section{Starting the test}
|
||||
|
||||
At the end of the module, logging is sent to the display and the EOF callback
|
||||
is called once by hand:
|
||||
|
||||
@racketblock[
|
||||
(sl-log-to-display)
|
||||
(audio-player-eof h)]
|
||||
|
||||
Calling @racket[audio-player-eof] manually may look unusual, but it keeps the
|
||||
queue logic in one place. The first call starts the first queued file; later
|
||||
calls are made by the player wrapper when the decoder reports end-of-stream.
|
||||
|
||||
A typical queue test therefore looks like this in the source:
|
||||
|
||||
@racketblock[
|
||||
(set-test 'queue)
|
||||
|
||||
(sl-log-to-display)
|
||||
(audio-player-eof h)]
|
||||
|
||||
@section{Integration pattern}
|
||||
|
||||
The important pattern for an application is not the global variables in the
|
||||
test file, but the division of responsibility:
|
||||
|
||||
@itemlist[#:style 'compact
|
||||
@item{create one player with @racket[make-audio-player];}
|
||||
@item{keep display or application state in the state callback;}
|
||||
@item{keep queue advancement in the EOF callback;}
|
||||
@item{use @racket[audio-play!] to start the next file;}
|
||||
@item{use @racket[audio-quit!] when the queue is exhausted.}]
|
||||
|
||||
An application will usually wrap the queue in its own data structure instead of
|
||||
using a top-level mutable list, but the control flow is the same.
|
||||
@@ -0,0 +1,123 @@
|
||||
@startuml
|
||||
!theme plain
|
||||
hide empty description
|
||||
|
||||
title Placed audio player - command loop and worker detail
|
||||
|
||||
skinparam backgroundColor transparent
|
||||
skinparam shadowing false
|
||||
skinparam roundcorner 14
|
||||
skinparam ArrowThickness 1.2
|
||||
skinparam DefaultFontName "DejaVu Sans"
|
||||
skinparam DefaultFontSize 13
|
||||
|
||||
skinparam state {
|
||||
BackgroundColor #F8F8F8
|
||||
BorderColor #555555
|
||||
FontColor #222222
|
||||
StartColor #555555
|
||||
EndColor #555555
|
||||
|
||||
BackgroundColor<<blue>> #DCEEFF
|
||||
BorderColor<<blue>> #3A7FC4
|
||||
FontColor<<blue>> #123A63
|
||||
|
||||
BackgroundColor<<green>> #E3F6E3
|
||||
BorderColor<<green>> #3C9D40
|
||||
FontColor<<green>> #1E5C22
|
||||
|
||||
BackgroundColor<<orange>> #FFE8CC
|
||||
BorderColor<<orange>> #D8842A
|
||||
FontColor<<orange>> #7A4A12
|
||||
|
||||
BackgroundColor<<red>> #FFE5E5
|
||||
BorderColor<<red>> #CC3333
|
||||
FontColor<<red>> #7A1F1F
|
||||
|
||||
BackgroundColor<<gray>> #F2F2F2
|
||||
BorderColor<<gray>> #888888
|
||||
FontColor<<gray>> #444444
|
||||
}
|
||||
|
||||
state "Command loop:\nreplace active worker" as A <<gray>> {
|
||||
[*] -down-> CurrentWorkerActive
|
||||
|
||||
state "Current worker active" as CurrentWorkerActive <<orange>>
|
||||
state "Interrupt requested" as InterruptRequested <<green>>
|
||||
state "Waiting for worker" as WaitingForWorker <<green>>
|
||||
state "Starting new worker" as StartingNewWorker <<orange>>
|
||||
state "New worker active" as NewWorkerActive <<orange>>
|
||||
|
||||
InterruptRequested : entry / feed-interrupted := #t
|
||||
InterruptRequested : entry / ao-clear-async
|
||||
InterruptRequested : entry / player-state := stopped
|
||||
InterruptRequested : entry / audio-stop
|
||||
|
||||
WaitingForWorker : do / wait until feeding-audio = #f
|
||||
|
||||
StartingNewWorker : entry / thread-wait
|
||||
StartingNewWorker : entry / audio-open
|
||||
StartingNewWorker : entry / player-state := playing
|
||||
StartingNewWorker : entry / spawn worker
|
||||
|
||||
CurrentWorkerActive -down-> InterruptRequested : open(new)
|
||||
InterruptRequested -down-> WaitingForWorker
|
||||
WaitingForWorker -down-> StartingNewWorker : ready
|
||||
StartingNewWorker -down-> NewWorkerActive
|
||||
|
||||
NewWorkerActive -down-> [*]
|
||||
}
|
||||
|
||||
state "Worker thread lifecycle" as B <<gray>> {
|
||||
[*] -down-> WorkerIdle
|
||||
|
||||
state "WorkerIdle" as WorkerIdle <<blue>>
|
||||
state "WorkerExited" as WorkerExited <<blue>>
|
||||
state "WorkerFailed" as WorkerFailed <<red>>
|
||||
|
||||
WorkerIdle -down-> C : open(file)\n/ audio-open\nspawn worker
|
||||
|
||||
state "Worker active" as C <<orange>> {
|
||||
C : entry / feeding-audio := #t
|
||||
C : exit / feeding-audio := #f
|
||||
|
||||
[*] -right-> Reading
|
||||
|
||||
state "Reading" as Reading <<orange>>
|
||||
state "DrainingAO" as DrainingAO <<green>>
|
||||
state "MarkStopped" as MarkStopped <<blue>>
|
||||
state "WorkerDone" as WorkerDone <<blue>>
|
||||
|
||||
Reading : do / audio-read
|
||||
Reading : pause #t / ao-pause #t and wait
|
||||
Reading : pause #f / ao-pause #f
|
||||
|
||||
DrainingAO : do / wait until AO queue drains
|
||||
DrainingAO : pause #t / ao-pause #t
|
||||
DrainingAO : pause #f / ao-pause #f
|
||||
|
||||
Reading -right-> DrainingAO : audio-read returns\n[not feed-interrupted]\n/ emit audio-done
|
||||
DrainingAO -right-> MarkStopped : [AO queue empty\nand file-id is current]
|
||||
MarkStopped -right-> WorkerDone : / player-state := stopped
|
||||
WorkerDone -right-> [*]
|
||||
|
||||
Reading -down-> WorkerDone : [feed-interrupted]\n/ feed-interrupted := #f
|
||||
DrainingAO -down-> WorkerDone : [AO closed,\nqueue grows,\nor old file-id]
|
||||
|
||||
note bottom of DrainingAO
|
||||
The file-id check prevents an old worker
|
||||
from stopping a newly opened file.
|
||||
end note
|
||||
}
|
||||
|
||||
C -down-> WorkerExited : worker exits
|
||||
C -down-> WorkerFailed : exception\n/ emit exception\nplayer-state := stopped
|
||||
|
||||
WorkerExited -down-> [*]
|
||||
WorkerFailed -down-> [*]
|
||||
}
|
||||
|
||||
A -[hidden]right-> B
|
||||
|
||||
|
||||
@enduml
|
||||
@@ -0,0 +1,37 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require racket/runtime-path
|
||||
scribble/core
|
||||
scribble/html-properties)
|
||||
|
||||
@(define-runtime-path rktplayer-logo "rktplayer.svg")
|
||||
|
||||
@(define title-logo-style
|
||||
(style #f
|
||||
(list (attributes
|
||||
'((style . "float: right; margin-left: 1.5em; margin-bottom: 0.5em;"))))))
|
||||
|
||||
@elem[#:style title-logo-style]{@image[#:scale 0.25 rktplayer-logo]}
|
||||
|
||||
@title{@elem{racket-audio}}
|
||||
|
||||
@table-of-contents[]
|
||||
|
||||
@include-section["intro.scrbl"]
|
||||
@include-section["audio-player.scrbl"]
|
||||
@include-section["audio-sniffer.scrbl"]
|
||||
@include-section["taglib.scrbl"]
|
||||
@include-section["audio-encoder.scrbl"]
|
||||
@include-section["encoder-test.scrbl"]
|
||||
@include-section["play-test.scrbl"]
|
||||
@include-section["audio-placed-player.scrbl"]
|
||||
@include-section["audio-decoder.scrbl"]
|
||||
@include-section["libao-async-ffi-racket.scrbl"]
|
||||
@include-section["flac-decoder.scrbl"]
|
||||
@include-section["mp3-decoder.scrbl"]
|
||||
@include-section["ffmpeg-decoder.scrbl"]
|
||||
@include-section["libao.scrbl"]
|
||||
@include-section["ffmpeg-definitions.scrbl"]
|
||||
@include-section["ffmpeg-ffi.scrbl"]
|
||||
|
||||
@index-section[]
|
||||
@@ -0,0 +1,73 @@
|
||||
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||
<!-- Generator: Adobe Illustrator 15.1.0, SVG Export Plug-In . SVG Version: 6.00 Build 0) -->
|
||||
|
||||
<svg
|
||||
version="1.1"
|
||||
id="circle_pieces"
|
||||
x="0px"
|
||||
y="0px"
|
||||
width="700"
|
||||
height="700"
|
||||
viewBox="0 0 700 699.99999"
|
||||
enable-background="new 0 0 511.875 511.824"
|
||||
xml:space="preserve"
|
||||
sodipodi:docname="rktplayer.svg"
|
||||
inkscape:version="1.4.3 (0d15f75042, 2025-12-25)"
|
||||
inkscape:export-filename="rktplayer.png"
|
||||
inkscape:export-xdpi="96"
|
||||
inkscape:export-ydpi="96"
|
||||
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
|
||||
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
|
||||
xmlns="http://www.w3.org/2000/svg"
|
||||
xmlns:svg="http://www.w3.org/2000/svg"><defs
|
||||
id="defs1" /><sodipodi:namedview
|
||||
id="namedview1"
|
||||
pagecolor="#ffffff"
|
||||
bordercolor="#000000"
|
||||
borderopacity="0.25"
|
||||
inkscape:showpageshadow="2"
|
||||
inkscape:pageopacity="0.0"
|
||||
inkscape:pagecheckerboard="0"
|
||||
inkscape:deskcolor="#d1d1d1"
|
||||
inkscape:zoom="2.6152606"
|
||||
inkscape:cx="442.21215"
|
||||
inkscape:cy="327.30964"
|
||||
inkscape:window-width="3840"
|
||||
inkscape:window-height="2088"
|
||||
inkscape:window-x="0"
|
||||
inkscape:window-y="0"
|
||||
inkscape:window-maximized="1"
|
||||
inkscape:current-layer="g2" />
|
||||
|
||||
|
||||
|
||||
|
||||
<g
|
||||
id="g2"><ellipse
|
||||
style="fill:#ffffff;stroke:none;stroke-width:12.2336"
|
||||
id="path5"
|
||||
cx="340.64243"
|
||||
cy="411.03333"
|
||||
rx="224.86732"
|
||||
ry="244.94084" /><path
|
||||
id="blue-piece"
|
||||
fill="#3e5ba9"
|
||||
d="m 517.53252,561.05183 c 29.98772,-41.38652 47.87279,-93.56675 47.87279,-150.27611 0,-134.46841 -100.55629,-243.4773 -224.59995,-243.4773 -26.98291,0 -52.853,5.16309 -76.82046,14.61962 91.18247,51.85123 211.79537,221.0202 253.54762,379.13379 z"
|
||||
style="stroke-width:0.923962" /><path
|
||||
id="left-red-piece"
|
||||
fill="#9f1d20"
|
||||
d="m 308.63814,322.60871 c -35.03626,-40.91705 -74.27268,-73.41269 -115.82881,-94.96454 -46.95076,44.62655 -76.60304,110.12097 -76.60304,183.13155 0,61.38953 20.9662,117.46493 55.54987,160.29253 30.48734,-99.2955 87.80229,-195.00079 136.88198,-248.45954 z"
|
||||
style="stroke-width:0.923962" /><path
|
||||
id="bottom-red-piece"
|
||||
fill="#9f1d20"
|
||||
d="M 350.023,377.81831 C 301.39945,434.6258 252.94628,534.06945 235.41085,625.818 c 31.43155,18.14057 67.30198,28.43598 105.3954,28.43598 39.16364,0 75.97918,-10.87646 108.03459,-29.97904 C 430.36385,531.72504 395.48556,446.9645 350.023,377.81831 Z"
|
||||
style="stroke-width:0.923962" /><path
|
||||
d="m 130.9,323.08501 c 19.13656,-1.81007 36.94048,13.59009 40.79155,36.14648 l 27.27181,159.74052 c 4.10781,24.06017 -9.2145,47.15353 -29.75784,51.57967 -20.54206,4.42609 -46.83685,-11.17988 -50.94473,-35.24153 L 90.989079,375.57159 c -4.107817,-24.06018 15.527281,-47.46572 36.069341,-51.8918 1.28388,-0.27664 2.5658,-0.47409 3.84158,-0.59478 z"
|
||||
style="stroke-width:3;stroke-linejoin:round;fill:#999999;stroke:#000000;stroke-opacity:1;stroke-dasharray:none"
|
||||
id="path12" /><path
|
||||
d="m 564.07865,327.18539 c -19.13791,-1.79576 -36.9303,13.61771 -40.76451,36.17698 l -27.15231,159.76087 c -4.08982,24.06324 9.24977,47.14663 29.7964,51.5574 20.54537,4.41072 46.82848,-11.2149 50.91837,-35.27963 L 604.02882,379.6421 c 4.08982,-24.06324 -15.56278,-47.45409 -36.10814,-51.86481 -1.28409,-0.27567 -2.56616,-0.47217 -3.84203,-0.5919 z"
|
||||
style="stroke-width:3;stroke-linejoin:round;fill:#999999;stroke:#000000;stroke-opacity:1;stroke-dasharray:none"
|
||||
id="path12-5" /><path
|
||||
d="m 343.63672,38.474609 c 0,0 -324.531251,-6.13e-4 -324.531251,295.406251 0,132.9331 34.615466,177.24529 51.923828,192.01562 0,0 51.925783,29.54031 34.619143,-11.07812 0,-34.17562 -17.310549,-107.08399 -17.310549,-107.08399 0,0 -17.308594,-0.002 -17.308594,-73.85351 0,-88.62206 69.234883,-243.708985 259.626953,-243.708985 h 34.61523 c 190.39209,0 259.62696,155.086925 259.62696,243.708985 0,73.85171 -17.3086,73.85351 -17.3086,73.85351 0,0 -17.31054,72.90837 -17.31054,107.08399 -17.30663,40.61843 34.61914,11.07812 34.61914,11.07812 17.30837,-14.77033 51.92383,-59.08252 51.92383,-192.01562 0,-295.406864 -324.53125,-295.406251 -324.53125,-295.406251 z"
|
||||
style="stroke-width:3;stroke-linejoin:round;fill:#cccccc;stroke:#000000;stroke-opacity:1;stroke-dasharray:none"
|
||||
id="path11" /></g></svg>
|
||||
|
After Width: | Height: | Size: 4.2 KiB |
@@ -0,0 +1,339 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
racket/contract
|
||||
racket/path
|
||||
racket/draw
|
||||
"../taglib.rkt"))
|
||||
|
||||
@title{TagLib Metadata}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@defmodule[racket-audio/taglib]
|
||||
|
||||
The @racketmodname[racket-audio/taglib] module provides the high level metadata
|
||||
API used by the audio package. It wraps the lower level TagLib C FFI module and
|
||||
presents a Racket API for common tags, generic properties, audio properties, and
|
||||
embedded cover art.
|
||||
|
||||
The module can be used in two modes. The default mode is read-only and returns
|
||||
a snapshot of the metadata. A handle opened with @racket[#:mode 'read-write]
|
||||
keeps the native TagLib file open and can be modified with the setter
|
||||
procedures documented below. Changes are written to the media file by calling
|
||||
@racket[tags-save!].
|
||||
|
||||
The name @racket[id3-tags] is historical. The implementation uses TagLib, so
|
||||
the usable file types are the file types supported by the TagLib library
|
||||
available at run time.
|
||||
|
||||
@section{Opening and closing tag handles}
|
||||
|
||||
@defproc[(id3-tags [file path-string?]
|
||||
[#:mode mode (or/c 'read 'read-only 'read-write 'write) 'read])
|
||||
any/c]{
|
||||
Opens @racket[file] through TagLib and returns an opaque tag handle. In the
|
||||
default read-only mode, the module copies the values needed on the Racket side,
|
||||
frees the native TagLib objects, and returns a snapshot handle.
|
||||
|
||||
In read-write mode, the native TagLib file remains open. Setter procedures may
|
||||
then be used to modify fields, properties, and pictures. Call
|
||||
@racket[tags-save!] to write changes and @racket[tags-close!] to close the
|
||||
native handle.
|
||||
|
||||
On Windows, the implementation retries with the wide-character TagLib open
|
||||
function when the normal open function does not produce a valid TagLib file.}
|
||||
|
||||
@defproc[(call-with-id3-tags [file path-string?]
|
||||
[proc procedure?]
|
||||
[#:mode mode (or/c 'read 'read-only 'read-write 'write) 'read])
|
||||
any/c]{
|
||||
Opens @racket[file], calls @racket[proc] with the tag handle, and closes the
|
||||
handle afterwards with @racket[tags-close!]. This is most useful for
|
||||
read-write code because it avoids leaking the native TagLib file handle.}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-valid? [tags any/c]) boolean?]
|
||||
@defproc[(tags-read-write? [tags any/c]) boolean?]
|
||||
@defproc[(tags-closed? [tags any/c]) boolean?])]{
|
||||
Return handle state. @racket[tags-valid?] reports whether TagLib opened the
|
||||
file successfully. @racket[tags-read-write?] reports whether the handle was
|
||||
opened in read-write mode. @racket[tags-closed?] reports whether the native
|
||||
TagLib file handle has been closed.}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-save! [tags any/c]) boolean?]
|
||||
@defproc[(tags-close! [tags any/c]) void?])]{
|
||||
@racket[tags-save!] writes pending changes for a read-write handle to the media
|
||||
file. @racket[tags-close!] closes the native TagLib file handle. Closing a
|
||||
read-only snapshot is harmless.
|
||||
}
|
||||
|
||||
@racketblock[
|
||||
(call-with-id3-tags "track.flac"
|
||||
(lambda (tags)
|
||||
(when (tags-valid? tags)
|
||||
(tags-title! tags "New title")
|
||||
(tags-save! tags)))
|
||||
#:mode 'read-write)]
|
||||
|
||||
@section{Common tag fields}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-title [tags any/c]) string?]
|
||||
@defproc[(tags-album [tags any/c]) string?]
|
||||
@defproc[(tags-artist [tags any/c]) string?]
|
||||
@defproc[(tags-comment [tags any/c]) string?]
|
||||
@defproc[(tags-genre [tags any/c]) string?])]{
|
||||
Return the common textual fields from the TagLib tag interface. Missing fields
|
||||
are returned as the empty string.}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-year [tags any/c]) integer?]
|
||||
@defproc[(tags-track [tags any/c]) integer?])]{
|
||||
Return the year and track number from the common TagLib tag interface. Missing
|
||||
numeric values are returned as @racket[-1].}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-title! [tags any/c] [value (or/c string? 'clear)]) void?]
|
||||
@defproc[(tags-album! [tags any/c] [value (or/c string? 'clear)]) void?]
|
||||
@defproc[(tags-artist! [tags any/c] [value (or/c string? 'clear)]) void?]
|
||||
@defproc[(tags-comment! [tags any/c] [value (or/c string? 'clear)]) void?]
|
||||
@defproc[(tags-genre! [tags any/c] [value (or/c string? 'clear)]) void?])]{
|
||||
Set common textual fields on a read-write handle. Passing @racket['clear]
|
||||
clears the field. Call @racket[tags-save!] to persist the change.}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-year! [tags any/c] [value (or/c exact-nonnegative-integer? 'clear)]) void?]
|
||||
@defproc[(tags-track! [tags any/c] [value (or/c exact-nonnegative-integer? 'clear)]) void?])]{
|
||||
Set numeric common fields on a read-write handle. Passing @racket['clear]
|
||||
writes zero through the TagLib C API and updates the Racket-side cache to
|
||||
@racket[-1].}
|
||||
|
||||
@section{Selected generic fields}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-composer [tags any/c]) (or/c string? (listof string?))]
|
||||
@defproc[(tags-album-artist [tags any/c]) (or/c string? (listof string?))]
|
||||
@defproc[(tags-disc-number [tags any/c]) (or/c number? #f)])]{
|
||||
Return selected values from the generic TagLib property store. The composer is
|
||||
read from the @racket['composer] key, the album artist from
|
||||
@racket['albumartist], and the disc number from @racket['discnumber]. Use
|
||||
@racket[tags-keys] and @racket[tags-ref] for direct access to the complete
|
||||
generic property store.}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-composer! [tags any/c] [value (or/c string? 'clear)]) void?]
|
||||
@defproc[(tags-album-artist! [tags any/c] [value (or/c string? 'clear)]) void?]
|
||||
@defproc[(tags-disc-number! [tags any/c]
|
||||
[value (or/c exact-nonnegative-integer? string? 'clear)])
|
||||
void?])]{
|
||||
Set selected generic properties on a read-write handle. The disc number may be
|
||||
provided as a number or as the exact string that should be written.}
|
||||
|
||||
@section{Audio properties}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-length [tags any/c]) integer?]
|
||||
@defproc[(tags-sample-rate [tags any/c]) integer?]
|
||||
@defproc[(tags-bit-rate [tags any/c]) integer?]
|
||||
@defproc[(tags-channels [tags any/c]) integer?])]{
|
||||
Return audio properties reported by TagLib: length in seconds, sample rate in
|
||||
Hz, bit rate in kbit/s, and number of channels. These values are read-only
|
||||
properties of the media stream, not editable tags. Missing values are returned
|
||||
as @racket[-1].}
|
||||
|
||||
@section{Generic properties}
|
||||
|
||||
@defproc[(tags-keys [tags any/c]) (listof symbol?)]{
|
||||
Returns the generic TagLib property keys found in the file. Keys are
|
||||
lower-cased and converted to symbols.}
|
||||
|
||||
@defproc[(tags-ref [tags any/c] [key symbol?])
|
||||
(or/c (listof string?) #f)]{
|
||||
Returns the list of values associated with @racket[key], or @racket[#f] when the
|
||||
property was not found. Use lower-case symbol keys, matching the values
|
||||
returned by @racket[tags-keys].}
|
||||
|
||||
@defproc[(tags-set! [tags any/c]
|
||||
[key (or/c symbol? string?)]
|
||||
[value (or/c string? 'clear)])
|
||||
void?]{
|
||||
Sets a generic property on a read-write handle. Symbol keys are converted to
|
||||
upper-case TagLib property names; string keys are passed as supplied. Passing
|
||||
@racket['clear] clears the property.}
|
||||
|
||||
@defproc[(tags-set-values! [tags any/c]
|
||||
[key (or/c symbol? string?)]
|
||||
[values (or/c (listof string?) 'clear)])
|
||||
void?]{
|
||||
Replaces a generic property with zero or more values. Passing @racket['clear]
|
||||
removes the property.}
|
||||
|
||||
@defproc[(tags-append! [tags any/c]
|
||||
[key (or/c symbol? string?)]
|
||||
[value string?])
|
||||
void?]{
|
||||
Appends a value to a generic property on a read-write handle.}
|
||||
|
||||
@defproc[(tags-clear! [tags any/c]
|
||||
[key (or/c symbol? string?)])
|
||||
void?]{
|
||||
Clears a generic property on a read-write handle.}
|
||||
|
||||
@racketblock[
|
||||
(call-with-id3-tags "track.flac"
|
||||
(lambda (tags)
|
||||
(tags-set-values! tags 'composer '("Johann Sebastian Bach"))
|
||||
(tags-set! tags 'discnumber "1")
|
||||
(tags-save! tags))
|
||||
#:mode 'read-write)]
|
||||
|
||||
Generic properties may contain multiple values for a single key. The API keeps
|
||||
those values as lists instead of joining them into one string.
|
||||
|
||||
@section{Embedded pictures}
|
||||
|
||||
The module represents embedded artwork as an opaque @deftech{picture value}.
|
||||
The picture value is returned by @racket[tags-picture] and can be inspected with
|
||||
the picture procedures documented below. It can also be written to another
|
||||
file with @racket[tags-picture!] or @racket[tags-append-picture!].
|
||||
|
||||
@defproc[(tags-picture [tags any/c]) (or/c any/c #f)]{
|
||||
Returns the embedded picture value, or @racket[#f] when the file has no picture
|
||||
that the underlying FFI layer could read.}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-picture->kind [tags any/c]) (or/c integer? #f)]
|
||||
@defproc[(tags-picture->mimetype [tags any/c]) (or/c string? #f)]
|
||||
@defproc[(tags-picture->description [tags any/c]) (or/c string? #f)]
|
||||
@defproc[(tags-picture->size [tags any/c]) (or/c integer? #f)]
|
||||
@defproc[(tags-picture->ext [tags any/c]) (or/c symbol? #f)])]{
|
||||
Return selected information about the embedded picture. The kind is the
|
||||
numeric picture type reported by the FFI layer. The MIME type is the stored
|
||||
MIME type, such as @racket["image/jpeg"] or @racket["image/png"]. The size is
|
||||
the number of bytes in the embedded image. The extension helper returns
|
||||
@racket['jpg], @racket['png], or @racket[#f] when the MIME type is not
|
||||
recognized.}
|
||||
|
||||
@defproc[(tags-picture->bitmap [tags any/c])
|
||||
(or/c (is-a?/c bitmap%) #f)]{
|
||||
Reads the embedded picture bytes with @racket[read-bitmap] and returns a
|
||||
@racket[bitmap%] object. If there is no embedded picture, the result is
|
||||
@racket[#f].}
|
||||
|
||||
@defproc[(tags-picture->file [tags any/c]
|
||||
[path path-string?])
|
||||
boolean?]{
|
||||
Writes the embedded picture bytes to @racket[path] in binary mode, replacing an
|
||||
existing file. The procedure returns @racket[#t] when a picture was written and
|
||||
@racket[#f] when the tag handle has no picture.}
|
||||
|
||||
@defproc[(make-tags-picture [mimetype string?]
|
||||
[kind integer?]
|
||||
[data (or/c bytes? (is-a?/c bitmap%))]
|
||||
[#:description description string? ""])
|
||||
id3-picture?]{
|
||||
Creates a picture value from encoded image bytes or from a @racket[bitmap%].
|
||||
The MIME type should normally be @racket["image/jpeg"] or @racket["image/png"].}
|
||||
|
||||
@defproc[(make-tags-picture-from-bitmap [bitmap (is-a?/c bitmap%)]
|
||||
[kind integer?]
|
||||
[#:mimetype mimetype string? "image/png"]
|
||||
[#:description description string? ""])
|
||||
id3-picture?]{
|
||||
Creates a picture value by encoding @racket[bitmap] as PNG or JPEG.}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(tags-picture! [tags any/c]
|
||||
[picture (or/c id3-picture? 'clear)])
|
||||
void?]
|
||||
@defproc[(tags-append-picture! [tags any/c]
|
||||
[picture id3-picture?])
|
||||
void?]
|
||||
@defproc[(tags-clear-picture! [tags any/c]) void?])]{
|
||||
Set, append, or clear embedded artwork on a read-write handle. The procedures
|
||||
use TagLib complex properties underneath. Call @racket[tags-save!] to persist
|
||||
the change.}
|
||||
|
||||
@racketblock[
|
||||
(define cover
|
||||
(make-tags-picture "image/jpeg" 3 (file->bytes "cover.jpg")
|
||||
#:description "Cover"))
|
||||
|
||||
(call-with-id3-tags "track.flac"
|
||||
(lambda (tags)
|
||||
(tags-picture! tags cover)
|
||||
(tags-save! tags))
|
||||
#:mode 'read-write)]
|
||||
|
||||
@section{Picture values}
|
||||
|
||||
@deftogether[
|
||||
(@defproc[(id3-picture? [v any/c]) boolean?]
|
||||
@defproc[(id3-picture-mimetype [picture id3-picture?]) string?]
|
||||
@defproc[(id3-picture-kind [picture id3-picture?]) integer?]
|
||||
@defproc[(id3-picture-size [picture id3-picture?]) integer?]
|
||||
@defproc[(id3-picture-bytes [picture id3-picture?]) bytes?]
|
||||
@defproc[(id3-picture-description [picture id3-picture?]) string?])]{
|
||||
Access the fields of a picture value. These procedures are useful when the
|
||||
caller wants to process the image bytes directly or pass a picture to another
|
||||
component.}
|
||||
|
||||
@section{Converting to a hash}
|
||||
|
||||
@defproc[(tags->hash [tags any/c]) hash?]{
|
||||
Returns a mutable hash containing the core values copied from the tag handle.
|
||||
The hash contains the keys @racket['valid?], @racket['read-write?],
|
||||
@racket['closed?], @racket['title], @racket['album], @racket['artist],
|
||||
@racket['comment], @racket['composer], @racket['genre], @racket['year],
|
||||
@racket['track], @racket['length], @racket['sample-rate], @racket['bit-rate],
|
||||
@racket['channels], @racket['picture], and @racket['keys].
|
||||
|
||||
The hash is intended as a convenient snapshot for application code. Generic
|
||||
property values are not expanded into the hash; use @racket[tags-ref] for those
|
||||
values.}
|
||||
|
||||
@section{Copying tags and pictures}
|
||||
|
||||
The encoder pipeline uses this module for metadata transfer. For FLAC output,
|
||||
@racket[audio-encode] first writes the audio stream and then opens the resulting
|
||||
file with @racket[id3-tags] in read-write mode to copy tags and pictures through
|
||||
TagLib. For Opus output, comments and pictures are supplied to
|
||||
@tt{libopusenc} before encoding starts, because OpusTags are written at the
|
||||
start of the Ogg Opus stream.
|
||||
|
||||
Applications that need explicit metadata editing should use the read-write API
|
||||
directly, as in the examples above.
|
||||
|
||||
@section[#:tag "taglib-example"]{Example}
|
||||
|
||||
@racketblock[
|
||||
(define tags (id3-tags "track.flac"))
|
||||
|
||||
(cond
|
||||
[(not (tags-valid? tags))
|
||||
(printf "No readable tags\n")]
|
||||
[else
|
||||
(printf "Title: ~a\n" (tags-title tags))
|
||||
(printf "Artist: ~a\n" (tags-artist tags))
|
||||
(printf "Album: ~a\n" (tags-album tags))
|
||||
(printf "Length: ~a seconds\n" (tags-length tags))
|
||||
|
||||
(when (tags-picture tags)
|
||||
(define ext (or (tags-picture->ext tags) 'bin))
|
||||
(tags-picture->file tags (format "cover.~a" ext)))])]
|
||||
|
||||
@section{Implementation notes}
|
||||
|
||||
This chapter documents the public @racketmodname["taglib.rkt"] layer. The
|
||||
native TagLib calls are delegated to @racketmodname["taglib-ffi.rkt"], but
|
||||
callers normally should not use that lower level module directly.
|
||||
|
||||
A read-only tag handle is a Racket-side snapshot. A read-write tag handle keeps
|
||||
the native TagLib file open until @racket[tags-close!] is called. Setter
|
||||
procedures update both the native file and the Racket-side cache; the changes
|
||||
are persisted only after @racket[tags-save!] succeeds.
|
||||
|
||||
The implementation normalizes generic property names by lower-casing TagLib
|
||||
property keys and converting them to symbols. Values remain lists of strings
|
||||
because TagLib properties may contain multiple values for one key.
|
||||
+130
-100
@@ -3,8 +3,7 @@
|
||||
(require ffi/unsafe
|
||||
ffi/unsafe/define
|
||||
"private/utils.rkt"
|
||||
"private/downloader.rkt"
|
||||
)
|
||||
"private/downloader.rkt")
|
||||
|
||||
(provide TagLib_File_Type
|
||||
_TagLib_File-pointer
|
||||
@@ -16,6 +15,7 @@
|
||||
taglib_file_new_type
|
||||
taglib_file_is_valid
|
||||
taglib_file_free
|
||||
taglib_file_save
|
||||
|
||||
taglib_file_tag
|
||||
taglib_file_audioproperties
|
||||
@@ -29,6 +29,14 @@
|
||||
taglib_tag_year
|
||||
taglib_tag_track
|
||||
|
||||
taglib_tag_set_title
|
||||
taglib_tag_set_artist
|
||||
taglib_tag_set_album
|
||||
taglib_tag_set_comment
|
||||
taglib_tag_set_genre
|
||||
taglib_tag_set_year
|
||||
taglib_tag_set_track
|
||||
|
||||
taglib_audioproperties_length
|
||||
taglib_audioproperties_bitrate
|
||||
taglib_audioproperties_samplerate
|
||||
@@ -36,36 +44,19 @@
|
||||
|
||||
taglib_property_keys
|
||||
taglib_property_key
|
||||
|
||||
taglib_property_get
|
||||
taglib_property_val
|
||||
|
||||
taglib_property_set
|
||||
taglib_property_set_append
|
||||
taglib_property_free
|
||||
|
||||
taglib_complex_property_set
|
||||
taglib_complex_property_set_append
|
||||
|
||||
taglib-get-picture
|
||||
)
|
||||
|
||||
|
||||
;(define-runtime-path lib-path "..");
|
||||
;
|
||||
;(define libs (let ((os-type (system-type 'os*)))
|
||||
; (if (eq? os-type 'windows)
|
||||
; (list
|
||||
; (build-path lib-path "lib" "dll" "tag")
|
||||
; (build-path lib-path "lib" "dll" "tag_c"))
|
||||
; (let* ((arch (symbol->string (system-type 'arch)))
|
||||
; (subdir (string-append (symbol->string os-type) "-" arch)))
|
||||
; (list
|
||||
; (build-path lib-path "lib" subdir "libtag")
|
||||
; (build-path lib-path "lib" subdir "libtag_c"))))))
|
||||
|
||||
;(define (get-lib l)
|
||||
; (ffi-lib l '("2" #f)
|
||||
; #:get-lib-dirs (λ ()
|
||||
; (cons (build-path ".") (get-lib-search-dirs)))
|
||||
; #:fail (λ ()
|
||||
; (error (format "Cannot find library ~a" l)))
|
||||
; ))
|
||||
taglib-set-picture
|
||||
taglib-append-picture
|
||||
taglib-clear-picture)
|
||||
|
||||
(define zlib (get-lib '("zlib" "libz") '(#f)))
|
||||
(define libtag (get-lib '("tag" "libtag") '("2" #f)))
|
||||
@@ -97,45 +88,39 @@
|
||||
dsf
|
||||
dsdiff
|
||||
shorten
|
||||
)))
|
||||
matroska)))
|
||||
|
||||
(define _TagLib_File-pointer (_cpointer/null 'taglib-file))
|
||||
(define _TagLib_Tag-pointer (_cpointer/null 'taglib-tag))
|
||||
(define _TagLib_AudioProperties-pointer (_cpointer/null 'taglib-audioproperties))
|
||||
|
||||
; TagLib_File *taglib_file_new(const char *filename);
|
||||
(define-tag-c-lib taglib_file_new
|
||||
(_fun _string/utf-8 -> _TagLib_File-pointer ))
|
||||
(_fun _string/utf-8 -> _TagLib_File-pointer))
|
||||
|
||||
; TAGLIB_C_EXPORT TagLib_File *taglib_file_new_wchar(const wchar_t *filename);
|
||||
(define-tag-c-lib taglib_file_new_wchar
|
||||
(_fun _string/utf-16 -> _TagLib_File-pointer ))
|
||||
(_fun _string/utf-16 -> _TagLib_File-pointer))
|
||||
|
||||
; TagLib_File *taglib_file_new_type(const char *filename, TagLib_File_Type type);
|
||||
(define-tag-c-lib taglib_file_new_type
|
||||
(_fun _string/utf-8 TagLib_File_Type -> _TagLib_File-pointer))
|
||||
|
||||
; TagLib_File *taglib_file_new_type_wchar(const char *filename, TagLib_File_Type type);
|
||||
(define-tag-c-lib taglib_file_new_type_wchar
|
||||
(_fun _string/utf-16 TagLib_File_Type -> _TagLib_File-pointer))
|
||||
|
||||
; void taglib_file_free(TagLib_File *file);
|
||||
(define-tag-c-lib taglib_file_free
|
||||
(_fun _TagLib_File-pointer -> _void))
|
||||
|
||||
; BOOL taglib_file_is_valid(const TagLib_File *file);
|
||||
(define-tag-c-lib taglib_file_is_valid
|
||||
(_fun _TagLib_File-pointer -> _bool))
|
||||
|
||||
; TagLib_Tag *taglib_file_tag(const TagLib_File *file);
|
||||
(define-tag-c-lib taglib_file_save
|
||||
(_fun _TagLib_File-pointer -> _bool))
|
||||
|
||||
(define-tag-c-lib taglib_file_tag
|
||||
(_fun _TagLib_File-pointer -> _TagLib_Tag-pointer))
|
||||
|
||||
; const TagLib_AudioProperties *taglib_file_audioproperties(const TagLib_File *file);
|
||||
(define-tag-c-lib taglib_file_audioproperties
|
||||
(_fun _TagLib_File-pointer -> _TagLib_AudioProperties-pointer))
|
||||
|
||||
; void taglib_tag_free_strings(void);
|
||||
(define-tag-c-lib taglib_tag_free_strings
|
||||
(_fun -> _void))
|
||||
|
||||
@@ -150,12 +135,8 @@
|
||||
(_fun _TagLib_Tag-pointer -> _string/utf-8)))
|
||||
((_ name ret-type)
|
||||
(define-tag-c-lib name
|
||||
(_fun _TagLib_Tag-pointer -> ret-type)))
|
||||
))
|
||||
(_fun _TagLib_Tag-pointer -> ret-type)))))
|
||||
|
||||
|
||||
; char *taglib_tag_title(const TagLib_Tag *tag);
|
||||
; etc..
|
||||
(tg taglib_tag_title)
|
||||
(tg taglib_tag_artist)
|
||||
(tg taglib_tag_album)
|
||||
@@ -164,6 +145,23 @@
|
||||
(tg taglib_tag_year _uint)
|
||||
(tg taglib_tag_track _uint)
|
||||
|
||||
(define-syntax tgs
|
||||
(syntax-rules ()
|
||||
((_ name)
|
||||
(define-tag-c-lib name
|
||||
(_fun _TagLib_Tag-pointer _string/utf-8 -> _void)))
|
||||
((_ name arg-type)
|
||||
(define-tag-c-lib name
|
||||
(_fun _TagLib_Tag-pointer arg-type -> _void)))))
|
||||
|
||||
(tgs taglib_tag_set_title)
|
||||
(tgs taglib_tag_set_artist)
|
||||
(tgs taglib_tag_set_album)
|
||||
(tgs taglib_tag_set_comment)
|
||||
(tgs taglib_tag_set_genre)
|
||||
(tgs taglib_tag_set_year _uint)
|
||||
(tgs taglib_tag_set_track _uint)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; audio properties
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -172,11 +170,7 @@
|
||||
(syntax-rules ()
|
||||
((_ name)
|
||||
(define-tag-c-lib name
|
||||
(_fun _TagLib_AudioProperties-pointer -> _int)))
|
||||
))
|
||||
|
||||
; int taglib_audioproperties_length(const TagLib_AudioProperties *audioProperties);
|
||||
; etc...
|
||||
(_fun _TagLib_AudioProperties-pointer -> _int)))))
|
||||
|
||||
(ap taglib_audioproperties_length)
|
||||
(ap taglib_audioproperties_bitrate)
|
||||
@@ -184,24 +178,29 @@
|
||||
(ap taglib_audioproperties_channels)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; keys in the propertymap
|
||||
;; property map
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
; char** taglib_property_keys(const TagLib_File *file);
|
||||
(define-tag-c-lib taglib_property_keys
|
||||
(_fun _TagLib_File-pointer -> (_ptr i _string/utf-8)))
|
||||
|
||||
(define (taglib_property_key keys i)
|
||||
(ptr-ref keys _string/utf-8 i))
|
||||
|
||||
;char** taglib_property_get(const TagLib_File *file, const char *prop);
|
||||
(define-tag-c-lib taglib_property_get
|
||||
(_fun _TagLib_File-pointer _string/utf-8 -> (_ptr i _string/utf-8)))
|
||||
|
||||
(define (taglib_property_val prop i)
|
||||
(ptr-ref prop _string/utf-8 i))
|
||||
|
||||
; void taglib_property_free(char **props);
|
||||
;; value may be NULL to clear the property.
|
||||
(define-tag-c-lib taglib_property_set
|
||||
(_fun _TagLib_File-pointer _string/utf-8 _pointer -> _void))
|
||||
|
||||
;; value may be NULL to clear all values for the property.
|
||||
(define-tag-c-lib taglib_property_set_append
|
||||
(_fun _TagLib_File-pointer _string/utf-8 _pointer -> _void))
|
||||
|
||||
(define-tag-c-lib taglib_property_free
|
||||
(_fun _pointer -> _void))
|
||||
|
||||
@@ -209,40 +208,12 @@
|
||||
;; Picture data
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
;typedef struct {
|
||||
; char *mimeType;
|
||||
; char *description;
|
||||
; char *pictureType;
|
||||
; char *data;
|
||||
; unsigned int size;
|
||||
;} TagLib_Complex_Property_Picture_Data;
|
||||
|
||||
(define-cstruct _TagLib_Complex_Property_Picture_Data
|
||||
(
|
||||
[mimeType _string/utf-8]
|
||||
([mimeType _string/utf-8]
|
||||
[description _string/utf-8]
|
||||
[pictureType _string/utf-8]
|
||||
[data _pointer]
|
||||
[size _uint]
|
||||
))
|
||||
|
||||
|
||||
|
||||
; TagLib_Complex_Property_Attribute*** properties = * taglib_complex_property_get(file, "PICTURE");
|
||||
; * TagLib_File *file = taglib_file_new("myfile.mp3");
|
||||
; * TagLib_Complex_Property_Attribute*** properties =
|
||||
; * taglib_complex_property_get(file, "PICTURE");
|
||||
; * TagLib_Complex_Property_Picture_Data picture;
|
||||
; * taglib_picture_from_complex_property(properties, &picture);
|
||||
; * // Do something with picture.mimeType, picture.description,
|
||||
; * // picture.pictureType, picture.data, picture.size, e.g. extract it.
|
||||
; * FILE *fh = fopen("mypicture.jpg", "wb");
|
||||
; * if(fh) {
|
||||
; * fwrite(picture.data, picture.size, 1, fh);
|
||||
; * fclose(fh);
|
||||
; * }
|
||||
; * taglib_complex_property_free(properties);
|
||||
[size _uint]))
|
||||
|
||||
(define _Complex_Property_Attribute-pointer (_cpointer/null 'taglib-complex-property-attribute))
|
||||
|
||||
@@ -257,24 +228,87 @@
|
||||
(define-tag-c-lib taglib_complex_property_free
|
||||
(_fun _Complex_Property_Attribute-pointer -> _void))
|
||||
|
||||
;TAGLIB_C_EXPORT char** taglib_complex_property_keys(const TagLib_File *file);
|
||||
(define-tag-c-lib taglib_complex_property_keys
|
||||
(_fun _TagLib_File-pointer -> (_ptr i _string/utf-8)))
|
||||
|
||||
; void taglib_complex_property_free_keys(char **keys);
|
||||
(define-tag-c-lib taglib_complex_property_free_keys
|
||||
(_fun _pointer -> _void))
|
||||
|
||||
(define (taglib-get-picture tag-file)
|
||||
(define (cp s) (string-append s ""))
|
||||
(define (to-bytestring data size)
|
||||
;; TagLib_Variant is { enum type; unsigned int size; union value; }.
|
||||
;; For writing pictures we only use pointer-valued union members: stringValue
|
||||
;; and byteVectorValue. A pointer-sized field has the same size/alignment as
|
||||
;; the union on the supported ABIs.
|
||||
(define TagLib_Variant_ByteVector 9)
|
||||
(define TagLib_Variant_String 7)
|
||||
|
||||
(let* ((v (make-vector size 0))
|
||||
(i 0))
|
||||
(while (< i size)
|
||||
(vector-set! v (ptr-ref data _byte i) i)
|
||||
(set! i (+ i 1)))
|
||||
v))
|
||||
(define-cstruct _TagLib_Variant
|
||||
([type _int]
|
||||
[size _uint]
|
||||
[value _pointer]))
|
||||
|
||||
(define-cstruct _TagLib_Complex_Property_Attribute
|
||||
([key _pointer]
|
||||
[value _TagLib_Variant]))
|
||||
|
||||
(define-tag-c-lib taglib_complex_property_set
|
||||
(_fun _TagLib_File-pointer _string/utf-8 _pointer -> _bool))
|
||||
|
||||
(define-tag-c-lib taglib_complex_property_set_append
|
||||
(_fun _TagLib_File-pointer _string/utf-8 _pointer -> _bool))
|
||||
|
||||
(define (bytes->malloc-ptr bs [nul? #f])
|
||||
(define len (bytes-length bs))
|
||||
(define ptr (malloc _byte (+ len (if nul? 1 0)) 'atomic-interior))
|
||||
(for ([i (in-range len)]) (ptr-set! ptr _byte i (bytes-ref bs i)))
|
||||
(when nul? (ptr-set! ptr _byte len 0))
|
||||
ptr)
|
||||
|
||||
(define (string->malloc-cstring s)
|
||||
(bytes->malloc-ptr (string->bytes/utf-8 s) #t))
|
||||
|
||||
(define (picture->complex-property data size description mimetype picture-type)
|
||||
(define data-ptr (bytes->malloc-ptr data #f))
|
||||
(define data-key (string->malloc-cstring "data"))
|
||||
(define mime-key (string->malloc-cstring "mimeType"))
|
||||
(define desc-key (string->malloc-cstring "description"))
|
||||
(define type-key (string->malloc-cstring "pictureType"))
|
||||
(define mime-ptr (string->malloc-cstring mimetype))
|
||||
(define desc-ptr (string->malloc-cstring description))
|
||||
(define type-ptr (string->malloc-cstring picture-type))
|
||||
(define data-attr (make-TagLib_Complex_Property_Attribute data-key (make-TagLib_Variant TagLib_Variant_ByteVector size data-ptr)))
|
||||
(define mime-attr (make-TagLib_Complex_Property_Attribute mime-key (make-TagLib_Variant TagLib_Variant_String 0 mime-ptr)))
|
||||
(define desc-attr (make-TagLib_Complex_Property_Attribute desc-key (make-TagLib_Variant TagLib_Variant_String 0 desc-ptr)))
|
||||
(define type-attr (make-TagLib_Complex_Property_Attribute type-key (make-TagLib_Variant TagLib_Variant_String 0 type-ptr)))
|
||||
(define propv (malloc _pointer 5 'atomic-interior))
|
||||
(ptr-set! propv _pointer 0 data-attr)
|
||||
(ptr-set! propv _pointer 1 mime-attr)
|
||||
(ptr-set! propv _pointer 2 desc-attr)
|
||||
(ptr-set! propv _pointer 3 type-attr)
|
||||
(ptr-set! propv _pointer 4 #f)
|
||||
;; Return keepalive values as well as the pointer array. TagLib copies during
|
||||
;; taglib_complex_property_set(), but all buffers must remain live for the call.
|
||||
(values propv (list data-ptr data-key mime-key desc-key type-key mime-ptr desc-ptr type-ptr
|
||||
data-attr mime-attr desc-attr type-attr propv)))
|
||||
|
||||
(define (taglib-set-picture tag-file mimetype picture-type description data)
|
||||
(define-values (props keepalive)
|
||||
(picture->complex-property data (bytes-length data) description mimetype picture-type))
|
||||
(define ok? (taglib_complex_property_set tag-file "PICTURE" props))
|
||||
keepalive
|
||||
ok?)
|
||||
|
||||
(define (taglib-append-picture tag-file mimetype picture-type description data)
|
||||
(define-values (props keepalive)
|
||||
(picture->complex-property data (bytes-length data) description mimetype picture-type))
|
||||
(define ok? (taglib_complex_property_set_append tag-file "PICTURE" props))
|
||||
keepalive
|
||||
ok?)
|
||||
|
||||
(define (taglib-clear-picture tag-file)
|
||||
(taglib_complex_property_set tag-file "PICTURE" #f))
|
||||
|
||||
(define (taglib-get-picture tag-file)
|
||||
(define (cp s) (if (eq? s #f) "" (string-append s "")))
|
||||
(let ((props (taglib_complex_property_get tag-file "PICTURE")))
|
||||
(if (eq? props #f)
|
||||
#f
|
||||
@@ -284,11 +318,7 @@
|
||||
(description (cp (TagLib_Complex_Property_Picture_Data-description pd)))
|
||||
(type (cp (TagLib_Complex_Property_Picture_Data-pictureType pd)))
|
||||
(size (TagLib_Complex_Property_Picture_Data-size pd))
|
||||
(data (cast (TagLib_Complex_Property_Picture_Data-data pd)
|
||||
_pointer
|
||||
(_bytes o size)))
|
||||
)
|
||||
(data (cast (TagLib_Complex_Property_Picture_Data-data pd) _pointer (_bytes o size))))
|
||||
(let ((r (list mimetype description type size data)))
|
||||
(taglib_complex_property_free props)
|
||||
r))))
|
||||
))
|
||||
r))))))
|
||||
|
||||
@@ -0,0 +1,278 @@
|
||||
#lang racket/base
|
||||
|
||||
(require rackunit
|
||||
racket/class
|
||||
racket/draw
|
||||
racket/file
|
||||
racket/list
|
||||
racket/path
|
||||
racket/runtime-path
|
||||
"taglib.rkt")
|
||||
|
||||
(provide run-taglib-tests
|
||||
run-taglib-tests/verbose
|
||||
current-taglib-test-verbosity
|
||||
test-audio-dir
|
||||
taglib-read-files
|
||||
taglib-write-files)
|
||||
|
||||
;; These tests expect the repository hans/racket-audio-test next to this
|
||||
;; package checkout, matching the layout already used by tests.rkt:
|
||||
;;
|
||||
;; parent/
|
||||
;; racket-audio/
|
||||
;; racket-audio-test/
|
||||
;;
|
||||
;; The tests are defensive: missing test files are skipped, but existing files
|
||||
;; are tested. Write tests always work on a temporary copy and never modify the
|
||||
;; original test audio files.
|
||||
|
||||
|
||||
(define current-taglib-test-verbosity (make-parameter 'normal))
|
||||
|
||||
(define (taglib-test-verbose?)
|
||||
(memq (current-taglib-test-verbosity) '(verbose very-verbose)))
|
||||
|
||||
(define (taglib-test-note fmt . args)
|
||||
(when (taglib-test-verbose?)
|
||||
(apply printf fmt args)
|
||||
(newline)
|
||||
(flush-output)))
|
||||
|
||||
(define-syntax-rule (taglib-test-case name body ...)
|
||||
(test-case name
|
||||
(taglib-test-note "[taglib] running: ~a" name)
|
||||
body ...
|
||||
(taglib-test-note "[taglib] ok: ~a" name)))
|
||||
|
||||
(define-runtime-path test-audio-dir "../racket-audio-test")
|
||||
|
||||
(define taglib-read-files
|
||||
'("idyll.flac"
|
||||
"idyll.m4a"
|
||||
"idyll.mp3"
|
||||
"idyll.ogg"
|
||||
"idyll.opus"
|
||||
"mahler-1.mp3"
|
||||
"mahler-1.ogg"
|
||||
"mahler-1.opus"
|
||||
"mahler-2.mp3"
|
||||
"mahler-2.ogg"
|
||||
"mahler-2.opus"
|
||||
"ff-16b-2c-44100hz.flac"
|
||||
"ff-16b-2c-44100hz.m4a"
|
||||
"ff-16b-2c-44100hz.mp3"
|
||||
"ff-16b-2c-44100hz.ogg"
|
||||
"ff-16b-2c-44100hz.opus"))
|
||||
|
||||
;; Keep the write matrix deliberately small. These formats should cover the
|
||||
;; main TagLib backends used by the package without making the test suite slow.
|
||||
(define taglib-write-files
|
||||
'("idyll.flac"
|
||||
"idyll.mp3"
|
||||
"idyll.m4a"
|
||||
"idyll.ogg"
|
||||
"idyll.opus"))
|
||||
|
||||
(define (existing-test-files names)
|
||||
(for/list ([name (in-list names)]
|
||||
#:when (file-exists? (build-path test-audio-dir name)))
|
||||
(build-path test-audio-dir name)))
|
||||
|
||||
(define (taglib-usable?)
|
||||
(with-handlers ([exn:fail? (lambda (_) #f)])
|
||||
(define files (existing-test-files taglib-read-files))
|
||||
(and (pair? files)
|
||||
(let ([tags (id3-tags (car files))])
|
||||
(and (tags-valid? tags) #t)))))
|
||||
|
||||
(define (copy-test-file-to-temp src)
|
||||
(define dst (make-temporary-file (format "racket-audio-taglib-~a-~~a~a"
|
||||
(path->string (file-name-from-path src))
|
||||
(or (path-get-extension src) #""))))
|
||||
(copy-file src dst #t)
|
||||
dst)
|
||||
|
||||
(define (check-nonnegative/name name v)
|
||||
(check-true (and (exact-integer? v) (>= v -1)) name))
|
||||
|
||||
(define (check-readable-snapshot path)
|
||||
(taglib-test-case (format "read-only snapshot: ~a" (file-name-from-path path))
|
||||
(define tags (id3-tags path))
|
||||
(check-true (tags-valid? tags))
|
||||
(check-false (tags-read-write? tags))
|
||||
(check-true (tags-closed? tags))
|
||||
(check-pred string? (tags-title tags))
|
||||
(check-pred string? (tags-album tags))
|
||||
(check-pred string? (tags-artist tags))
|
||||
(check-pred string? (tags-comment tags))
|
||||
(check-pred string? (tags-genre tags))
|
||||
(check-nonnegative/name "year" (tags-year tags))
|
||||
(check-nonnegative/name "track" (tags-track tags))
|
||||
(check-nonnegative/name "length" (tags-length tags))
|
||||
(check-nonnegative/name "sample-rate" (tags-sample-rate tags))
|
||||
(check-nonnegative/name "bit-rate" (tags-bit-rate tags))
|
||||
(check-nonnegative/name "channels" (tags-channels tags))
|
||||
(check-true (list? (tags-keys tags)))
|
||||
;; A read-only snapshot must still be usable after the native TagLib file
|
||||
;; has been closed. This protects the audio playback path from stale file
|
||||
;; handles/locks after metadata reading.
|
||||
(check-pred hash? (tags->hash tags))
|
||||
(check-exn exn:fail? (lambda () (tags-title! tags "must fail")))))
|
||||
|
||||
(define (check-call-with-closes path)
|
||||
(taglib-test-case (format "call-with-id3-tags closes read-write handle: ~a" (file-name-from-path path))
|
||||
(define captured #f)
|
||||
(with-handlers ([exn:fail? void])
|
||||
(call-with-id3-tags path #:mode 'read-write
|
||||
(lambda (tags)
|
||||
(set! captured tags)
|
||||
(check-true (tags-read-write? tags))
|
||||
(check-false (tags-closed? tags))
|
||||
(error 'expected-test-exception "force close path"))))
|
||||
(check-true (tags-closed? captured))))
|
||||
|
||||
(define (check-simple-write-roundtrip path)
|
||||
(taglib-test-case (format "tag write/read/clear roundtrip: ~a" (file-name-from-path path))
|
||||
(define tmp (copy-test-file-to-temp path))
|
||||
(displayln (format "tmp = ~a" tmp))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(define title (format "Racket Audio TagLib Test ~a" (current-inexact-milliseconds)))
|
||||
(call-with-id3-tags tmp #:mode 'read-write
|
||||
(lambda (tags)
|
||||
(check-true (tags-valid? tags))
|
||||
(check-true (tags-read-write? tags))
|
||||
(check-false (tags-closed? tags))
|
||||
(tags-title! tags title)
|
||||
(tags-album! tags "Racket Audio Test Album")
|
||||
(tags-artist! tags "Racket Audio Test Artist")
|
||||
(tags-comment! tags "Written by racket-audio taglib-tests.rkt")
|
||||
(tags-genre! tags "Test")
|
||||
(tags-year! tags 2026)
|
||||
(tags-track! tags 7)
|
||||
(tags-composer! tags "Racket Composer")
|
||||
(tags-album-artist! tags "Racket Album Artist")
|
||||
(tags-disc-number! tags 2)
|
||||
(tags-set-values! tags 'performer '("Performer One" "Performer Two"))
|
||||
(check-true (tags-save! tags))))
|
||||
|
||||
(define reread (id3-tags tmp))
|
||||
(check-true (tags-valid? reread))
|
||||
(check-true (tags-closed? reread))
|
||||
(check-equal? (tags-title reread) title)
|
||||
(check-equal? (tags-album reread) "Racket Audio Test Album")
|
||||
(check-equal? (tags-artist reread) "Racket Audio Test Artist")
|
||||
(check-equal? (tags-comment reread) "Written by racket-audio taglib-tests.rkt")
|
||||
(check-equal? (tags-genre reread) "Test")
|
||||
(check-equal? (tags-year reread) 2026)
|
||||
(check-equal? (tags-track reread) 7)
|
||||
(check-equal? (tags-composer reread) "Racket Composer")
|
||||
(check-equal? (tags-album-artist reread) "Racket Album Artist")
|
||||
(check-equal? (tags-disc-number reread) 2)
|
||||
(check-equal? (tags-ref reread 'performer) '("Performer One" "Performer Two"))
|
||||
|
||||
(call-with-id3-tags tmp #:mode 'read-write
|
||||
(lambda (tags)
|
||||
(tags-title! tags 'clear)
|
||||
(tags-year! tags 'clear)
|
||||
(tags-track! tags 'clear)
|
||||
(tags-clear! tags 'composer)
|
||||
(tags-clear! tags 'performer)
|
||||
(check-true (tags-save! tags))))
|
||||
|
||||
(define cleared (id3-tags tmp))
|
||||
(check-equal? (tags-title cleared) "")
|
||||
(check-equal? (tags-year cleared) -1)
|
||||
(check-equal? (tags-track cleared) -1)
|
||||
(check-equal? (tags-composer cleared) "")
|
||||
(check-false (tags-ref cleared 'performer)))
|
||||
(lambda ()
|
||||
(when (file-exists? tmp) (delete-file tmp))))))
|
||||
|
||||
(define (make-test-bitmap)
|
||||
(define bm (make-object bitmap% 4 4))
|
||||
(define dc (new bitmap-dc% [bitmap bm]))
|
||||
(send dc set-pen "black" 1 'solid)
|
||||
(send dc set-brush "white" 'solid)
|
||||
(send dc draw-rectangle 0 0 4 4)
|
||||
(send dc set-pen "black" 1 'solid)
|
||||
(send dc draw-line 0 0 3 3)
|
||||
(send dc set-bitmap #f)
|
||||
bm)
|
||||
|
||||
(define (check-picture-roundtrip path)
|
||||
(taglib-test-case (format "picture write/read/clear roundtrip: ~a" (file-name-from-path path))
|
||||
(define tmp (copy-test-file-to-temp path))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(define picture (make-tags-picture-from-bitmap (make-test-bitmap)
|
||||
"Front Cover"
|
||||
#:mimetype "image/png"
|
||||
#:description "Racket test cover"))
|
||||
(call-with-id3-tags tmp #:mode 'read-write
|
||||
(lambda (tags)
|
||||
(tags-picture! tags picture)
|
||||
(check-true (tags-save! tags))))
|
||||
|
||||
(define reread (id3-tags tmp))
|
||||
(define p (tags-picture reread))
|
||||
(check-true (id3-picture? p))
|
||||
(check-equal? (id3-picture-mimetype p) "image/png")
|
||||
(check-equal? (id3-picture-kind p) "Front Cover")
|
||||
(check-equal? (id3-picture-description p) "Racket test cover")
|
||||
(check-true (> (id3-picture-size p) 0))
|
||||
(check-true (is-a? (tags-picture->bitmap reread) bitmap%))
|
||||
|
||||
(call-with-id3-tags tmp #:mode 'read-write
|
||||
(lambda (tags)
|
||||
(tags-clear-picture! tags)
|
||||
(check-true (tags-save! tags))))
|
||||
(check-false (tags-picture (id3-tags tmp)))
|
||||
)
|
||||
(lambda ()
|
||||
(when (file-exists? tmp) (delete-file tmp))))))
|
||||
|
||||
(define (run-taglib-tests [verbosity 'normal])
|
||||
(unless (memq verbosity '(quiet normal verbose very-verbose))
|
||||
(raise-argument-error 'run-taglib-tests "(or/c 'quiet 'normal 'verbose 'very-verbose)" verbosity))
|
||||
(parameterize ([current-taglib-test-verbosity verbosity])
|
||||
(cond
|
||||
[(not (directory-exists? test-audio-dir))
|
||||
(unless (eq? verbosity 'quiet)
|
||||
(printf "Skipping TagLib tests: test audio directory not found: ~a\n" test-audio-dir))
|
||||
(void)]
|
||||
[(not (taglib-usable?))
|
||||
(unless (eq? verbosity 'quiet)
|
||||
(printf "Skipping TagLib tests: TagLib runtime is not available or no readable test file was found.\n"))
|
||||
(void)]
|
||||
[else
|
||||
(define read-files (existing-test-files taglib-read-files))
|
||||
(define write-files (existing-test-files taglib-write-files))
|
||||
(taglib-test-note "[taglib] test audio directory: ~a" test-audio-dir)
|
||||
(taglib-test-note "[taglib] read files: ~a" (length read-files))
|
||||
(taglib-test-note "[taglib] write files: ~a" (length write-files))
|
||||
(for ([path (in-list read-files)]) (check-readable-snapshot path))
|
||||
(when (pair? write-files)
|
||||
;; call-with close behavior only needs one writable copy.
|
||||
(define tmp (copy-test-file-to-temp (car write-files)))
|
||||
(dynamic-wind void
|
||||
(lambda () (check-call-with-closes tmp))
|
||||
(lambda () (when (file-exists? tmp) (delete-file tmp)))))
|
||||
(for ([path (in-list write-files)]) (check-simple-write-roundtrip path))
|
||||
;; Exercise picture writing on FLAC first, because it is the least
|
||||
;; ambiguous container for embedded cover-art roundtrips with TagLib.
|
||||
(define flac (build-path test-audio-dir "idyll.flac"))
|
||||
(when (file-exists? flac) (check-picture-roundtrip flac))
|
||||
(taglib-test-note "[taglib] done")])))
|
||||
|
||||
(define (run-taglib-tests/verbose)
|
||||
(run-taglib-tests 'verbose))
|
||||
|
||||
(module+ test
|
||||
(run-taglib-tests))
|
||||
|
||||
(module+ main
|
||||
(run-taglib-tests))
|
||||
+394
-163
@@ -2,12 +2,19 @@
|
||||
|
||||
(require "taglib-ffi.rkt"
|
||||
"private/utils.rkt"
|
||||
racket/string
|
||||
racket/draw)
|
||||
ffi/unsafe
|
||||
racket/class
|
||||
racket/draw
|
||||
racket/string)
|
||||
|
||||
(provide id3-tags
|
||||
call-with-id3-tags
|
||||
|
||||
tags-valid?
|
||||
tags-read-write?
|
||||
tags-closed?
|
||||
tags-close!
|
||||
tags-save!
|
||||
|
||||
tags-title
|
||||
tags-album
|
||||
@@ -20,6 +27,17 @@
|
||||
tags-disc-number
|
||||
tags-album-artist
|
||||
|
||||
tags-title!
|
||||
tags-album!
|
||||
tags-artist!
|
||||
tags-comment!
|
||||
tags-year!
|
||||
tags-genre!
|
||||
tags-track!
|
||||
tags-composer!
|
||||
tags-disc-number!
|
||||
tags-album-artist!
|
||||
|
||||
tags-length
|
||||
tags-sample-rate
|
||||
tags-bit-rate
|
||||
@@ -27,138 +45,336 @@
|
||||
|
||||
tags-keys
|
||||
tags-ref
|
||||
tags-set!
|
||||
tags-set-values!
|
||||
tags-append!
|
||||
tags-clear!
|
||||
|
||||
tags-picture
|
||||
tags-picture!
|
||||
tags-append-picture!
|
||||
tags-clear-picture!
|
||||
tags-picture->bitmap
|
||||
tags-picture->file
|
||||
tags-picture->kind
|
||||
tags-picture->mimetype
|
||||
tags-picture->description
|
||||
tags-picture->size
|
||||
tags-picture->ext
|
||||
|
||||
tags->hash
|
||||
|
||||
make-tags-picture
|
||||
make-tags-picture-from-bitmap
|
||||
id3-picture?
|
||||
id3-picture-mimetype
|
||||
id3-picture-kind
|
||||
id3-picture-size
|
||||
id3-picture-bytes
|
||||
)
|
||||
id3-picture-description)
|
||||
|
||||
(define-struct id3-tag-struct
|
||||
(handle))
|
||||
(define-struct id3-tag-struct (handle))
|
||||
(define-struct id3-picture (mimetype kind size bytes description))
|
||||
|
||||
(define-struct id3-picture
|
||||
(mimetype kind size bytes))
|
||||
(define clear-tag-value 'clear)
|
||||
|
||||
(define (id3-tags file*)
|
||||
(let ((file (if (path? file*) (path->string file*) file*))
|
||||
(valid? #f)
|
||||
(title "")
|
||||
(album "")
|
||||
(artist "")
|
||||
(comment "")
|
||||
(year -1)
|
||||
(genre "")
|
||||
(track -1)
|
||||
(length -1)
|
||||
(sample-rate -1)
|
||||
(bit-rate -1)
|
||||
(channels -1)
|
||||
(key-store (make-hash))
|
||||
(composer "")
|
||||
(album-artist "")
|
||||
(disc-number -1)
|
||||
(picture #f))
|
||||
(define (normal-mode mode)
|
||||
(cond
|
||||
[(or (eq? mode 'read) (eq? mode 'read-only)) 'read]
|
||||
[(or (eq? mode 'write) (eq? mode 'read-write)) 'read-write]
|
||||
[else (raise-argument-error 'id3-tags "(or/c 'read 'read-only 'read-write 'write)" mode)]))
|
||||
|
||||
(define (file->string file*)
|
||||
(if (path? file*) (path->string file*) file*))
|
||||
|
||||
(define (copy-string s)
|
||||
(if (eq? s #f) "" (string-append s "")))
|
||||
|
||||
(define (property-name k)
|
||||
(cond
|
||||
[(symbol? k) (string-upcase (symbol->string k))]
|
||||
[(string? k) k]
|
||||
[else (raise-argument-error 'tag-property "(or/c symbol? string?)" k)]))
|
||||
|
||||
(define (property-symbol k)
|
||||
(string->symbol (string-downcase (property-name k))))
|
||||
|
||||
(define (first-property h key [default ""])
|
||||
(let ((v (hash-ref h key #f)))
|
||||
(cond
|
||||
[(and (pair? v) (string? (car v))) (car v)]
|
||||
[(string? v) v]
|
||||
[else default])))
|
||||
|
||||
(define (first-property-number h key [default -1])
|
||||
(let ((n (string->number (first-property h key (number->string default)))))
|
||||
(if n n default)))
|
||||
|
||||
(define (string-list? v)
|
||||
(and (list? v) (andmap string? v)))
|
||||
|
||||
(define (bitmap->encoded-bytes bm mimetype)
|
||||
(define kind
|
||||
(cond
|
||||
[(or (string-ci=? mimetype "image/jpeg") (string-ci=? mimetype "image/jpg")) 'jpeg]
|
||||
[(string-ci=? mimetype "image/png") 'png]
|
||||
[else (error 'make-tags-picture-from-bitmap
|
||||
"unsupported bitmap mimetype: ~a; use image/png or image/jpeg" mimetype)]))
|
||||
(define out (open-output-bytes))
|
||||
(unless (send bm save-file out kind)
|
||||
(error 'make-tags-picture-from-bitmap "could not encode bitmap as ~a" mimetype))
|
||||
(get-output-bytes out))
|
||||
|
||||
(define (make-tags-picture mimetype kind data #:description [description ""])
|
||||
(define bytes
|
||||
(cond
|
||||
[(bytes? data) data]
|
||||
[(is-a? data bitmap%) (bitmap->encoded-bytes data mimetype)]
|
||||
[else (raise-argument-error 'make-tags-picture "(or/c bytes? (is-a?/c bitmap%))" data)]))
|
||||
(make-id3-picture mimetype kind (bytes-length bytes) bytes description))
|
||||
|
||||
(define (make-tags-picture-from-bitmap bm kind #:mimetype [mimetype "image/png"] #:description [description ""])
|
||||
(make-tags-picture mimetype kind bm #:description description))
|
||||
|
||||
(define (open-tag-file file)
|
||||
(let ((tag-file (taglib_file_new file)))
|
||||
(if (eq? tag-file #f)
|
||||
(set! valid? #f)
|
||||
(set! valid? (taglib_file_is_valid tag-file)))
|
||||
|
||||
(unless valid?
|
||||
(when (eq? (system-type 'os) 'windows)
|
||||
(if (and tag-file (taglib_file_is_valid tag-file))
|
||||
tag-file
|
||||
(begin
|
||||
(when (and tag-file (not (eq? tag-file #f))) (taglib_file_free tag-file))
|
||||
(if (eq? (system-type 'os) 'windows)
|
||||
(begin
|
||||
(dbg-sound "Could not open file ~a, trying wchar version on windows" file)
|
||||
(unless (eq? tag-file #f)
|
||||
(taglib_file_free tag-file))
|
||||
(set! tag-file (taglib_file_new_wchar file))
|
||||
(let ((wtag-file (taglib_file_new_wchar file)))
|
||||
(if (and wtag-file (taglib_file_is_valid wtag-file)) wtag-file
|
||||
(begin
|
||||
(when (and wtag-file (not (eq? wtag-file #f))) (taglib_file_free wtag-file))
|
||||
#f))))
|
||||
#f)))))
|
||||
|
||||
(define (read-property-map tag-file)
|
||||
(define key-store (make-hash))
|
||||
(let* ((keys (taglib_property_keys tag-file))
|
||||
(i 0)
|
||||
(key (and keys (taglib_property_key keys i)))
|
||||
(key-list '()))
|
||||
(while (not (eq? key #f))
|
||||
(set! key-list (append key-list (list (copy-string key))))
|
||||
(set! i (+ i 1))
|
||||
(set! key (taglib_property_key keys i)))
|
||||
(for-each
|
||||
(lambda (key)
|
||||
(let ((props (taglib_property_get tag-file key)))
|
||||
(let* ((vals '())
|
||||
(i 0)
|
||||
(val (and props (taglib_property_val props i))))
|
||||
(while (not (eq? val #f))
|
||||
(set! vals (append vals (list (copy-string val))))
|
||||
(set! i (+ i 1))
|
||||
(set! val (taglib_property_val props i)))
|
||||
(when props (taglib_property_free props))
|
||||
(hash-set! key-store (string->symbol (string-downcase key)) vals))))
|
||||
key-list))
|
||||
key-store)
|
||||
|
||||
(define (read-picture tag-file)
|
||||
(let ((p (taglib-get-picture tag-file)))
|
||||
(if (eq? p #f)
|
||||
#f
|
||||
(let ((mimetype (car p))
|
||||
(description (cadr p))
|
||||
(kind (caddr p))
|
||||
(size (cadddr p))
|
||||
(bytes (car (cddddr p))))
|
||||
(make-id3-picture mimetype kind size bytes description)))))
|
||||
|
||||
(define (id3-tags file* #:mode [mode 'read])
|
||||
(define file (file->string file*))
|
||||
(define actual-mode (normal-mode mode))
|
||||
(define read-write? (eq? actual-mode 'read-write))
|
||||
(define valid? #f)
|
||||
(define closed? #t)
|
||||
(define tag-file #f)
|
||||
(define tag #f)
|
||||
(define title "")
|
||||
(define album "")
|
||||
(define artist "")
|
||||
(define comment "")
|
||||
(define year -1)
|
||||
(define genre "")
|
||||
(define track -1)
|
||||
(define length -1)
|
||||
(define sample-rate -1)
|
||||
(define bit-rate -1)
|
||||
(define channels -1)
|
||||
(define key-store (make-hash))
|
||||
(define composer "")
|
||||
(define album-artist "")
|
||||
(define disc-number -1)
|
||||
(define picture #f)
|
||||
|
||||
(define (refresh-derived!)
|
||||
(set! composer (first-property key-store 'composer ""))
|
||||
(set! album-artist (first-property key-store 'albumartist ""))
|
||||
(set! disc-number (first-property-number key-store 'discnumber -1)))
|
||||
|
||||
(define (open-and-read!)
|
||||
(set! tag-file (open-tag-file file))
|
||||
(if (eq? tag-file #f)
|
||||
(begin
|
||||
(set! valid? #f)
|
||||
(set! valid? (taglib_file_is_valid tag-file)))))
|
||||
|
||||
(unless valid?
|
||||
(warn-sound "Could not open file ~a" file)
|
||||
(unless (eq? tag-file #f)
|
||||
(taglib_file_free tag-file)
|
||||
(set! tag-file #f)))
|
||||
|
||||
(when valid?
|
||||
(let ((tag (taglib_file_tag tag-file))
|
||||
(ap (taglib_file_audioproperties tag-file))
|
||||
(cp (lambda (s) (string-append s "")))
|
||||
)
|
||||
(set! title (cp (taglib_tag_title tag)))
|
||||
(set! album (cp (taglib_tag_album tag)))
|
||||
(set! artist (cp (taglib_tag_artist tag)))
|
||||
(set! comment (cp (taglib_tag_comment tag)))
|
||||
(set! genre (cp (taglib_tag_genre tag)))
|
||||
(set! year (taglib_tag_year tag))
|
||||
(set! track (taglib_tag_track tag))
|
||||
|
||||
(warn-sound "Could not open file ~a" file))
|
||||
(begin
|
||||
(set! valid? #t)
|
||||
(set! closed? #f)
|
||||
(set! tag (taglib_file_tag tag-file))
|
||||
(let ((ap (taglib_file_audioproperties tag-file)))
|
||||
(set! title (copy-string (taglib_tag_title tag)))
|
||||
(set! album (copy-string (taglib_tag_album tag)))
|
||||
(set! artist (copy-string (taglib_tag_artist tag)))
|
||||
(set! comment (copy-string (taglib_tag_comment tag)))
|
||||
(set! genre (copy-string (taglib_tag_genre tag)))
|
||||
(set! year (let ((v (taglib_tag_year tag))) (if (zero? v) -1 v)))
|
||||
(set! track (let ((v (taglib_tag_track tag))) (if (zero? v) -1 v)))
|
||||
(set! length (taglib_audioproperties_length ap))
|
||||
(set! sample-rate (taglib_audioproperties_samplerate ap))
|
||||
(set! bit-rate (taglib_audioproperties_bitrate ap))
|
||||
(set! channels (taglib_audioproperties_channels ap))
|
||||
|
||||
(let* ((keys (taglib_property_keys tag-file))
|
||||
(i 0)
|
||||
(key (taglib_property_key keys i))
|
||||
(key-list '())
|
||||
)
|
||||
(while (not (eq? key #f))
|
||||
(set! key-list (append key-list (list (cp key))))
|
||||
(set! i (+ i 1))
|
||||
(set! key (taglib_property_key keys i)))
|
||||
(for-each (lambda (key)
|
||||
(let ((props (taglib_property_get tag-file key)))
|
||||
(let* ((vals '())
|
||||
(i 0)
|
||||
(val (taglib_property_val props i)))
|
||||
(while (not (eq? val #f))
|
||||
(set! vals (append vals (list (cp val))))
|
||||
(set! i (+ i 1))
|
||||
(set! val (taglib_property_val props i)))
|
||||
(taglib_property_free props)
|
||||
(hash-set! key-store
|
||||
(string->symbol
|
||||
(string-downcase key)) vals)
|
||||
)))
|
||||
key-list)
|
||||
(set! composer (hash-ref key-store 'composer ""))
|
||||
(set! album-artist (hash-ref key-store 'albumartist ""))
|
||||
(set! disc-number (string->number
|
||||
(car
|
||||
(hash-ref key-store 'discnumber (list "-1")))))
|
||||
)
|
||||
|
||||
; picture
|
||||
(let ((p (taglib-get-picture tag-file)))
|
||||
(if (eq? p #f)
|
||||
(set! picture #f)
|
||||
(let ((mimetype (car p))
|
||||
(kind (caddr p))
|
||||
(size (cadddr p))
|
||||
(bytes (car (cddddr p))))
|
||||
(set! picture (make-id3-picture mimetype kind size bytes))
|
||||
)))
|
||||
|
||||
; cleaning up
|
||||
(set! key-store (read-property-map tag-file))
|
||||
(refresh-derived!)
|
||||
(set! picture (read-picture tag-file))
|
||||
(taglib_tag_free_strings)
|
||||
(unless read-write? (close!))))))
|
||||
|
||||
(define (close!)
|
||||
(unless closed?
|
||||
(taglib_file_free tag-file)
|
||||
)
|
||||
)
|
||||
(let ((handle
|
||||
(lambda (v . args)
|
||||
(set! tag-file #f)
|
||||
(set! tag #f)
|
||||
(set! closed? #t))
|
||||
(void))
|
||||
|
||||
(define (ensure-open! who)
|
||||
(unless valid? (error who "tag handle is invalid: ~a" file))
|
||||
(unless read-write?
|
||||
(error who "tag handle is read-only for ~a; open with #:mode 'read-write" file))
|
||||
(when closed? (error who "tag handle is closed: ~a" file)))
|
||||
|
||||
(define (set-property-cache! key vals)
|
||||
(define sym (property-symbol key))
|
||||
(if (null? vals) (hash-remove! key-store sym) (hash-set! key-store sym vals))
|
||||
(refresh-derived!))
|
||||
|
||||
(define (string->cptr s)
|
||||
(define bs (string->bytes/utf-8 s))
|
||||
(define len (bytes-length bs))
|
||||
(define ptr (malloc _byte (+ len 1) 'atomic-interior))
|
||||
(for ([i (in-range len)]) (ptr-set! ptr _byte i (bytes-ref bs i)))
|
||||
(ptr-set! ptr _byte len 0)
|
||||
ptr)
|
||||
|
||||
(define (apply-string! who value setter cache!)
|
||||
(ensure-open! who)
|
||||
(cond
|
||||
[(eq? value clear-tag-value) (setter tag "") (cache! "")]
|
||||
[(string? value) (setter tag value) (cache! value)]
|
||||
[else (raise-argument-error who "(or/c string? 'clear)" value)]))
|
||||
|
||||
(define (apply-uint! who value setter cache!)
|
||||
(ensure-open! who)
|
||||
(cond
|
||||
[(eq? value clear-tag-value) (setter tag 0) (cache! -1)]
|
||||
[(and (exact-nonnegative-integer? value) (<= value #xffffffff))
|
||||
(setter tag value) (cache! value)]
|
||||
[else (raise-argument-error who "(or/c exact-nonnegative-integer? 'clear)" value)]))
|
||||
|
||||
(define (set-one-property! who key value #:append? [append? #f])
|
||||
(ensure-open! who)
|
||||
(cond
|
||||
[(eq? value clear-tag-value)
|
||||
(if append?
|
||||
(taglib_property_set_append tag-file (property-name key) #f)
|
||||
(taglib_property_set tag-file (property-name key) #f))
|
||||
(set-property-cache! key '())]
|
||||
[(string? value)
|
||||
(if append?
|
||||
(taglib_property_set_append tag-file (property-name key) (string->cptr value))
|
||||
(taglib_property_set tag-file (property-name key) (string->cptr value)))
|
||||
(if append?
|
||||
(set-property-cache! key (append (hash-ref key-store (property-symbol key) '()) (list value)))
|
||||
(set-property-cache! key (list value)))]
|
||||
[else (raise-argument-error who "(or/c string? 'clear)" value)]))
|
||||
|
||||
(define (set-values-property! key values)
|
||||
(ensure-open! 'tags-set-values!)
|
||||
(cond
|
||||
[(eq? values clear-tag-value)
|
||||
(taglib_property_set tag-file (property-name key) #f)
|
||||
(set-property-cache! key '())]
|
||||
[(string-list? values)
|
||||
(taglib_property_set tag-file (property-name key) #f)
|
||||
(for ([v values]) (taglib_property_set_append tag-file (property-name key) (string->cptr v)))
|
||||
(set-property-cache! key values)]
|
||||
[else (raise-argument-error 'tags-set-values! "(or/c (listof string?) 'clear)" values)]))
|
||||
|
||||
(define (set-picture! value #:append? [append? #f])
|
||||
(ensure-open! (if append? 'tags-append-picture! 'tags-picture!))
|
||||
(cond
|
||||
[(eq? value clear-tag-value)
|
||||
(unless (taglib-clear-picture tag-file)
|
||||
(error 'tags-picture! "could not clear picture for file: ~a" file))
|
||||
(set! picture #f)]
|
||||
[(id3-picture? value)
|
||||
(define ok?
|
||||
(if append?
|
||||
(taglib-append-picture tag-file
|
||||
(id3-picture-mimetype value)
|
||||
(id3-picture-kind value)
|
||||
(id3-picture-description value)
|
||||
(id3-picture-bytes value))
|
||||
(taglib-set-picture tag-file
|
||||
(id3-picture-mimetype value)
|
||||
(id3-picture-kind value)
|
||||
(id3-picture-description value)
|
||||
(id3-picture-bytes value))))
|
||||
(unless ok? (error (if append? 'tags-append-picture! 'tags-picture!)
|
||||
"could not set picture for file: ~a" file))
|
||||
(unless append? (set! picture value))]
|
||||
[else (raise-argument-error (if append? 'tags-append-picture! 'tags-picture!)
|
||||
"(or/c id3-picture? 'clear)" value)]))
|
||||
|
||||
(define (save!)
|
||||
(ensure-open! 'tags-save!)
|
||||
(taglib_file_save tag-file))
|
||||
|
||||
(define (to-hash)
|
||||
(let ((h (make-hash)))
|
||||
(hash-set! h 'valid? valid?)
|
||||
(hash-set! h 'read-write? read-write?)
|
||||
(hash-set! h 'closed? closed?)
|
||||
(hash-set! h 'title title)
|
||||
(hash-set! h 'album album)
|
||||
(hash-set! h 'artist artist)
|
||||
(hash-set! h 'comment comment)
|
||||
(hash-set! h 'composer composer)
|
||||
(hash-set! h 'genre genre)
|
||||
(hash-set! h 'year year)
|
||||
(hash-set! h 'track track)
|
||||
(hash-set! h 'length length)
|
||||
(hash-set! h 'sample-rate sample-rate)
|
||||
(hash-set! h 'bit-rate bit-rate)
|
||||
(hash-set! h 'channels channels)
|
||||
(hash-set! h 'picture picture)
|
||||
(hash-set! h 'keys (hash-keys key-store))
|
||||
h))
|
||||
|
||||
(define (handle v . args)
|
||||
(cond
|
||||
[(eq? v 'valid?) valid?]
|
||||
[(eq? v 'read-write?) read-write?]
|
||||
[(eq? v 'closed?) closed?]
|
||||
[(eq? v 'close!) (close!)]
|
||||
[(eq? v 'save!) (save!)]
|
||||
[(eq? v 'title) title]
|
||||
[(eq? v 'album) album]
|
||||
[(eq? v 'artist) artist]
|
||||
@@ -174,55 +390,62 @@
|
||||
[(eq? v 'keys) (hash-keys key-store)]
|
||||
[(eq? v 'album-artist) album-artist]
|
||||
[(eq? v 'disc-number) disc-number]
|
||||
[(eq? v 'val)
|
||||
(if (null? args)
|
||||
#f
|
||||
(hash-ref key-store (car args) #f))]
|
||||
[(eq? v 'val) (if (null? args) #f (hash-ref key-store (property-symbol (car args)) #f))]
|
||||
[(eq? v 'picture) picture]
|
||||
[(eq? v 'to-hash)
|
||||
(let ((h (make-hash)))
|
||||
(hash-set! h 'valid? valid?)
|
||||
(hash-set! h 'title title)
|
||||
(hash-set! h 'album album)
|
||||
(hash-set! h 'artist artist)
|
||||
(hash-set! h 'comment comment)
|
||||
(hash-set! h 'composer composer)
|
||||
(hash-set! h 'genre genre)
|
||||
(hash-set! h 'year year)
|
||||
(hash-set! h 'track track)
|
||||
(hash-set! h 'length length)
|
||||
(hash-set! h 'sample-rate sample-rate)
|
||||
(hash-set! h 'bit-rate bit-rate)
|
||||
(hash-set! h 'channels channels)
|
||||
(hash-set! h 'picture picture)
|
||||
(hash-set! h 'keys (hash-keys key-store))
|
||||
h)]
|
||||
[else (error (format "Unknown tag-cmd '~a'" v))]
|
||||
))))
|
||||
(make-id3-tag-struct handle))
|
||||
)))
|
||||
[(eq? v 'to-hash) (to-hash)]
|
||||
[(eq? v 'set-title!) (apply-string! 'tags-title! (car args) taglib_tag_set_title (lambda (x) (set! title x)))]
|
||||
[(eq? v 'set-album!) (apply-string! 'tags-album! (car args) taglib_tag_set_album (lambda (x) (set! album x)))]
|
||||
[(eq? v 'set-artist!) (apply-string! 'tags-artist! (car args) taglib_tag_set_artist (lambda (x) (set! artist x)))]
|
||||
[(eq? v 'set-comment!) (apply-string! 'tags-comment! (car args) taglib_tag_set_comment (lambda (x) (set! comment x)))]
|
||||
[(eq? v 'set-genre!) (apply-string! 'tags-genre! (car args) taglib_tag_set_genre (lambda (x) (set! genre x)))]
|
||||
[(eq? v 'set-year!) (apply-uint! 'tags-year! (car args) taglib_tag_set_year (lambda (x) (set! year x)))]
|
||||
[(eq? v 'set-track!) (apply-uint! 'tags-track! (car args) taglib_tag_set_track (lambda (x) (set! track x)))]
|
||||
[(eq? v 'set-composer!) (set-one-property! 'tags-composer! 'composer (car args))]
|
||||
[(eq? v 'set-album-artist!) (set-one-property! 'tags-album-artist! 'albumartist (car args))]
|
||||
[(eq? v 'set-disc-number!)
|
||||
(let ((x (car args)))
|
||||
(cond
|
||||
[(eq? x clear-tag-value) (set-one-property! 'tags-disc-number! 'discnumber clear-tag-value)]
|
||||
[(and (exact-nonnegative-integer? x) (<= x #xffffffff)) (set-one-property! 'tags-disc-number! 'discnumber (number->string x))]
|
||||
[(string? x) (set-one-property! 'tags-disc-number! 'discnumber x)]
|
||||
[else (raise-argument-error 'tags-disc-number! "(or/c exact-nonnegative-integer? string? 'clear)" x)]))]
|
||||
[(eq? v 'set!) (set-one-property! 'tags-set! (car args) (cadr args))]
|
||||
[(eq? v 'set-values!) (set-values-property! (car args) (cadr args))]
|
||||
[(eq? v 'append!) (set-one-property! 'tags-append! (car args) (cadr args) #:append? #t)]
|
||||
[(eq? v 'clear!) (set-one-property! 'tags-clear! (car args) clear-tag-value)]
|
||||
[(eq? v 'set-picture!) (set-picture! (car args))]
|
||||
[(eq? v 'append-picture!) (set-picture! (car args) #:append? #t)]
|
||||
[(eq? v 'clear-picture!) (set-picture! clear-tag-value)]
|
||||
[else (error (format "Unknown tag-cmd '~a'" v))]))
|
||||
|
||||
(open-and-read!)
|
||||
(make-id3-tag-struct handle))
|
||||
|
||||
(define (call-with-id3-tags file proc #:mode [mode 'read])
|
||||
(define tags (id3-tags file #:mode mode))
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda () (proc tags))
|
||||
(lambda () (tags-close! tags))))
|
||||
|
||||
(define-syntax def
|
||||
(syntax-rules ()
|
||||
((_ (fun v))
|
||||
(define (fun tags . args)
|
||||
(apply (id3-tag-struct-handle tags) (cons v args)))
|
||||
)))
|
||||
(apply (id3-tag-struct-handle tags) (cons v args))))))
|
||||
|
||||
(define-syntax defs
|
||||
(syntax-rules ()
|
||||
((_ f1)
|
||||
(def f1))
|
||||
((_ f1 f2 ...)
|
||||
(begin
|
||||
(def f1)
|
||||
(def f2)
|
||||
...))
|
||||
))
|
||||
((_ f1) (def f1))
|
||||
((_ f1 f2 ...) (begin (def f1) (def f2) ...))))
|
||||
|
||||
(defs
|
||||
(tags-valid? 'valid?)
|
||||
(tags-read-write? 'read-write?)
|
||||
(tags-closed? 'closed?)
|
||||
(tags-close! 'close!)
|
||||
(tags-save! 'save!)
|
||||
|
||||
(tags-title 'title)
|
||||
(tags-album 'album)
|
||||
(tags-artist 'artist)
|
||||
@@ -234,6 +457,17 @@
|
||||
(tags-year 'year)
|
||||
(tags-track 'track)
|
||||
|
||||
(tags-title! 'set-title!)
|
||||
(tags-album! 'set-album!)
|
||||
(tags-artist! 'set-artist!)
|
||||
(tags-comment! 'set-comment!)
|
||||
(tags-genre! 'set-genre!)
|
||||
(tags-composer! 'set-composer!)
|
||||
(tags-album-artist! 'set-album-artist!)
|
||||
(tags-disc-number! 'set-disc-number!)
|
||||
(tags-year! 'set-year!)
|
||||
(tags-track! 'set-track!)
|
||||
|
||||
(tags-length 'length)
|
||||
(tags-sample-rate 'sample-rate)
|
||||
(tags-bit-rate 'bit-rate)
|
||||
@@ -241,10 +475,16 @@
|
||||
|
||||
(tags-keys 'keys)
|
||||
(tags-ref 'val)
|
||||
(tags-set! 'set!)
|
||||
(tags-set-values! 'set-values!)
|
||||
(tags-append! 'append!)
|
||||
(tags-clear! 'clear!)
|
||||
|
||||
(tags-picture 'picture)
|
||||
(tags->hash 'to-hash)
|
||||
)
|
||||
(tags-picture! 'set-picture!)
|
||||
(tags-append-picture! 'append-picture!)
|
||||
(tags-clear-picture! 'clear-picture!)
|
||||
(tags->hash 'to-hash))
|
||||
|
||||
(define (tags-picture->bitmap tags)
|
||||
(let ((p (tags-picture tags)))
|
||||
@@ -257,34 +497,27 @@
|
||||
|
||||
(define (tags-picture->kind tags)
|
||||
(let ((p (tags-picture tags)))
|
||||
(if (eq? p #f)
|
||||
#f
|
||||
(id3-picture-kind p))))
|
||||
(if (eq? p #f) #f (id3-picture-kind p))))
|
||||
|
||||
(define (tags-picture->mimetype tags)
|
||||
(let ((p (tags-picture tags)))
|
||||
(if (eq? p #f)
|
||||
#f
|
||||
(id3-picture-mimetype p))))
|
||||
(if (eq? p #f) #f (id3-picture-mimetype p))))
|
||||
|
||||
(define (tags-picture->description tags)
|
||||
(let ((p (tags-picture tags)))
|
||||
(if (eq? p #f) #f (id3-picture-description p))))
|
||||
|
||||
(define (tags-picture->ext tags)
|
||||
(let ((mt (tags-picture->mimetype tags)))
|
||||
(cond
|
||||
((eq? mt #f)
|
||||
#f)
|
||||
((or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg"))
|
||||
'jpg)
|
||||
((string-suffix? mt "/png")
|
||||
'png)
|
||||
(else #f)
|
||||
)
|
||||
))
|
||||
[(eq? mt #f) #f]
|
||||
[(or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg")) 'jpg]
|
||||
[(string-suffix? mt "/png") 'png]
|
||||
[else #f])))
|
||||
|
||||
(define (tags-picture->size tags)
|
||||
(let ((p (tags-picture tags)))
|
||||
(if (eq? p #f)
|
||||
#f
|
||||
(id3-picture-size p))))
|
||||
(if (eq? p #f) #f (id3-picture-size p))))
|
||||
|
||||
(define (tags-picture->file tags path)
|
||||
(let ((p (tags-picture tags)))
|
||||
@@ -300,6 +533,4 @@
|
||||
(close-input-port in)
|
||||
#t))))
|
||||
|
||||
|
||||
); end of module
|
||||
|
||||
)
|
||||
|
||||
@@ -0,0 +1,79 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/runtime-path
|
||||
"private/utils.rkt"
|
||||
"libmpg123-ffi.rkt"
|
||||
"audio-decoder.rkt"
|
||||
)
|
||||
|
||||
(provide mp3-ffi-read-test
|
||||
decoder-read-test
|
||||
test-file1
|
||||
test-file2
|
||||
test-file3
|
||||
test-file4
|
||||
test-file5)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; test audio
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-runtime-path tests "../racket-audio-test")
|
||||
|
||||
(define test-file1 (build-path tests "idyll.mp3"))
|
||||
(define test-file2 (build-path tests "idyll.opus"))
|
||||
(define test-file3 (build-path tests "mahler-1.mp3"))
|
||||
(define test-file4 (build-path tests "mahler-2.mp3"))
|
||||
(define test-file5 (build-path tests "mahler-1.opus"))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; test functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; mp3 read test ffi
|
||||
|
||||
(define (mp3-ffi-read-test)
|
||||
(let* ((file test-file1)
|
||||
(state #f)
|
||||
(audio '())
|
||||
(formats '())
|
||||
(h (mpg123-ffi-decoder-handler))
|
||||
)
|
||||
(h 'new)
|
||||
(h 'init file)
|
||||
(let loop ()
|
||||
(h 'read
|
||||
(λ (kind pos buf done)
|
||||
(set! state kind)
|
||||
(set! audio (cons (list kind pos done) audio)))
|
||||
(λ (pos rate channels sample-bits sample-bytes length)
|
||||
(set! formats (cons (list rate channels sample-bits sample-bytes length) formats))))
|
||||
(unless (eq? state 'done)
|
||||
(loop)))
|
||||
(h 'close)
|
||||
(h 'delete)
|
||||
|
||||
(displayln (format "got ~a audio samples (~a)" (length audio) (car audio)))
|
||||
(displayln (format "got ~a formats (~a)" (length formats) (car formats)))
|
||||
))
|
||||
|
||||
;;; decoder read test
|
||||
|
||||
(define (decoder-read-test file)
|
||||
(let* ((state #f)
|
||||
(audio '())
|
||||
(formats '())
|
||||
(h (audio-open file
|
||||
(λ (reader-type ao-type handle meta)
|
||||
(set! formats (cons (list reader-type ao-type meta) formats)))
|
||||
(λ (reader-type ao-type handle buf-info audio-buffer buf-len)
|
||||
(set! audio
|
||||
(cons (list reader-type ao-type buf-info buf-len) audio)))
|
||||
)))
|
||||
(audio-read h)
|
||||
|
||||
(displayln (format "got ~a audio samples (~a)" (length audio) (car audio)))
|
||||
(displayln (format "got ~a formats (~a)" (length formats) (car formats)))
|
||||
)
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user