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

sounds right...before a sync error

main
Steve Ayerhart 2022-08-13 14:30:09 -04:00
parent f2a62a3990
commit 3b96fbc28d
No known key found for this signature in database
GPG Key ID: 4CB33EB9BB156C97
2 changed files with 57 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/flac.scm
View File

@ -29,15 +29,16 @@
(let* ((header (frame-header frame)) (let* ((header (frame-header frame))
(total-bytes (floor-quotient (frame-header-bits-per-sample header) 8)) (total-bytes (floor-quotient (frame-header-bits-per-sample header) 8))
(addend (if (= 8 (frame-header-bits-per-sample header)) 128 0)) (addend (if (= 8 (frame-header-bits-per-sample header)) 128 0))
(data-bv (make-bytevector 4))) (data-bv (make-bytevector total-bytes)))
(for-each (for-each
(lambda (block) (lambda (block)
(for-each (for-each
(lambda (channel) (lambda (channel)
(bytevector-s32-set! data-bv (bytevector-sint-set! data-bv
0 0
(+ addend (list-ref (list-ref (frame-samples frame) channel) block)) (+ addend (list-ref (list-ref (frame-samples frame) channel) block))
(endianness little)) (endianness little)
total-bytes)
(put-bytevector (current-output-port) data-bv)) (put-bytevector (current-output-port) data-bv))
(iota channels))) (iota channels)))
(iota (frame-header-blocksize header))))) (iota (frame-header-blocksize header)))))
@ -74,6 +75,7 @@
(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)) (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 (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))

64
src/flac/decoder.scm
View File

@ -217,28 +217,59 @@
(%make-subframe subframe-header subframe) (%make-subframe subframe-header subframe)
samples)))) samples))))
;; TODO: clean up the channel decorrelation this is kind of ugly
(define (read-subframes stream-info frame-header) (define (read-subframes stream-info frame-header)
(let ((channels (stream-info-channels stream-info))) (let ((channels (stream-info-channels stream-info))
(let subframe-loop ((channel 0) (channel-assignment (frame-header-channel-assignment frame-header)))
(if (eq? 'independent channel-assignment)
; do nothing loop over channels
(let channel-loop ((channel 0)
(subframes '()) (subframes '())
(samples '())) (samples '()))
(if (>= channel channels) (if (>= channel channels)
(begin (values subframes samples)
(align-to-byte) (let-values (((subframe subframe-samples) (read-subframe frame-header channel)))
(values subframes samples)) (channel-loop (+ 1 channel)
(let-values (((subframe subframe-samples) (append subframes (list subframe))
(read-subframe frame-header channel))) (append samples (list subframe-samples))))))
(subframe-loop (+ 1 channel) (let-values (((channel-0-subframe channel-0-samples) (read-subframe frame-header 0))
(cons subframe subframes) ((channel-1-subframe channel-1-samples) (read-subframe frame-header 1)))
(cons subframe-samples samples))))))) (match channel-assignment
('left (values
(list channel-0-subframe channel-1-subframe)
(list channel-0-samples (map - channel-0-samples channel-1-samples))))
('right (values
(list channel-0-subframe channel-1-subframe)
(list (map + channel-0-samples channel-1-samples) channel-1-samples)))
('mid (values
(list channel-0-subframe channel-1-subframe)
(fold
(λ (channel-0 channel-1 samples)
(let* ((channel-0-samples (first samples))
(channel-1-samples (second samples))
(side channel-1)
(right (- channel-0 (bitwise-arithmetic-shift-right side 1))))
(list
(append channel-0-samples (list right))
(append channel-1-samples (list (+ right side))))))
'(() ())
channel-0-samples
channel-1-samples))))))))
; (subframes (map ;(define (read-subframes stream-info frame-header)
; (λ (header channel) ; (let ((channels (stream-info-channels stream-info)))
; (read-subframe header channel)) ; (let subframe-loop ((channel 0)
; (make-list channels frame-header) ; (subframes '())
; (iota channels)))) ; (samples '()))
; (if (>= channel channels)
; (begin
; (align-to-byte) ; (align-to-byte)
; subframes)) ; (values subframes samples))
; (let-values (((subframe subframe-samples)
; (read-subframe frame-header channel)))
; (subframe-loop (+ 1 channel)
; (cons subframe subframes)
; (cons subframe-samples samples)))))))
(define-public (read-frame-header stream-info) (define-public (read-frame-header stream-info)
(read/assert-frame-sync-code) (read/assert-frame-sync-code)
@ -268,5 +299,6 @@
(define (read-flac-frame stream-info) (define (read-flac-frame stream-info)
(let ((header (read-frame-header stream-info))) (let ((header (read-frame-header stream-info)))
(let-values (((subframes samples) (read-subframes stream-info header))) (let-values (((subframes samples) (read-subframes stream-info header)))
(align-to-byte)
(let ((footer (read-frame-footer))) (let ((footer (read-frame-footer)))
(%make-frame header subframes footer samples))))) (%make-frame header subframes footer samples)))))