small cleanup

main
Steve Ayerhart 2022-11-06 23:26:37 -05:00
parent 5340fc7bae
commit 54633487c5
No known key found for this signature in database
GPG Key ID: 4CB33EB9BB156C97
2 changed files with 52 additions and 68 deletions

View File

@ -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))))))))))))))

View File

@ -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))))