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

some simple cleanup

main
Steve Ayerhart 2022-10-28 00:45:28 -04:00
parent e3c7e3e05a
commit 5340fc7bae
No known key found for this signature in database
GPG Key ID: 4CB33EB9BB156C97
4 changed files with 47 additions and 134 deletions

3
src/flac/decoder.scm
View File

@ -239,14 +239,13 @@
(residual (read-residual-partitioned-rice blocksize lpc-order))) (residual (read-residual-partitioned-rice blocksize lpc-order)))
(restore-linear-prediction warmup residual coefs lpc-order shift))) (restore-linear-prediction warmup residual coefs lpc-order shift)))
;; TODO: clean up the channel decorrelation this is kind of ugly ;; TODO: clean up the channel decorrelation this is kind of ugly
(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))
(channel-assignment (frame-header-channel-assignment frame-header))) (channel-assignment (frame-header-channel-assignment frame-header)))
(map! (λ (channel) (read-subframe frame-header channel)) (iota channels)))) (map! (λ (channel) (read-subframe frame-header channel)) (iota channels))))
e; TODO: actually verify the checksum ; TODO: actually verify the checksum
(define (read-frame-footer) (define (read-frame-footer)
(flac-read-uint 16)) (flac-read-uint 16))

126
src/flac/format.scm
View File

@ -13,7 +13,7 @@
flac-subframe-type flac-subframe-type
flac-entropy-coding-method-type flac-entropy-coding-method-type
make-frame-header %make-frame-header
frame-header-strategy frame-header-blocksize frame-header-sample-rate frame-header-strategy frame-header-blocksize frame-header-sample-rate
frame-header-channel-assignment frame-header-bits-per-sample frame-header-channel-assignment frame-header-bits-per-sample
frame-header-frame/sample-number frame-header-crc frame-header-frame/sample-number frame-header-crc
@ -31,48 +31,20 @@
%make-frame %make-frame
frame-header frame-subframes frame-footer frame-samples frame-header frame-subframes frame-footer frame-samples
%make-subframe-constant %make-metadata-padding metadata-padding?
subframe-constant-value padding-length
%make-subframe-verbatim %make-metadata-stream-info metadata-stream-info?
subframe-verbatim-value
%make-subframe-lpc
%make-rice-partition
partitioned-rice-order partitioned-rice-contents
%make-entropy-coding-method
entropy-coding-method-type entropy-coding-method-data
%make-entropy-coding-method-partitioned-rice-contents
entropy-coding-method-partitioned-rice-contents-parameters
entropy-coding-method-partitioned-rice-contents-raw-bits
entropy-coding-method-partitioned-rice-contents?
%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
metadata-block-header-length
make-metadata-padding
make-metadata-stream-info metadata-stream-info?
stream-info-min-block-size stream-info-max-block-size stream-info-min-block-size stream-info-max-block-size
stream-info-min-frame-size stream-info-max-frame-size stream-info-min-frame-size stream-info-max-frame-size
stream-info-sample-rate stream-info-channels stream-info-sample-rate stream-info-channels
stream-info-bits-per-sample stream-info-samples stream-info-md5 stream-info-bits-per-sample stream-info-samples stream-info-md5
make-metadata-vorbis-comment %make-metadata-vorbis-comment
vorbis-comment-vendor vorbis-comment-vendor
vorbis-comment-comments vorbis-comment-comments
make-flac-metadata %make-flac-metadata
flac-metadata-stream-info set-flac-metadata-stream-info! flac-metadata-stream-info set-flac-metadata-stream-info!
flac-metadata-seek-table set-flac-metadata-seek-table! flac-metadata-seek-table set-flac-metadata-seek-table!
flac-metadata-vorbis-comment set-flac-metadata-vorbis-comment! flac-metadata-vorbis-comment set-flac-metadata-vorbis-comment!
@ -81,11 +53,11 @@
flac-metadata-application set-flac-metadata-application! flac-metadata-application set-flac-metadata-application!
flac-metadata-cuesheet set-flac-metadata-cuesheet! flac-metadata-cuesheet set-flac-metadata-cuesheet!
%make-metadata-picture
make-metadata-picture
flac-picture-type flac-picture-type
make-metadata-seek-point make-metadata-seek-table %make-metadata-seek-table
%make-metadata-seek-point
flac-metadata-type flac-metadata-type-index)) flac-metadata-type flac-metadata-type-index))
@ -122,56 +94,8 @@
(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>
(%make-subframe-verbatim value)
subframe-verbatim?
(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>
(%make-subframe-constant value)
subframe-constant?
(value subframe-constant-value))
(define-record-type <entropy-coding-method-partitioned-rice-contents>
(%make-entropy-coding-method-partitioned-rice-contents parameters raw-bits capacity-by-order)
entropy-coding-method-partitioned-rice-contents?
(parameters entropy-coding-method-partitioned-rice-contents-parameters)
(raw-bits entropy-coding-method-partitioned-rice-contents-raw-bits)
(capacity-by-order entropy-coding-method-partitioned-rice-contents-capacity-by-order))
(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 <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)
frame-header? frame-header?
(blocking-strategy frame-header-blocking-strategy) (blocking-strategy frame-header-blocking-strategy)
(blocksize frame-header-blocksize) (blocksize frame-header-blocksize)
@ -194,7 +118,6 @@
(samples frame-samples)) (samples frame-samples))
; metadata ; metadata
(define flac-metadata-type (define flac-metadata-type
(make-enumeration '(stream-info (make-enumeration '(stream-info
padding padding
@ -205,15 +128,8 @@
picture picture
invalid))) invalid)))
(define-record-type <metadata-block-header>
(make-metadata-block-header last? type length)
metadata-block-header?
(last? metadata-block-header-last?)
(type metadata-block-header-type)
(length metadata-block-header-length))
(define-record-type <stream-info> (define-record-type <stream-info>
(make-metadata-stream-info min-block-size max-block-size min-frame-size max-frame-size sample-rate channels bits-per-sample samples md5) (%make-metadata-stream-info min-block-size max-block-size min-frame-size max-frame-size sample-rate channels bits-per-sample samples md5)
metadata-stream-info? metadata-stream-info?
(min-block-size stream-info-min-block-size) (min-block-size stream-info-min-block-size)
(max-block-size stream-info-max-block-size) (max-block-size stream-info-max-block-size)
@ -231,19 +147,19 @@
; (format port "#<stream-info>"))) ; (format port "#<stream-info>")))
(define-record-type <seek-table> (define-record-type <seek-table>
(make-metadata-seek-table seek-points) (%make-metadata-seek-table seek-points)
metadata-seek-table? metadata-seek-table?
(seek-points seek-table-seek-points)) (seek-points seek-table-seek-points))
(define-record-type <seek-point> (define-record-type <seek-point>
(make-metadata-seek-point sample-number offset total-samples) (%make-metadata-seek-point sample-number offset total-samples)
metadata-seek-point? metadata-seek-point?
(sample-number seek-point-sample-number) (sample-number seek-point-sample-number)
(offset seek-point-offset) (offset seek-point-offset)
(total-samples seek-point-total-samples)) (total-samples seek-point-total-samples))
(define-record-type <vorbis-comment> (define-record-type <vorbis-comment>
(make-metadata-vorbis-comment vendor comments) (%make-metadata-vorbis-comment vendor comments)
metadata-vorbis-comment? metadata-vorbis-comment?
(vendor vorbis-comment-vendor) (vendor vorbis-comment-vendor)
(comments vorbis-comment-comments)) (comments vorbis-comment-comments))
@ -254,12 +170,12 @@
(format port "#<<vorbis-comment> vendor: ~a comments: ~a>" (vorbis-comment-vendor record) (length (vorbis-comment-comments record))))) (format port "#<<vorbis-comment> vendor: ~a comments: ~a>" (vorbis-comment-vendor record) (length (vorbis-comment-comments record)))))
(define-record-type <padding> (define-record-type <padding>
(make-metadata-padding length) (%make-metadata-padding length)
metadata-padding? metadata-padding?
(length padding-length)) (length padding-length))
(define-record-type <application> (define-record-type <application>
(make-metadata-application id data) (%make-metadata-application id data)
metadata-application? metadata-application?
(id application-id) (id application-id)
(data application-data)) (data application-data))
@ -267,7 +183,7 @@
(define flac-cuesheet-track-type (make-enumeration '(audio non-audio))) (define flac-cuesheet-track-type (make-enumeration '(audio non-audio)))
(define-record-type <cuesheet-track> (define-record-type <cuesheet-track>
(make-metadata-cuesheet-track offset number isrc type pre-emphasis indices) (%make-metadata-cuesheet-track offset number isrc type pre-emphasis indices)
metadata-cuesheet-track? metadata-cuesheet-track?
(offset cuesheet-track-offset) (offset cuesheet-track-offset)
(number cuesheet-track-number) (number cuesheet-track-number)
@ -277,13 +193,13 @@
(indices cuesheet-track-indices)) (indices cuesheet-track-indices))
(define-record-type <cuesheet-index> (define-record-type <cuesheet-index>
(make-metadata-cuesheet-index offset number) (%make-metadata-cuesheet-index offset number)
metadata-cuesheet-index? metadata-cuesheet-index?
(offset cuesheet-index-offset) (offset cuesheet-index-offset)
(number cuesheet-index-number)) (number cuesheet-index-number))
(define-record-type <cuesheet> (define-record-type <cuesheet>
(make-metadata-cuesheet catalog-number lead-in cd? tracks) (%make-metadata-cuesheet catalog-number lead-in cd? tracks)
metadata-cuesheet? metadata-cuesheet?
(catalog-number cuesheet-catalog-number) (catalog-number cuesheet-catalog-number)
(lead-in cuesheet-lead-in) (lead-in cuesheet-lead-in)
@ -315,7 +231,7 @@
publisher/studio-logotype))) publisher/studio-logotype)))
(define-record-type <picture> (define-record-type <picture>
(make-metadata-picture type mime-type description width height depth colors data) (%make-metadata-picture type mime-type description width height depth colors data)
metadata-picture? metadata-picture?
(type picture-type) (type picture-type)
(mime-type picture-mime-type) (mime-type picture-mime-type)
@ -337,7 +253,7 @@
; (format port "#<<frame> header: ~a>" (frame-header record)))) ; (format port "#<<frame> header: ~a>" (frame-header record))))
(define-record-type <flac-metadata> (define-record-type <flac-metadata>
(make-flac-metadata stream-info padding application seek-table vorbis-comment cuesheet pictures) (%make-flac-metadata stream-info padding application seek-table vorbis-comment cuesheet pictures)
flac-metadata? flac-metadata?
(stream-info flac-metadata-stream-info set-flac-metadata-stream-info!) (stream-info flac-metadata-stream-info set-flac-metadata-stream-info!)
(padding flac-metadata-padding set-flac-metadata-padding!) (padding flac-metadata-padding set-flac-metadata-padding!)

28
src/flac/metadata.scm
View File

@ -19,7 +19,7 @@
(flac-read-uint 24))) (flac-read-uint 24)))
(define (read-metadata-block-stream-info) (define (read-metadata-block-stream-info)
(make-metadata-stream-info (%make-metadata-stream-info
(flac-read-uint 16) (flac-read-uint 16)
(flac-read-uint 16) (flac-read-uint 16)
(flac-read-uint 24) (flac-read-uint 24)
@ -31,9 +31,9 @@
(flac-read-bytes 16))) (flac-read-bytes 16)))
(define (read-metadata-block-seek-table length) (define (read-metadata-block-seek-table length)
(make-metadata-seek-table (%make-metadata-seek-table
(map (λ (_) (map (λ (_)
(make-metadata-seek-point (%make-metadata-seek-point
(flac-read-uint 64) (flac-read-uint 64)
(flac-read-uint 64) (flac-read-uint 64)
(flac-read-uint 16))) (flac-read-uint 16)))
@ -41,16 +41,16 @@
(define (read-metadata-block-vorbis-comment) (define (read-metadata-block-vorbis-comment)
(define (read-native-u32) (bytevector-u32-native-ref (flac-read-bytes 4) 0)) (define (read-native-u32) (bytevector-u32-native-ref (flac-read-bytes 4) 0))
(make-metadata-vorbis-comment (%make-metadata-vorbis-comment
(utf8->string (flac-read-bytes (read-native-u32))) (utf8->string (flac-read-bytes (read-native-u32)))
(map (λ (_) (string-split (utf8->string (flac-read-bytes (read-native-u32))) #\=)) (iota (read-native-u32))))) (map (λ (_) (string-split (utf8->string (flac-read-bytes (read-native-u32))) #\=)) (iota (read-native-u32)))))
(define (read-metadata-block-padding length) (define (read-metadata-block-padding length)
(flac-read-bytes length) (flac-read-bytes length)
(make-metadata-padding length)) (%make-metadata-padding length))
(define (read-metadata-block-picture) (define (read-metadata-block-picture)
(make-metadata-picture (%make-metadata-picture
(list-ref (enum-set->list flac-picture-type) (flac-read-uint 32)) (list-ref (enum-set->list flac-picture-type) (flac-read-uint 32))
(utf8->string (flac-read-bytes (flac-read-uint 32))) (utf8->string (flac-read-bytes (flac-read-uint 32)))
(utf8->string (flac-read-bytes (flac-read-uint 32))) (utf8->string (flac-read-bytes (flac-read-uint 32)))
@ -81,7 +81,7 @@
(define (read-flac-metadata) (define (read-flac-metadata)
(flac-read/assert-magic) (flac-read/assert-magic)
(let metadata-loop ((metadata (make-flac-metadata #f #f #f #f #f #f #f))) (let metadata-loop ((metadata (%make-flac-metadata #f #f #f #f #f #f #f)))
(receive (last-block? block-type block-length) (receive (last-block? block-type block-length)
(read-metadata-block-header) (read-metadata-block-header)
(if last-block? (if last-block?
@ -104,13 +104,13 @@
(define* (flac-metadata port #:optional (type #f)) (define* (flac-metadata port #:optional (type #f))
(with-flac-input-port port (with-flac-input-port port
(λ () (λ ()
(if (symbol? type) (if (symbol? type)
(read-flac-metadata-type type) (read-flac-metadata-type type)
(read-flac-metadata))))) (read-flac-metadata)))))
(define* (flac-file-metadata filename #:optional (type #f)) (define* (flac-file-metadata filename #:optional (type #f))
(with-flac-input-port (open-input-file filename #:binary #t) (with-flac-input-port (open-input-file filename #:binary #t)
(λ () (λ ()
(flac-read/assert-magic) (flac-read/assert-magic)
(flac-metadata (current-input-port) type)))) (flac-metadata (current-input-port) type))))

24
src/flac/tests.scm
View File

@ -56,13 +56,11 @@
(with-flac-input-port (with-flac-input-port
(open-bytevector-input-port example-1) (open-bytevector-input-port example-1)
(λ () (λ ()
(let* ((expected-metadata (make-flac-metadata (let* ((expected-streaminfo (%make-metadata-stream-info
(make-metadata-stream-info
4096 4096 15 15 44100 2 16 1 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)) #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 (expected-frame (%make-frame
(make-frame-header 'fixed 1 44100 'independent 16 0 191) (%make-frame-header 'fixed 1 44100 'independent 16 0 191)
43674 43674
'((25588) (10416)))) '((25588) (10416))))
@ -73,29 +71,29 @@
(test-equal (test-equal
"stream info" "stream info"
(flac-metadata-stream-info actual-metadata) (flac-metadata-stream-info actual-metadata)
(flac-metadata-stream-info expected-metadata))) expected-streaminfo))
(test-group "Frame" (test-group "Frame"
(test-equal "first frame" expected-frame expected-frame)))))) (test-equal "first frame" expected-frame expected-frame))))))
(test-group "Example 2" (test-group "Example 2"
(with-flac-input-port (with-flac-input-port
(open-bytevector-input-port example-2) (open-bytevector-input-port example-2)
(λ () (λ ()
(let* ((expected-stream-info (make-metadata-stream-info (let* ((expected-stream-info (%make-metadata-stream-info
16 16 23 68 44100 2 16 19 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))) #vu8(213 176 86 73 117 233 139 141 139 147 4 34 117 123 129 3)))
(expected-vorbis-comment (make-metadata-vorbis-comment (expected-vorbis-comment (%make-metadata-vorbis-comment
"reference libFLAC 1.3.3 20190804" "reference libFLAC 1.3.3 20190804"
(list '("TITLE" "שלום")))) (list '("TITLE" "שלום"))))
(expected-padding (make-metadata-padding 6)) (expected-padding (%make-metadata-padding 6))
(expected-seek-table (make-metadata-seek-table (expected-seek-table (%make-metadata-seek-table
(list (make-metadata-seek-point 0 0 16)))) (list (%make-metadata-seek-point 0 0 16))))
(expected-first-frame (%make-frame (expected-first-frame (%make-frame
(make-frame-header 'fixed 16 44100 'right 16 0 153) (%make-frame-header 'fixed 16 44100 'right 16 0 153)
47120 47120
'((4302 7496 6199 7427 6484 7436 6740 7508 6984 7583 7182 -5990 -6306 -6032 -6299 -6165) '((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)))) (6070 10545 8743 10449 9143 10463 9502 10569 9840 10680 10113 -8428 -8895 -8476 -8896 -8653))))
(expected-second-frame (%make-frame (expected-second-frame (%make-frame
(make-frame-header 'fixed 3 44100 'independent 16 1 164) (%make-frame-header 'fixed 3 44100 'independent 16 1 164)
4912 4912
'((-15486 -15349 -16054) '((-15486 -15349 -16054)
(-9072 -8958 -9410)))) (-9072 -8958 -9410))))