test

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)

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 <rice-partition>
+  (%make-rice-partition order contents)
+  rice-partition?
+  (order rice-partition-order)
+  (contents rice-partition-contents))
+
+(define-record-type <entropy-coding-method>
+  (%make-entropy-coding-method type data)
+  entropy-coding-method?
+  (type entropy-coding-method-type)
+  (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>
   (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?
  <flac-metadata>
  (λ (record port)
    (format port "#<<flac-metadata>")
-   (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)))

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)

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))