working decoder?

src/flac.scm

@@ -44,7 +44,8 @@
      (iota (frame-header-blocksize header)))))
 
 (define (decode-flac-file infile outfile)
-  (with-input-from-file infile
+  (let ((old-output (current-output-port)))
+    (with-input-from-file infile
     (λ ()
       (with-flac-input-port (current-input-port)
         (λ ()
@@ -87,4 +88,20 @@
                         (write-frame frame (stream-info-channels stream-info))
                         (frame-loop (+ 1 frame-number)
                                     (read-flac-frame stream-info))))))
-              #:binary #t)))))))
+              #:binary #t))))))))
+;
+;            (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))
+;                (let frame-loop ((frame-number 0)
+;                                 (frame (read-flac-frame stream-info)))
+;                  (if (= (stream-info-samples stream-info) frame-number)
+;                      #t
+;                      (begin
+;                        (format old-output "frame ~a\n" frame)
+;                        (write-frame frame (stream-info-channels stream-info))
+;                        (frame-loop (+ 1 frame-number)
+;                                    (read-flac-frame stream-info))))))))))))
+;              #:binary #t))))))))

src/flac/decoder.scm

@@ -114,7 +114,7 @@
                           (parameters '())
                           (raw-bits '())
                           (residual '()))
-        (if (= partition partitions)
+        (if (>= partition partitions)
             (values (%make-entropy-coding-method
                      coding-method
                      (%make-rice-partition

src/flac/format.scm

@@ -120,7 +120,6 @@
   (header subframe-header)
   (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?
@@ -169,7 +168,6 @@
   (type entropy-coding-method-type)
   (data entropy-coding-method-data))
 
-
 (define-record-type <frame-header>
   (make-frame-header blocking-strategy blocksize sample-rate channel-assignment bits-per-sample frame/sample-number crc)
   frame-header?
@@ -332,6 +330,11 @@
  (λ (record port)
    (format port "#<<picture> type: ~a mime-type: ~a>" (picture-type record) (picture-mime-type record))))
 
+(set-record-type-printer!
+ <frame>
+ (λ (record port)
+   (format port "#<<frame> header: ~a>" (frame-header record))))
+
 (define-record-type <flac-metadata>
   (make-flac-metadata stream-info padding application seek-table vorbis-comment cuesheet pictures)
   flac-metadata?

src/flac/reader.scm

@@ -93,4 +93,6 @@
   (let coded-number-loop ((coded-sample-number (flac-read-uint 8)))
     (if (< coded-sample-number #b11000000)
         coded-sample-number
-        (coded-number-loop (bitwise-and (bitwise-arithmetic-shift coded-sample-number 1) #xff)))))
+        (begin
+          (flac-read-uint 8)
+          (coded-number-loop (bitwise-and (bitwise-arithmetic-shift coded-sample-number 1) #xff))))))