317 lines
12 KiB
Racket
317 lines
12 KiB
Racket
(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
|