From ea2e1177b5401446d070abc85119db4d5e0b078f Mon Sep 17 00:00:00 2001 From: Steve Ayerhart Date: Mon, 1 Aug 2022 16:59:46 -0400 Subject: [PATCH] test --- src/flac/decoder.scm | 14 ++++++++++---- src/flac/format.scm | 35 ++++++++++++++++++++++++++++++++++- src/flac/metadata.scm | 2 +- src/flac/reader.scm | 12 ++++++++++++ 4 files changed, 57 insertions(+), 6 deletions(-) diff --git a/src/flac/decoder.scm b/src/flac/decoder.scm index d3e9335..9836bce 100644 --- a/src/flac/decoder.scm +++ b/src/flac/decoder.scm @@ -95,7 +95,10 @@ (%make-subframe-verbatim (list-ec (: b blocksize) (bitwise-arithmetic-shift (flac-read-sint sample-depth) wasted-bits)))) -(define (read-subframe-fixed) #f) +(define (read-subframe-fixed predictor-order blocksize sample-depth) + (format #t "bitdepth: ~a\n" sample-depth) + (let ((warmup ((list-ec (: o predictor-order) (flac-read-sint sample-depth))))) + raw)) (define (read-subframe-lpc) #f) @@ -108,11 +111,12 @@ ;;; 1xxxxx lpc xxxxx = order - 1 (define (read-subframe-type) (let ([raw (flac-read-uint 6)]) + (format #t "raw: ~a\n" raw) (cond [(= raw #b000000) (values #f 'constant)] [(= raw #b000001) (values #f 'verbatim)] - [(between? raw #b0010000 #b001100) (values (bit-extract raw 0 4) 'fixed)] - [(between? raw #b1000000 #b111111) (values (bit-extract raw 0 6) 'lpc)] + [(between? raw #b001000 #b001100) (values (bit-extract raw 0 3) 'fixed)] + [(between? raw #b100000 #b111111) (values (bit-extract raw 0 6) 'lpc)] (else (values #f #f))))) (define (read-subframe-header) @@ -124,18 +128,20 @@ (define (read-subframe frame-header channel) (let* ([subframe-header (read-subframe-header)] [wasted-bits (subframe-header-wasted-bits subframe-header)] + [predictor-order (subframe-header-predictor-order subframe-header)] [sample-depth (calculate-sample-depth (frame-header-bits-per-sample frame-header) wasted-bits (frame-header-channel-assignment frame-header) channel)] [blocksize (frame-header-blocksize frame-header)]) + (format #t "sf: ~a\n" subframe-header) (%make-subframe subframe-header (match (subframe-header-subframe-type subframe-header) ('constant (read-subframe-constant blocksize sample-depth wasted-bits)) ('verbatim (read-subframe-verbatim blocksize sample-depth wasted-bits)) - ('fixed (read-subframe-fixed)) + ('fixed (read-subframe-fixed predictor-order blocksize sample-depth)) ('lpx (read-subframe-lpc)))))) (define (read-subframes stream-info frame-header) diff --git a/src/flac/format.scm b/src/flac/format.scm index ffbd349..513c213 100644 --- a/src/flac/format.scm +++ b/src/flac/format.scm @@ -32,9 +32,22 @@ %make-subframe-constant subframe-constant-value + %make-subframe-verbatim subframe-verbatim-data + %make-partitioned-rice + partitioned-rice-order partitioned-rice-contents + + %make-entropy-coding-method + entropy-coding-method-type entropy-coding-method-data + + %make-subframe-fixed + subframe-fixed-entropy-coding-method + subframe-fixed-predictor-order + subframe-fixed-warmup + subframe-fixed-residual + make-metadata-block-header metadata-block-header-last? metadata-block-header-type @@ -116,6 +129,26 @@ make-metadata-stream-info metadata-stream-info? subframe-constant? (value subframe-constant-value)) +(define-record-type + (%make-rice-partition order contents) + rice-partition? + (order rice-partition-order) + (contents rice-partition-contents)) + +(define-record-type + (%make-entropy-coding-method type data) + entropy-coding-method? + (type entropy-coding-method-type) + (data entropy-coding-method-data)) + +(define-record-type + (%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 (make-frame-header blocking-strategy blocksize sample-rate channel-assignment bits-per-sample frame/sample-number crc) frame-header? @@ -292,7 +325,7 @@ make-metadata-stream-info metadata-stream-info? (λ (record port) (format port "#<") - (let ((getters '(flac-metadata-stream-info flac-metadata-vorbis-comment flac-metadata-application flac-metadata-cuesheet flac-metadata-pictures flac-metadata-seek-table))) + (let ((getters '(flac-metadata-stream-info flac-metadata-vorbis-comment flac-metadata-application flac-metadata-cuesheet flac-metadata-pictures flac-metadata-seek-table flac-metadata-padding))) (for-each (λ (getter) (when ((primitive-eval getter) record) (regexp-substitute/global port "flac-metadata-" (symbol->string getter) 'pre " " 'post))) diff --git a/src/flac/metadata.scm b/src/flac/metadata.scm index 7753f3b..fd77f5d 100644 --- a/src/flac/metadata.scm +++ b/src/flac/metadata.scm @@ -44,7 +44,7 @@ (map (λ (_) (string-split (utf8->string (flac-read-bytes (read-native-u32))) #\=)) (iota (read-native-u32))))) (define (read-metadata-block-padding length) - (flac-read-uint length) + (flac-read-bytes length) (make-metadata-padding length)) (define (read-metadata-block-picture) diff --git a/src/flac/reader.scm b/src/flac/reader.scm index f3a71b1..4c90a14 100644 --- a/src/flac/reader.scm +++ b/src/flac/reader.scm @@ -11,6 +11,7 @@ flac-read-sint flac-read-bytes flac-read-coded-number + flac-read-rice-sint with-flac-input-port new-flac-reader make-flac-reader @@ -66,6 +67,17 @@ (let ([uint (flac-read-uint bits)]) (- uint (bitwise-arithmetic-shift (bitwise-arithmetic-shift-right uint (- bits 1)) bits)))) +(define (flac-read-rice-sint param) + (let rice-loop ([val 0]) + (if (= 0 (flac-read-uint 1)) + (rice-loop (+ 1 val)) + (let ([val (bitwise-ior + (bitwise-arithmetic-shift val param) + (flac-read-uint param))]) + (bitwise-xor + (bitwise-arithmetic-shift-left val 1) + (* -1 (bitwise-and val 1))))))) + (define (flac-read/assert-magic) (unless (= FLAC-MAGIC (flac-read-uint 32)) #f))