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

lpc seems to be reading correctly now

main
Steve Ayerhart 2022-08-08 14:42:07 -04:00
parent cf27bdeb64
commit 0e31e3f21a
No known key found for this signature in database
GPG Key ID: 4CB33EB9BB156C97
3 changed files with 47 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/flac/decoder.scm
View File

@ -122,19 +122,18 @@
(let ((rice-parameter (flac-read-uint param-bits))) (let ((rice-parameter (flac-read-uint param-bits)))
(if (< rice-parameter escape-param) (if (< rice-parameter escape-param)
(let ((count (if (= 0 partition) (- partition-samples predictor-order) partition-samples))) (let ((count (if (= 0 partition) (- partition-samples predictor-order) partition-samples)))
(format #t "samples ~a\n" count)
(residual-loop (+ sample count) (residual-loop (+ sample count)
(+ 1 partition) (+ 1 partition)
(cons rice-parameter parameters) (cons rice-parameter parameters)
(cons 0 raw-bits) (cons 0 raw-bits)
(list-ec (: c count) (flac-read-rice-sint rice-parameter)))) (list-ec (: c count) (flac-read-rice-sint rice-parameter))))
(let ((num-bits ((flac-read-sint 5)))) (let ((num-bits (flac-read-sint 5)))
(residual-loop sample (residual-loop sample
(+ 1 partition) (+ 1 partition)
(cons rice-parameter parameters) (cons rice-parameter parameters)
(cons num-bits raw-bits) (cons num-bits raw-bits)
(let ((order (if (= 0 partition) predictor-order 0))) (let ((order (- partition-samples (if (= 0 partition) predictor-order 0))))
(if (= 0 raw-bits) (if (= 0 num-bits)
(list-ec (: o order) 0) (list-ec (: o order) 0)
(list-ec (: o order) (flac-read-sint num-bits))))))))))))) (list-ec (: o order) (flac-read-sint num-bits)))))))))))))
@ -144,7 +143,13 @@
(let-values (((entropy-coding-method residual) (read-residual-partiioned-rice blocksize predictor-order))) (let-values (((entropy-coding-method residual) (read-residual-partiioned-rice blocksize predictor-order)))
(%make-subframe-fixed entropy-coding-method predictor-order warmup residual)))) (%make-subframe-fixed entropy-coding-method predictor-order warmup residual))))
(define (read-subframe-lpc) #f) (define (read-subframe-lpc lpc-order blocksize sample-depth)
(let* ((warmup (list-ec (: o lpc-order) (flac-read-sint sample-depth)))
(precision (+ 1 (flac-read-uint 4)))
(shift (flac-read-sint 5))
(coefs (list-ec (: o lpc-order) (flac-read-sint precision))))
(let-values (((entropy-coding-method residual) (read-residual-partiioned-rice blocksize lpc-order)))
(%make-subframe-lpc entropy-coding-method lpc-order precision shift coefs warmup residual))))
;;; 000000 constant ;;; 000000 constant
;;; 000001 verbatim ;;; 000001 verbatim
@ -159,7 +164,7 @@
[(= raw #b000000) (values #f 'constant)] [(= raw #b000000) (values #f 'constant)]
[(= raw #b000001) (values #f 'verbatim)] [(= raw #b000001) (values #f 'verbatim)]
[(between? raw #b001000 #b001100) (values (bit-extract raw 0 3) 'fixed)] [(between? raw #b001000 #b001100) (values (bit-extract raw 0 3) 'fixed)]
[(between? raw #b100000 #b111111) (values (bit-extract raw 0 6) 'lpc)] [(between? raw #b100000 #b111111) (values (+ 1 (bit-extract raw 0 5)) 'lpc)]
(else (values #f #f))))) (else (values #f #f)))))
(define (read-subframe-header) (define (read-subframe-header)
@ -178,14 +183,13 @@
(frame-header-channel-assignment frame-header) (frame-header-channel-assignment frame-header)
channel)] channel)]
[blocksize (frame-header-blocksize frame-header)]) [blocksize (frame-header-blocksize frame-header)])
(format #t "sf: ~a\n" subframe-header)
(%make-subframe (%make-subframe
subframe-header subframe-header
(match (subframe-header-subframe-type subframe-header) (match (subframe-header-subframe-type subframe-header)
('constant (read-subframe-constant blocksize sample-depth wasted-bits)) ('constant (read-subframe-constant blocksize sample-depth wasted-bits))
('verbatim (read-subframe-verbatim blocksize sample-depth wasted-bits)) ('verbatim (read-subframe-verbatim blocksize sample-depth wasted-bits))
('fixed (read-subframe-fixed predictor-order blocksize sample-depth)) ('fixed (read-subframe-fixed predictor-order blocksize sample-depth))
('lpx (read-subframe-lpc)))))) ('lpc (read-subframe-lpc predictor-order blocksize sample-depth))))))
(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)]

28
src/flac/format.scm
View File

@ -36,6 +36,8 @@
%make-subframe-verbatim %make-subframe-verbatim
subframe-verbatim-data subframe-verbatim-data
%make-subframe-lpc
%make-rice-partition %make-rice-partition
partitioned-rice-order partitioned-rice-contents partitioned-rice-order partitioned-rice-contents
@ -118,11 +120,30 @@ make-metadata-stream-info metadata-stream-info?
(header subframe-header) (header subframe-header)
(data subframe-data)) (data subframe-data))
(define-record-type <subframe-lpc>
(%make-subframe-lpc entropy-coding-method order qlp-coefficient-precision quantization-level qlp-coefficients warmup residual)
subframe-lpc?
(entropy-coding-method subframe-lpc-entropy-coding-method)
(order subframe-lpc-order)
(qlp-coefficient-precision subframe-lpc-qlp-coefficient-precision)
(quantization-level subframe-lpc-quantization-level)
(qlp-coefficients subframe-lpc-qlp-coefficients)
(warmup subframe-lpc-warmup)
(residual subframe-lpc-residual))
(define-record-type <subframe-verbatim> (define-record-type <subframe-verbatim>
(%make-subframe-verbatim value) (%make-subframe-verbatim value)
subframe-verbatim? subframe-verbatim?
(value subframe-verbatim-value)) (value subframe-verbatim-value))
(define-record-type <subframe-fixed>
(%make-subframe-fixed entropy-coding-method predictor-order warmup residual)
subframe-fixed?
(entropy-coding-method subframe-fixed-entropy-coding-method)
(predictor-order subframe-fix-predictor-order)
(warmup subframe-fixed-warmup)
(residual subframe-fixed-residual))
(define-record-type <subframe-constant> (define-record-type <subframe-constant>
(%make-subframe-constant value) (%make-subframe-constant value)
subframe-constant? subframe-constant?
@ -147,13 +168,6 @@ make-metadata-stream-info metadata-stream-info?
(type entropy-coding-method-type) (type entropy-coding-method-type)
(data entropy-coding-method-data)) (data entropy-coding-method-data))
(define-record-type <subframe-fixed>
(%make-subframe-fixed entropy-coding-method predictor-order warmup residual)
subframe-fixed?
(entropy-coding-method subframe-fixed-entropy-coding-method)
(predictor-order subframe-fix-predictor-order)
(warmup subframe-fixed-warmup)
(residual subframe-fixed-residual))
(define-record-type <frame-header> (define-record-type <frame-header>
(make-frame-header blocking-strategy blocksize sample-rate channel-assignment bits-per-sample frame/sample-number crc) (make-frame-header blocking-strategy blocksize sample-rate channel-assignment bits-per-sample frame/sample-number crc)

21
src/flac/tests.scm
View File

@ -9,6 +9,13 @@
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
(define example-1
#vu8(#x66 #x4c #x61 #x43 #x80 #x00 #x00 #x22 #x10 #x00 #x10 #x00
#x00 #x00 #x0f #x00 #x00 #x0f #x0a #xc4 #x42 #xf0 #x00 #x00
#x00 #x01 #x3e #x84 #xb4 #x18 #x07 #xdc #x69 #x03 #x07 #x58
#x6a #x3d #xad #x1a #x2e #x0f #xff #xf8 #x69 #x18 #x00 #x00
#xbf #x03 #x58 #xfd #x03 #x12 #x8b #xaa #x9a))
(define example-2 (define example-2
#vu8(#x66 #x4c #x61 #x43 #x00 #x00 #x00 #x22 #x00 #x10 #x00 #x10 #vu8(#x66 #x4c #x61 #x43 #x00 #x00 #x00 #x22 #x00 #x10 #x00 #x10
#x00 #x00 #x17 #x00 #x00 #x44 #x0a #xc4 #x42 #xf0 #x00 #x00 #x00 #x00 #x17 #x00 #x00 #x44 #x0a #xc4 #x42 #xf0 #x00 #x00
@ -30,18 +37,18 @@
#xff #xf8 #x69 #x18 #x01 #x02 #xa4 #x02 #xc3 #x82 #xc4 #x0b #xff #xf8 #x69 #x18 #x01 #x02 #xa4 #x02 #xc3 #x82 #xc4 #x0b
#xc1 #x4a #x03 #xee #x48 #xdd #x03 #xb6 #x7c #x13 #x30)) #xc1 #x4a #x03 #xee #x48 #xdd #x03 #xb6 #x7c #x13 #x30))
(define example-1 (define example-3
#vu8(#x66 #x4c #x61 #x43 #x80 #x00 #x00 #x22 #x10 #x00 #x10 #x00 #vu8(#x66 #x4c #x61 #x43 #x80 #x00 #x00 #x22 #x10 #x00 #x10 #x00 #x00
#x00 #x00 #x0f #x00 #x00 #x0f #x0a #xc4 #x42 #xf0 #x00 #x00 #x00 #x1f #x00 #x00 #x1f #x07 #xd0 #x00 #x70 #x00 #x00 #x00
#x00 #x01 #x3e #x84 #xb4 #x18 #x07 #xdc #x69 #x03 #x07 #x58 #x18 #xf8 #xf9 #xe3 #x96 #xf5 #xcb #xcf #xc6 #xdc #x80 #x7f
#x6a #x3d #xad #x1a #x2e #x0f #xff #xf8 #x69 #x18 #x00 #x00 #x99 #x77 #x90 #x6b #x32 #xff #xf8 #x68 #x02 #x00 #x17 #xe9
#xbf #x03 #x58 #xfd #x03 #x12 #x8b #xaa #x9a)) #x44 #x00 #x4f #x6f #x31 #x3d #x10 #x47 #xd2 #x27 #xcb #x6d
#x09 #x08 #x31 #x45 #x2b #xdc #x28 #x22 #x22 #x80 #x57 #xa3))
; (test-begin "RFC Examples") ; (test-begin "RFC Examples")
; ;
; ;
(with-tests (with-tests
"RFC Examples" "RFC Examples"
(test-group "Example 1" (test-group "Example 1"