steve
/
guile-flac
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
src/flac.scm
View File

@ -46,62 +46,44 @@
(define (decode-flac-file infile outfile) (define (decode-flac-file infile outfile)
(let ((old-output (current-output-port))) (let ((old-output (current-output-port)))
(with-input-from-file infile (with-input-from-file infile
(λ () (λ ()
(with-flac-input-port (current-input-port) (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) (let* ((stream-info (flac-metadata-stream-info (read-flac-metadata)))
(stream-info-channels stream-info) (sample-data-length (* (stream-info-samples stream-info)
(floor-quotient (stream-info-bits-per-sample stream-info) 8))) (stream-info-channels stream-info)
(wav-header (bytestructure (floor-quotient (stream-info-bits-per-sample stream-info) 8)))
header-struct (wav-header (bytestructure
`((filetype "RIFF") header-struct
(filesize ,(+ 36 (* (stream-info-samples stream-info) `((filetype "RIFF")
(stream-info-channels stream-info) (filesize ,(+ 36 (* (stream-info-samples 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)
(stream-info-channels stream-info) (stream-info-channels stream-info)
(floor-quotient (stream-info-bits-per-sample stream-info) 8))))))) (floor-quotient (stream-info-bits-per-sample stream-info) 8))))
(format #t "SAMPLES: ~a\n" (stream-info-samples stream-info)) (filetype-header "WAVE")
(format #t "bps: ~a\n" (stream-info-bits-per-sample stream-info)) (format-chunk-marker "fmt ")
(with-output-to-file outfile (format-chunk-length 16)
(lambda () (format-type #x0001)
(put-bytevector (current-output-port) (bytestructure-unwrap wav-header)) (num-channels ,(stream-info-channels stream-info))
(let frame-loop ((frame-number 0) (sample-freq ,(stream-info-sample-rate stream-info))
(frame (read-flac-frame stream-info))) (bytes/sec ,(* (stream-info-sample-rate stream-info)
(if (= (stream-info-samples stream-info) frame-number) (stream-info-channels stream-info)
#t (floor-quotient (stream-info-bits-per-sample stream-info) 8)))
(begin (block-alignment ,(* (stream-info-channels stream-info)
(write-frame frame (stream-info-channels stream-info)) (floor-quotient (stream-info-bits-per-sample stream-info) 8)))
(frame-loop (+ 1 frame-number) (bits-per-sample ,(stream-info-bits-per-sample stream-info))
(read-flac-frame stream-info)))))) (data-chunk-header "data")
#:binary #t)))))))) (data-chunk-size ,(* (stream-info-samples stream-info)
; (stream-info-channels stream-info)
; (format #t "SAMPLES: ~a\n" (stream-info-samples stream-info)) (floor-quotient (stream-info-bits-per-sample stream-info) 8)))))))
; (format #t "bps: ~a\n" (stream-info-bits-per-sample stream-info)) (with-output-to-file outfile
; (with-output-to-file outfile (lambda ()
; (lambda () (put-bytevector (current-output-port) (bytestructure-unwrap wav-header))
; (put-bytevector (current-output-port) (bytestructure-unwrap wav-header)) (let frame-loop ((frame-number 0)
; (let frame-loop ((frame-number 0) (frame (read-flac-frame stream-info)))
; (frame (read-flac-frame stream-info))) (if (= (stream-info-samples stream-info) frame-number)
; (if (= (stream-info-samples stream-info) frame-number) #t
; #t (begin
; (begin (write-frame frame (stream-info-channels stream-info))
; (format old-output "frame ~a\n" frame) (frame-loop (+ 1 frame-number)
; (write-frame frame (stream-info-channels stream-info)) (read-flac-frame stream-info))))))))))))))
; (frame-loop (+ 1 frame-number)
; (read-flac-frame stream-info))))))))))))
; #:binary #t))))))))

22
src/flac/metadata.scm
View File

@ -88,7 +88,7 @@
(read-metadata-block metadata block-length block-type) (read-metadata-block metadata block-length block-type)
(metadata-loop (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) (define (read-flac-metadata-type type)
(let metadata-loop () (let metadata-loop ()
(receive (last-block? block-type block-length) (receive (last-block? block-type block-length)
@ -103,14 +103,16 @@
(metadata-loop)))))) (metadata-loop))))))
(define* (flac-metadata port #:optional (type #f)) (define* (flac-metadata port #:optional (type #f))
(with-flac-input-port port (with-flac-input-port
(λ () port
(if (symbol? type) (λ ()
(read-flac-metadata-type type) (if (symbol? type)
(read-flac-metadata))))) (read-flac-metadata-type type)
(read-flac-metadata)))))
(define* (flac-file-metadata filename #:optional (type #f)) (define* (flac-file-metadata filename #:optional (type #f))
(with-flac-input-port (open-input-file filename #:binary #t) (with-flac-input-port
(λ () (open-input-file filename #:binary #t)
(flac-read/assert-magic) (λ ()
(flac-metadata (current-input-port) type)))) (flac-read/assert-magic)
(flac-metadata (current-input-port) type))))