249 lines
9.3 KiB
Racket
249 lines
9.3 KiB
Racket
(module flac-decoder racket/base
|
|
|
|
(require ffi/unsafe
|
|
"libflac-ffi.rkt"
|
|
"flac-definitions.rkt"
|
|
"private/utils.rkt")
|
|
|
|
(provide flac-open
|
|
flac-valid?
|
|
flac-read
|
|
flac-read-meta
|
|
flac-stream-state
|
|
flac-stop
|
|
flac-seek
|
|
(all-from-out "flac-definitions.rkt")
|
|
kinds
|
|
last-buffer last-buf-len
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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*)))
|
|
(if (file-exists? flac-file)
|
|
(let ((handler (flac-ffi-decoder-handler)))
|
|
(handler 'new)
|
|
(handler 'init flac-file)
|
|
(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)))
|
|
|
|
(define (flac-stream-state handle)
|
|
((flac-handle-ffi-decoder-handler handle) 'state))
|
|
|
|
|
|
(define kinds (make-hash))
|
|
(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)]
|
|
[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)])
|
|
|
|
(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)
|
|
|
|
(hash-set! kinds type #t)
|
|
|
|
(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 'bits-per-sample 32) ; Flac works internally 32 bits.
|
|
(let ((cb (flac-handle-cb-stream-info handle)))
|
|
(when (procedure? cb)
|
|
(cb mh))))))
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (flac-read handle)
|
|
(let* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
|
|
(state (ffi-handler 'state)))
|
|
(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))
|
|
(set-flac-handle-reading! handle #f)
|
|
'stopped-reading)
|
|
(let* ((st (ffi-handler 'state)))
|
|
(ffi-handler 'process-single)
|
|
(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?)
|
|
(err-sound "Error in stream: ~a" (ffi-handler 'errno))
|
|
)
|
|
(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 (frame buffer)
|
|
(process-frame handle frame buffer)))
|
|
)
|
|
(if (eq? st 'end-of-stream)
|
|
(begin
|
|
(set-flac-handle-reading! handle #f)
|
|
st)
|
|
(reader (+ frame-nr 1))))))
|
|
))
|
|
(reader 0)
|
|
; done reading, delete flac encoder
|
|
(ffi-handler 'delete)
|
|
)
|
|
)
|
|
)
|
|
|
|
(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)))
|
|
(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))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(define (flac-stop handle)
|
|
(let ((ct (current-milliseconds)))
|
|
(dbg-sound "requesting stop at: ~a" ct)
|
|
(set-flac-handle-stop-reading! handle #t)
|
|
(while (flac-handle-reading handle)
|
|
(sleep 0.01))
|
|
(let ((ct* (current-milliseconds)))
|
|
(dbg-sound "stop came back at: ~a" ct*)
|
|
(dbg-sound "flac-stop took: ~a ms" (- ct* ct)))
|
|
)
|
|
)
|
|
|
|
); end of module
|