(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