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

64
src/flac/decoder.scm
View File

@ -217,28 +217,59 @@
(%make-subframe subframe-header subframe)
samples))))
;; TODO: clean up the channel decorrelation this is kind of ugly
(define (read-subframes stream-info frame-header)
(let ((channels (stream-info-channels stream-info)))
(let subframe-loop ((channel 0)
(let ((channels (stream-info-channels stream-info))
(channel-assignment (frame-header-channel-assignment frame-header)))
(if (eq? 'independent channel-assignment)
; do nothing loop over channels
(let channel-loop ((channel 0)
(subframes '())
(samples '()))
(if (>= channel channels)
(begin
(align-to-byte)
(values subframes samples))
(let-values (((subframe subframe-samples)
(read-subframe frame-header channel)))
(subframe-loop (+ 1 channel)
(cons subframe subframes)
(cons subframe-samples samples)))))))
(values subframes samples)
(let-values (((subframe subframe-samples) (read-subframe frame-header channel)))
(channel-loop (+ 1 channel)
(append subframes (list subframe))
(append samples (list subframe-samples))))))
(let-values (((channel-0-subframe channel-0-samples) (read-subframe frame-header 0))
((channel-1-subframe channel-1-samples) (read-subframe frame-header 1)))
(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
; (λ (header channel)
; (read-subframe header channel))
; (make-list channels frame-header)
; (iota channels))))
;(define (read-subframes stream-info frame-header)
; (let ((channels (stream-info-channels stream-info)))
; (let subframe-loop ((channel 0)
; (subframes '())
; (samples '()))
; (if (>= channel channels)
; (begin
; (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)
(read/assert-frame-sync-code)
@ -268,5 +299,6 @@
(define (read-flac-frame stream-info)
(let ((header (read-frame-header stream-info)))
(let-values (((subframes samples) (read-subframes stream-info header)))
(align-to-byte)
(let ((footer (read-frame-footer)))
(%make-frame header subframes footer samples)))))