diff --git a/src/flac.scm b/src/flac.scm index 01f7412..50a30f2 100644 --- a/src/flac.scm +++ b/src/flac.scm @@ -46,62 +46,44 @@ (define (decode-flac-file infile outfile) (let ((old-output (current-output-port))) (with-input-from-file infile - (λ () - (with-flac-input-port (current-input-port) - (λ () - (let* ((stream-info (flac-metadata-stream-info (read-flac-metadata))) - (sample-data-length (* (stream-info-samples stream-info) - (stream-info-channels stream-info) - (floor-quotient (stream-info-bits-per-sample stream-info) 8))) - (wav-header (bytestructure - header-struct - `((filetype "RIFF") - (filesize ,(+ 36 (* (stream-info-samples stream-info) - (stream-info-channels stream-info) - (floor-quotient (stream-info-bits-per-sample stream-info) 8)))) - (filetype-header "WAVE") - (format-chunk-marker "fmt ") - (format-chunk-length 16) - (format-type #x0001) - (num-channels ,(stream-info-channels stream-info)) - (sample-freq ,(stream-info-sample-rate stream-info)) - (bytes/sec ,(* (stream-info-sample-rate stream-info) - (stream-info-channels stream-info) - (floor-quotient (stream-info-bits-per-sample stream-info) 8))) - (block-alignment ,(* (stream-info-channels stream-info) - (floor-quotient (stream-info-bits-per-sample stream-info) 8))) - (bits-per-sample ,(stream-info-bits-per-sample stream-info)) - (data-chunk-header "data") - (data-chunk-size ,(* (stream-info-samples stream-info) + (λ () + (with-flac-input-port + (current-input-port) + (λ () + (let* ((stream-info (flac-metadata-stream-info (read-flac-metadata))) + (sample-data-length (* (stream-info-samples stream-info) + (stream-info-channels stream-info) + (floor-quotient (stream-info-bits-per-sample stream-info) 8))) + (wav-header (bytestructure + header-struct + `((filetype "RIFF") + (filesize ,(+ 36 (* (stream-info-samples stream-info) (stream-info-channels stream-info) - (floor-quotient (stream-info-bits-per-sample stream-info) 8))))))) - (format #t "SAMPLES: ~a\n" (stream-info-samples stream-info)) - (format #t "bps: ~a\n" (stream-info-bits-per-sample stream-info)) - (with-output-to-file outfile - (lambda () - (put-bytevector (current-output-port) (bytestructure-unwrap wav-header)) - (let frame-loop ((frame-number 0) - (frame (read-flac-frame stream-info))) - (if (= (stream-info-samples stream-info) frame-number) - #t - (begin - (write-frame frame (stream-info-channels stream-info)) - (frame-loop (+ 1 frame-number) - (read-flac-frame stream-info)))))) - #:binary #t)))))))) -; -; (format #t "SAMPLES: ~a\n" (stream-info-samples stream-info)) -; (format #t "bps: ~a\n" (stream-info-bits-per-sample stream-info)) -; (with-output-to-file outfile -; (lambda () -; (put-bytevector (current-output-port) (bytestructure-unwrap wav-header)) -; (let frame-loop ((frame-number 0) -; (frame (read-flac-frame stream-info))) -; (if (= (stream-info-samples stream-info) frame-number) -; #t -; (begin -; (format old-output "frame ~a\n" frame) -; (write-frame frame (stream-info-channels stream-info)) -; (frame-loop (+ 1 frame-number) -; (read-flac-frame stream-info)))))))))))) -; #:binary #t)))))))) + (floor-quotient (stream-info-bits-per-sample stream-info) 8)))) + (filetype-header "WAVE") + (format-chunk-marker "fmt ") + (format-chunk-length 16) + (format-type #x0001) + (num-channels ,(stream-info-channels stream-info)) + (sample-freq ,(stream-info-sample-rate stream-info)) + (bytes/sec ,(* (stream-info-sample-rate stream-info) + (stream-info-channels stream-info) + (floor-quotient (stream-info-bits-per-sample stream-info) 8))) + (block-alignment ,(* (stream-info-channels stream-info) + (floor-quotient (stream-info-bits-per-sample stream-info) 8))) + (bits-per-sample ,(stream-info-bits-per-sample stream-info)) + (data-chunk-header "data") + (data-chunk-size ,(* (stream-info-samples stream-info) + (stream-info-channels stream-info) + (floor-quotient (stream-info-bits-per-sample stream-info) 8))))))) + (with-output-to-file outfile + (lambda () + (put-bytevector (current-output-port) (bytestructure-unwrap wav-header)) + (let frame-loop ((frame-number 0) + (frame (read-flac-frame stream-info))) + (if (= (stream-info-samples stream-info) frame-number) + #t + (begin + (write-frame frame (stream-info-channels stream-info)) + (frame-loop (+ 1 frame-number) + (read-flac-frame stream-info)))))))))))))) diff --git a/src/flac/metadata.scm b/src/flac/metadata.scm index 68ef626..06a30cc 100644 --- a/src/flac/metadata.scm +++ b/src/flac/metadata.scm @@ -88,7 +88,7 @@ (read-metadata-block metadata block-length block-type) (metadata-loop (read-metadata-block metadata block-length block-type)))))) - ; FIXME: bail early if not in type +;;; FIXME: bail early if not in type (define (read-flac-metadata-type type) (let metadata-loop () (receive (last-block? block-type block-length) @@ -103,14 +103,16 @@ (metadata-loop)))))) (define* (flac-metadata port #:optional (type #f)) - (with-flac-input-port port - (λ () - (if (symbol? type) - (read-flac-metadata-type type) - (read-flac-metadata))))) + (with-flac-input-port + port + (λ () + (if (symbol? type) + (read-flac-metadata-type type) + (read-flac-metadata))))) (define* (flac-file-metadata filename #:optional (type #f)) - (with-flac-input-port (open-input-file filename #:binary #t) - (λ () - (flac-read/assert-magic) - (flac-metadata (current-input-port) type)))) + (with-flac-input-port + (open-input-file filename #:binary #t) + (λ () + (flac-read/assert-magic) + (flac-metadata (current-input-port) type))))