Files
racket-audio/flac-decoder.rkt
T

223 lines
10 KiB
Racket

(module flac-decoder racket/base
(require ffi/unsafe
"libflac-ffi.rkt"
"flac-definitions.rkt"
"private/utils.rkt"
let-assert
)
(provide flac-open
flac-valid?
flac-read
flac-read-meta
flac-stream-state
flac-stop
flac-seek
(all-from-out "flac-definitions.rkt")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to do the good stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (flac-valid? flac-file*)
#t)
(define (flac-open flac-file* cb-stream-info cb-audio)
(let ((flac-file (if (path? flac-file*) (path->string flac-file*) flac-file*)))
(and (string? flac-file)
(file-exists? flac-file)
(let ((handler (flac-ffi-decoder-handler)))
(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))))))
(define (flac-stream-state handle)
((flac-handle-ffi-decoder-handler handle) 'state))
(define (process-frame handle h mem-out)
(let* ([cb-audio (flac-handle-cb-audio handle)]
[type (hash-ref h 'number-type)]
[buf-size (bytes-length mem-out)])
(hash-set! h 'duration (flac-duration handle))
(when (procedure? cb-audio)
(cb-audio h mem-out buf-size))
#t))
(define (process-meta handle meta)
(let ((type (FLAC__StreamMetadata-type meta)))
(dbg-sound (format " Got metadata type: ~a\n" type))
(cond
([eq? type 'streaminfo]
(let ((mh (flac-ffi-meta meta)))
(let ((si (make-flac-stream-info
(hash-ref mh 'min-blocksize) (hash-ref mh 'max-blocksize)
(hash-ref mh 'min-framesize) (hash-ref mh 'max-framesize)
(hash-ref mh 'sample-rate)
(hash-ref mh 'channels)
32 ; (hash-ref mh 'bits-per-sample)
(hash-ref mh 'total-samples))))
(let ((duration (exact->inexact
(/ (hash-ref mh 'total-samples)
(hash-ref mh 'sample-rate)))))
(hash-set! mh 'duration duration))
(set-flac-handle-stream-info! handle si)
(hash-set! mh 'audio-bits-per-sample (hash-ref mh 'bits-per-sample))
(hash-set! mh 'bits-per-sample 32) ; Flac works internally 32 bits.
(let ((cb (flac-handle-cb-stream-info handle)))
(when (procedure? cb)
(cb mh))))))
)
)
)
(define (flac-err->str nr)
(cond
((= nr 0) "0 = Lost Sync: An error in the stream caused the decoder to lose synchronization.")
((= nr 1) "1 = Bad Header: The decoder encountered a corrupted frame header.")
((= nr 2) "2 = CRC Mismatch: The frame's data did not match the CRC in the footer.")
((= nr 3) "3 = Unparseable Stream: The decoder encountered reserved fields in use in the stream.")
((= nr 4) "4 = Bad Metadata: The decoder encountered a corrupted metadata block.")
((= nr 5) "5 = Out of bounds: The decoder encountered a otherwise valid frame in which the decoded samples exceeded the range offered by the stated bit depth.")
((= nr 6) "6 = Missing Frame: Two adjacent frames had frame numbers increasing by more than 1 or sample numbers increasing by more than the blocksize, indicating that one or more frame/frames was missing between them.")
(else (format "~a = Unknown: Unknown status code." nr))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Decode FLAC frames and release the decoder on every exit.
; pre : Handle is open and is not already being read.
; post : The native decoder is released and reading is false.
; result : Void on completion; decoding and callback errors propagate.
; internals: reader processes frames and callbacks. dynamic-wind deletes
; the native decoder before clearing reading, so flac-stop
; cannot return while decoder cleanup is still in progress.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (flac-read handle)
(let* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
(state (ffi-handler 'state))
(err-hash (make-hash))
)
(set-flac-handle-stop-reading! handle #f)
(set-flac-handle-reading! handle #t)
(letrec ((reader (lambda (frame-nr)
(if (flac-handle-stop-reading handle)
(begin
(dbg-sound "handling stop at: ~a" (current-milliseconds))
'stopped-reading)
(let* ((st (ffi-handler 'state)))
(when (memq st '(ogg-error seek-error aborted
memory-allocation-error uninitialized))
(error 'flac-read "Decoder cannot continue in state ~a" st))
(unless (ffi-handler 'process-single)
(error 'flac-read "Could not decode FLAC frame ~a (state ~a)"
frame-nr (ffi-handler 'state)))
(unless (eq? state st)
(set! state st)
(dbg-sound "Now in state ~a (frame-nr = ~a) (int-state = ~a)"
st frame-nr (ffi-handler 'int-state))
)
(when (ffi-handler 'has-errno?)
(let ((errno (ffi-handler 'errno)))
(unless (eq? (hash-ref err-hash errno #f) #f)
(hash-set! err-hash errno #t)
(warn-sound "Error in stream: ~a (frame-nr = ~a) (int-state = ~a)"
(flac-err->str errno)
frame-nr (ffi-handler 'int-state))))
)
(when (ffi-handler 'has-meta-data?)
(ffi-handler 'process-meta-data
(lambda (meta) (process-meta handle meta)))
)
(when (ffi-handler 'has-write-data?)
(ffi-handler 'process-write-data
(lambda (h mem-out)
(process-frame handle h mem-out)))
)
(if (eq? st 'end-of-stream)
st
(reader (+ frame-nr 1))))))
))
(dynamic-wind
void
(λ () (reader 0) (void))
(λ ()
(dynamic-wind
void
(λ () (ffi-handler 'delete))
(λ () (set-flac-handle-reading! handle #f)))))
)
)
)
(define (flac-read-meta handle)
(let* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
(state (ffi-handler 'state)))
(while (not (or (eq? state 'read-metadata)
(eq? state 'end-of-stream)
(eq? state 'aborted)
(eq? state 'memory-allocation-error)
(eq? state 'uninitialized)))
(ffi-handler 'process-single)
(set! state (ffi-handler 'state))
state)
(if (eq? state 'read-metadata)
(begin
(ffi-handler 'process-meta-data
(lambda (meta) (process-meta handle meta)))
(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))
(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)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Stop decoding and safely release an idle FLAC decoder.
; pre : Handle was returned by flac-open.
; post : Reading and native decoder cleanup have finished.
; result : Void; repeated stops and stops after EOF are harmless.
; internals: An active reader observes stop-reading and owns cleanup.
; Otherwise the FFI handler performs idempotent deletion.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (flac-stop handle)
(let ((ct (current-milliseconds)))
(dbg-sound "requesting stop at: ~a" ct)
(if (flac-handle-reading handle)
(begin ; in reading
(set-flac-handle-stop-reading! handle #t)
(while (flac-handle-reading handle)
(sleep 0.01)))
(begin ; never starte reading, or reading finished
(dbg-sound "not reading flac, need to finish flac")
(let ((ffi-handler (flac-handle-ffi-decoder-handler handle)))
(unless (eq? ffi-handler #f)
(ffi-handler 'delete))))
)
(let ((ct* (current-milliseconds)))
(dbg-sound "stop came back at: ~a" ct*)
(dbg-sound "flac-stop took: ~a ms" (- ct* ct)))
)
)
); end of module