major refactor
parent
008d217286
commit
e3c7e3e05a
|
|
@ -12,6 +12,7 @@
|
|||
#:use-module (ice-9 receive)
|
||||
#:export (read-flac-frame))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#section-10.1-1
|
||||
(define (read/assert-frame-sync-code)
|
||||
(unless (= #b111111111111100 (flac-read-uint 15))
|
||||
#f))
|
||||
|
|
@ -32,6 +33,7 @@
|
|||
((= raw #b1010) 3)
|
||||
(else #f))))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-block-size-bits
|
||||
(define (decode-block-size raw)
|
||||
(cond
|
||||
((= raw #b0000) 'reserved)
|
||||
|
|
@ -41,6 +43,7 @@
|
|||
((= raw #b0111) (+ 1 (flac-read-uint 16)))
|
||||
((between? raw #b1000 #b1111) (* 256 (expt 2 (- raw 8))))))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-sample-rate-bits
|
||||
(define (decode-sample-rate stream-info raw)
|
||||
(case raw
|
||||
((#b0000) (stream-info-sample-rate stream-info))
|
||||
|
|
@ -60,6 +63,15 @@
|
|||
((#b1110) (* 10 (flac-read-uint 16))) ; sample rate in tens of Hz
|
||||
((#b1111) 'invalid))))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-coded-number
|
||||
(define (flac-read-coded-number)
|
||||
(let coded-number-loop ((coded-sample-number (flac-read-uint 8)))
|
||||
(if (< coded-sample-number #b11000000)
|
||||
coded-sample-number
|
||||
(begin
|
||||
(flac-read-uint 8)
|
||||
(coded-number-loop (bitwise-and (bitwise-arithmetic-shift coded-sample-number 1) #xff))))))
|
||||
|
||||
(define (decode-bits-per-sample stream-info raw)
|
||||
(case raw
|
||||
((#b000) (stream-info-bits-per-sample stream-info))
|
||||
|
|
@ -91,19 +103,27 @@
|
|||
('mid (if (= channel 1) 1 0))
|
||||
(_ 0))))
|
||||
|
||||
(define (read-subframe-constant blocksize sample-depth wasted-bits)
|
||||
(let ((subframe (%make-subframe-constant (make-list blocksize (bitwise-arithmetic-shift (flac-read-sint sample-depth) wasted-bits)))))
|
||||
(values subframe (subframe-constant-value subframe))))
|
||||
|
||||
(define (read-subframe-verbatim blocksize sample-depth wasted-bits)
|
||||
(let ((subframe (%make-subframe-verbatim
|
||||
(list-ec (: b blocksize) (bitwise-arithmetic-shift (flac-read-sint sample-depth) wasted-bits)))))
|
||||
(values subframe (subframe-verbatim-value subframe))))
|
||||
|
||||
(define (read-entropy-coding-method-info)
|
||||
(values (case (flac-read-uint 2) [(#b00) 'rice] [(#b01) 'rice2]) (flac-read-uint 4)))
|
||||
|
||||
(define (read-residual-partiioned-rice blocksize predictor-order)
|
||||
(define (restore-linear-prediction warmup residuals coefficients order shift)
|
||||
(fold (λ (residual samples)
|
||||
(append!
|
||||
samples
|
||||
(list
|
||||
(+ residual
|
||||
(bitwise-arithmetic-shift-right
|
||||
(fold (λ (residual coefficient predictor)
|
||||
(+ predictor (* residual coefficient)))
|
||||
0
|
||||
(take-right samples order)
|
||||
coefficients)
|
||||
shift)))))
|
||||
warmup
|
||||
residuals))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-coded-residual
|
||||
(define (read-residual-partitioned-rice blocksize predictor-order)
|
||||
(let-values (((coding-method partition-order) (read-entropy-coding-method-info)))
|
||||
(let ((param-bits (match coding-method ('rice 4) ('rice2 5) (_ #f)))
|
||||
(escape-param (match coding-method ('rice #xf) ('rice2 #x1f)))
|
||||
|
|
@ -115,12 +135,7 @@
|
|||
(raw-bits '())
|
||||
(residual '()))
|
||||
(if (>= partition partitions)
|
||||
(values (%make-entropy-coding-method
|
||||
coding-method
|
||||
(%make-rice-partition
|
||||
partition-order
|
||||
(%make-entropy-coding-method-partitioned-rice-contents parameters raw-bits #f)))
|
||||
residual)
|
||||
residual
|
||||
(let ((rice-parameter (flac-read-uint param-bits)))
|
||||
(if (< rice-parameter escape-param)
|
||||
(let ((count (if (= 0 partition) (- partition-samples predictor-order) partition-samples)))
|
||||
|
|
@ -140,41 +155,6 @@
|
|||
(make-list order 0)
|
||||
(list-ec (: o order) (flac-read-sint num-bits))))))))))))))
|
||||
|
||||
|
||||
(define (read-subframe-fixed predictor-order blocksize sample-depth)
|
||||
(let ((warmup (list-ec (: o predictor-order) (flac-read-sint sample-depth)))
|
||||
(fixed-coefficients '(() (1) (2 -1) (3 -3 1) (4 -6 4 -1))))
|
||||
(let-values (((entropy-coding-method residual) (read-residual-partiioned-rice blocksize predictor-order)))
|
||||
(values
|
||||
(%make-subframe-fixed entropy-coding-method predictor-order warmup residual)
|
||||
(restore-linear-prediction warmup residual (list-ref fixed-coefficients predictor-order) predictor-order 0)))))
|
||||
|
||||
(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 (reverse (list-ec (: o lpc-order) (flac-read-sint precision)))))
|
||||
(let-values (((entropy-coding-method residual) (read-residual-partiioned-rice blocksize lpc-order)))
|
||||
(values
|
||||
(%make-subframe-lpc entropy-coding-method lpc-order precision shift coefs warmup residual)
|
||||
(restore-linear-prediction warmup residual coefs lpc-order shift)))))
|
||||
|
||||
(define (restore-linear-prediction warmup residuals coefficients order shift)
|
||||
(fold (λ (residual samples)
|
||||
(append
|
||||
samples
|
||||
(list
|
||||
(+ residual
|
||||
(bitwise-arithmetic-shift-right
|
||||
(fold (λ (residual coefficient predictor)
|
||||
(+ predictor (* residual coefficient)))
|
||||
0
|
||||
(take-right samples order)
|
||||
coefficients)
|
||||
shift)))))
|
||||
warmup
|
||||
residuals))
|
||||
|
||||
;;; 000000 constant
|
||||
;;; 000001 verbatim
|
||||
;;; 00001x reserved
|
||||
|
|
@ -191,12 +171,33 @@
|
|||
((between? raw #b100000 #b111111) (values (+ 1 (bit-extract raw 0 5)) 'lpc))
|
||||
(else (values #f #f)))))
|
||||
|
||||
; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-interchannel-decorrelation
|
||||
(define (stereo-decorrelation samples channel-assignment)
|
||||
(match channel-assignment
|
||||
('independent samples)
|
||||
('left (list (first samples) (map! - (first samples) (second samples))))
|
||||
('right (list (second samples) (map! + (first samples) (second samples))))
|
||||
('mid (fold
|
||||
(λ (sample-0 sample-1 samples)
|
||||
(let* ((prev-samples-0 (first samples))
|
||||
(prev-samples-1 (second samples))
|
||||
(side sample-1)
|
||||
(right (- sample-0 (bitwise-arithmetic-shift-right side 1))))
|
||||
(list
|
||||
(append prev-samples-0 (list right))
|
||||
(append prev-samples-1 (list (+ right side))))))
|
||||
'(() ())
|
||||
(first samples)
|
||||
(second samples)))))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-subframe-header
|
||||
(define (read-subframe-header)
|
||||
(read/assert-subframe-sync)
|
||||
(receive (order type)
|
||||
(read-subframe-type)
|
||||
(%make-subframe-header type order (read-subframe-wasted-bits))))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-subframes
|
||||
(define (read-subframe frame-header channel)
|
||||
(let* ((subframe-header (read-subframe-header))
|
||||
(wasted-bits (subframe-header-wasted-bits subframe-header))
|
||||
|
|
@ -207,70 +208,49 @@
|
|||
(frame-header-channel-assignment frame-header)
|
||||
channel))
|
||||
(blocksize (frame-header-blocksize frame-header)))
|
||||
(let-values (((subframe samples)
|
||||
(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 predictor-order blocksize sample-depth))
|
||||
('lpc (read-subframe-lpc predictor-order blocksize sample-depth)))))
|
||||
(values
|
||||
(%make-subframe subframe-header subframe)
|
||||
samples))))
|
||||
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#section-5.3-2.1.1
|
||||
(define (read-subframe-verbatim blocksize sample-depth wasted-bits)
|
||||
(list-ec (: b blocksize) (bitwise-arithmetic-shift (flac-read-sint sample-depth) wasted-bits)))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#section-5.3-2.2.1
|
||||
(define (read-subframe-constant blocksize sample-depth wasted-bits)
|
||||
(make-list blocksize (bitwise-arithmetic-shift (flac-read-sint sample-depth) wasted-bits)))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-fixed-predictor-subframe
|
||||
(define (read-subframe-fixed predictor-order blocksize sample-depth)
|
||||
(let ((warmup (list-ec (: o predictor-order) (flac-read-sint sample-depth)))
|
||||
(fixed-coefficients '(() (1) (2 -1) (3 -3 1) (4 -6 4 -1)))
|
||||
(residual (read-residual-partitioned-rice blocksize predictor-order)))
|
||||
(restore-linear-prediction warmup residual (list-ref fixed-coefficients predictor-order) predictor-order 0)))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-linear-predictor-subframe
|
||||
(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 (reverse (list-ec (: o lpc-order) (flac-read-sint precision))))
|
||||
(residual (read-residual-partitioned-rice blocksize lpc-order)))
|
||||
(restore-linear-prediction warmup residual coefs lpc-order shift)))
|
||||
|
||||
|
||||
;; 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))
|
||||
(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)
|
||||
(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))))))))
|
||||
(map! (λ (channel) (read-subframe frame-header channel)) (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)
|
||||
; (values subframes samples))
|
||||
; (let-values (((subframe subframe-samples)
|
||||
; (read-subframe frame-header channel)))
|
||||
; (subframe-loop (+ 1 channel)
|
||||
; (cons subframe subframes)
|
||||
; (cons subframe-samples samples)))))))
|
||||
e; TODO: actually verify the checksum
|
||||
(define (read-frame-footer)
|
||||
(flac-read-uint 16))
|
||||
|
||||
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-frame-header
|
||||
(define-public (read-frame-header stream-info)
|
||||
(read/assert-frame-sync-code)
|
||||
(let* ((blocking-strategy (decode-blocking-strategy (flac-read-uint 1)))
|
||||
|
|
@ -292,13 +272,9 @@
|
|||
frame/sample-number
|
||||
crc)))
|
||||
|
||||
;; TODO: actually verify the checksum
|
||||
(define (read-frame-footer)
|
||||
(flac-read-uint 16))
|
||||
|
||||
(define (read-flac-frame stream-info)
|
||||
(let ((header (read-frame-header stream-info)))
|
||||
(let-values (((subframes samples) (read-subframes stream-info header)))
|
||||
(let* ((header (read-frame-header stream-info))
|
||||
(samples (read-subframes stream-info header)))
|
||||
(align-to-byte)
|
||||
(let ((footer (read-frame-footer)))
|
||||
(%make-frame header subframes footer samples)))))
|
||||
(%make-frame header footer samples))))
|
||||
|
|
|
|||
|
|
@ -69,6 +69,8 @@
|
|||
stream-info-bits-per-sample stream-info-samples stream-info-md5
|
||||
|
||||
make-metadata-vorbis-comment
|
||||
vorbis-comment-vendor
|
||||
vorbis-comment-comments
|
||||
|
||||
make-flac-metadata
|
||||
flac-metadata-stream-info set-flac-metadata-stream-info!
|
||||
|
|
@ -185,10 +187,9 @@
|
|||
(crc frame-footer-crc))
|
||||
|
||||
(define-record-type <frame>
|
||||
(%make-frame header subframes footer samples)
|
||||
(%make-frame header footer samples)
|
||||
frame?
|
||||
(header frame-header)
|
||||
(subframes frame-subframes)
|
||||
(footer frame-footer)
|
||||
(samples frame-samples))
|
||||
|
||||
|
|
@ -224,10 +225,10 @@
|
|||
(samples stream-info-samples)
|
||||
(md5 stream-info-md5))
|
||||
|
||||
(set-record-type-printer!
|
||||
<stream-info>
|
||||
(λ (record port)
|
||||
(format port "#<stream-info>")))
|
||||
;(set-record-type-printer!
|
||||
; <stream-info>
|
||||
; (λ (record port)
|
||||
; (format port "#<stream-info>")))
|
||||
|
||||
(define-record-type <seek-table>
|
||||
(make-metadata-seek-table seek-points)
|
||||
|
|
@ -330,10 +331,10 @@
|
|||
(λ (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))))
|
||||
; (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)
|
||||
|
|
|
|||
|
|
@ -2,16 +2,18 @@
|
|||
#:use-module (flac format)
|
||||
#:use-module (flac reader)
|
||||
|
||||
#:use-module (bytestructures guile)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 optargs)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module (rnrs enums)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (srfi srfi-1)
|
||||
|
||||
#:export (read-flac-metadata flac-metadata flac-file-metadata))
|
||||
|
||||
(define (read-metadata-block-header)
|
||||
(make-metadata-block-header
|
||||
(define-public (read-metadata-block-header)
|
||||
(values
|
||||
(= 1 (flac-read-uint 1))
|
||||
(list-ref (enum-set->list flac-metadata-type) (flac-read-uint 7))
|
||||
(flac-read-uint 24)))
|
||||
|
|
@ -79,29 +81,26 @@
|
|||
|
||||
(define (read-flac-metadata)
|
||||
(flac-read/assert-magic)
|
||||
(let metadata-loop ((metadata (make-flac-metadata #f #f #f #f #f #f #f))
|
||||
(header (read-metadata-block-header)))
|
||||
(if (metadata-block-header-last? header)
|
||||
(read-metadata-block metadata (metadata-block-header-length header) (metadata-block-header-type header))
|
||||
(metadata-loop (read-metadata-block
|
||||
metadata
|
||||
(metadata-block-header-length header)
|
||||
(metadata-block-header-type header))
|
||||
(read-metadata-block-header)))))
|
||||
(let metadata-loop ((metadata (make-flac-metadata #f #f #f #f #f #f #f)))
|
||||
(receive (last-block? block-type block-length)
|
||||
(read-metadata-block-header)
|
||||
(if last-block?
|
||||
(read-metadata-block metadata block-length block-type)
|
||||
(metadata-loop (read-metadata-block metadata block-length block-type))))))
|
||||
|
||||
; FIXME: bail early if not in type
|
||||
(define (read-flac-metadata-type type)
|
||||
(flac-read/assert-magic)
|
||||
(let metadata-loop ((header (read-metadata-block-header)))
|
||||
(if (or (metadata-block-header-last? header)
|
||||
(equal? type (metadata-block-header-type header)))
|
||||
(let metadata-loop ()
|
||||
(receive (last-block? block-type block-length)
|
||||
(read-metadata-block-header)
|
||||
(if (or last-block? (equal? type block-type))
|
||||
(match type
|
||||
('stream-info (read-metadata-block-stream-info))
|
||||
('vorbis-comment (read-metadata-block-vorbis-comment))
|
||||
(_ #f))
|
||||
(begin
|
||||
(flac-read-bytes (metadata-block-header-length header))
|
||||
(metadata-loop (read-metadata-block-header))))))
|
||||
(flac-read-bytes block-length)
|
||||
(metadata-loop))))))
|
||||
|
||||
(define* (flac-metadata port #:optional (type #f))
|
||||
(with-flac-input-port port
|
||||
|
|
@ -113,4 +112,5 @@
|
|||
(define* (flac-file-metadata filename #:optional (type #f))
|
||||
(with-flac-input-port (open-input-file filename #:binary #t)
|
||||
(λ ()
|
||||
(flac-read/assert-magic)
|
||||
(flac-metadata (current-input-port) type))))
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@
|
|||
current-flac-reader))
|
||||
|
||||
(define current-flac-reader (make-parameter #f))
|
||||
(define default-bit-reader-capacity 65536)
|
||||
|
||||
;;; TODO: redo api? callback based?
|
||||
|
||||
|
|
|
|||
|
|
@ -3,20 +3,21 @@
|
|||
#:use-module (flac reader)
|
||||
#:use-module (flac format)
|
||||
#:use-module (flac metadata)
|
||||
#:use-module (flac decoder)
|
||||
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (ice-9 binary-ports)
|
||||
|
||||
#:use-module (srfi srfi-64))
|
||||
|
||||
(define example-1
|
||||
(define-public 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-public example-2
|
||||
#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 #x13 #xd5 #xb0 #x56 #x49 #x75 #xe9 #x8b #x8d #x8b #x93
|
||||
|
|
@ -52,13 +53,63 @@
|
|||
(with-tests
|
||||
"RFC Examples"
|
||||
(test-group "Example 1"
|
||||
(with-flac-input-port (open-bytevector-input-port example-1)
|
||||
(with-flac-input-port
|
||||
(open-bytevector-input-port example-1)
|
||||
(λ ()
|
||||
(define expected-stream-info
|
||||
(make-metadata-stream-info 4096 4096 15 15 44100 2 16 1 #vu8(62 132 180 24 7 220 105 3 7 88 106 61 173 26 46 15)))
|
||||
(define expected-metadata
|
||||
(make-flac-metadata expected-stream-info #f #f #f #f #f '()))
|
||||
(let* ((expected-metadata (make-flac-metadata
|
||||
(make-metadata-stream-info
|
||||
4096 4096 15 15 44100 2 16 1
|
||||
#vu8(62 132 180 24 7 220 105 3 7 88 106 61 173 26 46 15))
|
||||
#f #f #f #f #f #f))
|
||||
(expected-frame (%make-frame
|
||||
(make-frame-header 'fixed 1 44100 'independent 16 0 191)
|
||||
43674
|
||||
'((25588) (10416))))
|
||||
|
||||
|
||||
(actual-metadata (read-flac-metadata))
|
||||
(actual-frame (read-flac-frame (flac-metadata-stream-info actual-metadata))))
|
||||
(test-group "Metadata"
|
||||
(let ((actual-metadata ((@@ (flac metadata) read-flac-metadata))))
|
||||
(test-equal "stream info" (flac-metadata-stream-info actual-metadata) expected-stream-info)
|
||||
(test-equal "metadata" actual-metadata expected-metadata)))))))
|
||||
(test-equal
|
||||
"stream info"
|
||||
(flac-metadata-stream-info actual-metadata)
|
||||
(flac-metadata-stream-info expected-metadata)))
|
||||
(test-group "Frame"
|
||||
(test-equal "first frame" expected-frame expected-frame))))))
|
||||
(test-group "Example 2"
|
||||
(with-flac-input-port
|
||||
(open-bytevector-input-port example-2)
|
||||
(λ ()
|
||||
(let* ((expected-stream-info (make-metadata-stream-info
|
||||
16 16 23 68 44100 2 16 19
|
||||
#vu8(213 176 86 73 117 233 139 141 139 147 4 34 117 123 129 3)))
|
||||
(expected-vorbis-comment (make-metadata-vorbis-comment
|
||||
"reference libFLAC 1.3.3 20190804"
|
||||
(list '("TITLE" "שלום"))))
|
||||
(expected-padding (make-metadata-padding 6))
|
||||
(expected-seek-table (make-metadata-seek-table
|
||||
(list (make-metadata-seek-point 0 0 16))))
|
||||
(expected-first-frame (%make-frame
|
||||
(make-frame-header 'fixed 16 44100 'right 16 0 153)
|
||||
47120
|
||||
'((4302 7496 6199 7427 6484 7436 6740 7508 6984 7583 7182 -5990 -6306 -6032 -6299 -6165)
|
||||
(6070 10545 8743 10449 9143 10463 9502 10569 9840 10680 10113 -8428 -8895 -8476 -8896 -8653))))
|
||||
(expected-second-frame (%make-frame
|
||||
(make-frame-header 'fixed 3 44100 'independent 16 1 164)
|
||||
4912
|
||||
'((-15486 -15349 -16054)
|
||||
(-9072 -8958 -9410))))
|
||||
|
||||
(actual-metadata (read-flac-metadata))
|
||||
(actual-stream-info (flac-metadata-stream-info actual-metadata))
|
||||
|
||||
(actual-first-frame (read-flac-frame actual-stream-info))
|
||||
(actual-second-frame (read-flac-frame actual-stream-info)))
|
||||
(test-group "Metadata"
|
||||
(test-equal "stream info" actual-stream-info expected-stream-info)
|
||||
(test-equal "vorbis comment" (flac-metadata-vorbis-comment actual-metadata) expected-vorbis-comment)
|
||||
(test-equal "padding" (flac-metadata-padding actual-metadata) expected-padding)
|
||||
(test-equal "seek table" (flac-metadata-seek-table actual-metadata) expected-seek-table))
|
||||
(test-group "Frames"
|
||||
(test-equal "frame 1" actual-first-frame expected-first-frame)
|
||||
(test-equal "frame 2" actual-second-frame expected-second-frame)))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue