steve
/
factor-work
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cleanup

master
Steve Ayerhart 2022-07-06 18:13:20 -04:00
parent 0992da86d0
commit 84b402b246
No known key found for this signature in database
GPG Key ID: 5C815FDF3A00B8BA
4 changed files with 191 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
flac/bitstream/bitstream.factor
View File

@ -1,59 +0,0 @@
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: kernel system destructors accessors byte-arrays math math.functions locals io.files io.encodings.binary combinators sequences namespaces ;
QUALIFIED: bitstreams
QUALIFIED: io
USING: prettyprint ;
IN: flac.bitstream
CONSTANT: default-bitreader-capacity 65536
SYMBOL: flac-input-stream
TUPLE: flac-stream-reader stream bitstream ;
GENERIC: read-uint ( n flac-stream-reader -- n )
GENERIC: align-to-byte ( flac-stream-reader -- )
: <flac-stream-reader> ( path -- flac-stream-reader )
binary <file-reader> B{ } bitstreams:<msb0-bit-reader> flac-stream-reader boa ;
M: flac-stream-reader dispose stream>> dispose ;
: flac-align-to-byte ( -- )
8 flac-input-stream get bitstream>> bitstreams:align ;
: flac-read-uint ( n -- n )
[ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ]
[
flac-input-stream get
[ stream>> default-bitreader-capacity swap io:stream-read ] [ bitstream>> ] bi
dup bytes>> swap [ prepend ] dip swap >>bytes drop
] while flac-input-stream get bitstream>> bitstreams:read ;
: flac-seek ( n -- )
[ 8 * flac-input-stream get bitstream>> bitstreams:seek ]
[ io:seek-relative flac-input-stream get stream>> io:stream-seek ] bi ;
:: flac-read-sint ( n -- n )
n flac-read-uint :> val
val val n 1 - neg shift n shift - ;
: flac-read-utf8-uint ( -- n )
8 flac-read-uint
[ dup 0b11000000 >= ] [ 8 flac-read-uint drop 2^ 0xff bitand ] while ;
: flac-read-rice-sint ( param -- n )
0 [ 1 flac-read-uint 0 = ] [ 1 + ] while
[ swap shift ] [ flac-read-uint ] bi bitor
[ -1 shift ] [ 1 bitand neg ] bi ^ ;
: with-flac-stream-reader* ( flac-bitstream quot -- )
flac-input-stream swap with-variable ; inline
: with-flac-stream-reader ( flac-bitstream quot -- )
[ with-flac-stream-reader* ] curry with-disposal ; inline
: with-flac-file-reader ( filename quot -- )
[ <flac-stream-reader> ] dip with-flac-stream-reader ; inline

272
flac/decoder/decoder.factor
View File

@ -1,37 +1,25 @@
! Copyright (C) 2020 . USING: kernel math math.order combinators combinators.extras generalizations math.bitwise accessors sequences ;
! See http://factorcode.org/license.txt for BSD license. USING: flac.format flac.stream ;
USING: math io.encodings.binary kernel io io.files locals endian bit-arrays math.intervals combinators combinators.extras math.order math.bits sequences namespaces accessors byte-arrays math.bitwise arrays generalizations ;
USING: prettyprint ; USING: prettyprint ;
USING: flac.bitstream flac.metadata flac.format ;
IN: flac.decoder IN: flac.decoder
SYMBOL: current-flac-output
: decode-block-size ( n -- n ) : decode-block-size ( n -- n )
dup dup
{ {
{ [ 0b0000 = ] [ drop reserved-block-size ] } { [ 0b0000 = ] [ drop reserved-block-size ] }
{ [ 0b0001 = ] [ drop 192 ] } { [ 0b0001 = ] [ drop 192 ] }
{ [ 0b0010 0b0101 between? ] [ 2 - 2^ 567 * ] } { [ 0b0010 0b0101 between? ] [ 2 - 2^ 567 * ] }
{ [ 0b0110 = ] [ drop 8 flac-read-uint 1 + ] } { [ 0b0110 = ] [ drop 8 flac-read 1 + ] }
{ [ 0b0111 = ] [ drop 16 flac-read-uint 1 + ] } { [ 0b0111 = ] [ drop 16 flac-read 1 + ] }
{ [ 0b1000 0b1111 between? ] [ 8 - 2^ 256 * ] } { [ 0b1000 0b1111 between? ] [ 8 - 2^ 256 * ] }
} cond-case ; } cond-case ;
: decode-bits-per-sample ( n -- n )
{
{ 0b000 [ "TODO" ] }
{ 0b001 [ 8 ] }
{ 0b010 [ 12 ] }
{ 0b011 [ reserved-sample-size ] }
{ 0b100 [ 16 ] }
{ 0b101 [ 20 ] }
{ 0b110 [ 24 ] }
{ 0b111 [ reserved-sample-size ] }
} case ;
: decode-sample-rate ( n -- n ) : decode-sample-rate ( n -- n )
{ {
{ 0b0000 [ "TODO" ] } { 0b0000 [ "TODO: GET FROM STREAMINFO" ] }
{ 0b0001 [ 88200 ] } { 0b0001 [ 88200 ] }
{ 0b0010 [ 17640 ] } { 0b0010 [ 17640 ] }
{ 0b0011 [ 19200 ] } { 0b0011 [ 19200 ] }
@ -43,108 +31,95 @@ IN: flac.decoder
{ 0b1001 [ 44100 ] } { 0b1001 [ 44100 ] }
{ 0b1010 [ 48000 ] } { 0b1010 [ 48000 ] }
{ 0b1011 [ 96000 ] } { 0b1011 [ 96000 ] }
{ 0b1100 [ 8 flac-read-uint 1000 * ] } ! sample rate in kHz { 0b1100 [ 8 flac-read 1000 * ] } ! sample rate in kHz
{ 0b1101 [ 16 flac-read-uint ] } ! sample rate in Hz { 0b1101 [ 16 flac-read ] } ! sample rate in Hz
{ 0b1110 [ 16 flac-read-uint 10 * ] } ! sample rate in tens of Hz { 0b1110 [ 16 flac-read 10 * ] } ! sample rate in tens of Hz
{ 0b1111 [ invalid-sample-rate ] } { 0b1111 [ invalid-sample-rate ] }
} case ; } case ;
: decode-channels ( n -- channels channel-assignment ) : decode-channel-assignment ( n -- channel-assignment )
dup
{ {
{ [ dup 0b0000 0b0111 between? ] [ 1 + ] } { [ 0b0000 0b0111 between? ] [ 0 ] }
{ [ 0b1000 0b1010 between? ] [ 2 ] } { [ 0b1000 = ] [ 1 ] }
[ invalid-channel-assignment ] { [ 0b1001 = ] [ 2 ] }
} cond swap { [ 0b1010 = ] [ 3 ] }
<flac-channel-assignment> ; [ reserved-channel-assignment ]
} cond-case <flac-channel-assignment> ;
: read-flac-subframe-verbatim ( frame-header subframe-header -- verbatim-subframe ) : decode-bits-per-sample ( stream-info n -- n )
[ [ blocksize>> ] [ bits-per-sample>> ] bi ] dip wasted-bits>> - <repetition> {
[ flac-read-uint ] map { 0b000 [ 0 ] }
flac-subframe-constant boa ; { 0b001 [ 8 ] }
{ 0b010 [ 12 ] }
: read-flac-subframe-constant ( frame-header subframe-header -- constant-subframe ) { 0b011 [ reserved-sample-size ] }
[ [ blocksize>> ] [ bits-per-sample>> ] bi ] dip wasted-bits>> - flac-read-uint <repetition> [ ] map ; { 0b100 [ 16 ] }
{ 0b101 [ 20 ] }
! :: read-residual-partitioned-rice ( frame-header subframe-header -- rice residual ) { 0b110 [ 24 ] }
! 4 flac-read-uint :> partition-order { 0b111 [ reserved-sample-size ] }
! partition-order .
! frame-header blocksize>> -1 partition-order * shift :> samples
! samples .
! 1 partition-order shift 4 <array> [
! dup .
! flac-read-uint :> param
! param 0b1111 =
! [ 5 flac-read-uint :> numbits samples numbits <array> [ flac-read-uint ] map drop "dicks" . param ]
! [ samples param <array> [ flac-read-uint ] map first . "balls" . param dup . ] if
! ] map :> parameters
! parameters .
! partition-order
! flac-entropy-coding-method-partitioned-rice-contents new
! flac-entropy-coding-method-partitioned-rice boa parameters ;
:: read-residual-partitioned-rice ( frame-header subframe-header -- rice residual )
frame-header blocksize>> :> blocksize
4 flac-read-uint :> partition-order
partition-order 2^ :> partitions
blocksize mod partitions 0 = [ invalid-blocksize/rice-partitions ] unless
partitions <iota>
[
]
2drop flac-entropy-coding-method-partitioned-rice-contents new f ;
: read-residual-partitioned-rice2 ( frame-header subframe-header -- rice residual )
2drop flac-entropy-coding-method-partitioned-rice-contents new f ;
: read-residual-coding-method-type ( -- coding-method )
2 flac-read-uint dup
2 > [ reserved-residual-coding-type ] when
<flac-entropy-coding-method-type> ;
: flac-read-residuals ( frame-header subframe-header -- entropy-coding-method residual )
read-residual-coding-method-type
dup {
{ entropy-coding-partitioned-rice [ read-residual-partitioned-rice ] }
{ entropy-coding-partitioned-rice2 [ read-residual-partitioned-rice2 ] }
[ reserved-residual-coding-type ]
} case } case
flac-entropy-coding-method boa ; dup 0 = [ drop bits-per-sample>> ] [ nip ] if ;
: read-flac-subframe-warmup-samples ( frame-header subframe-header -- seq ) : read/assert-frame-sync-code ( -- )
! TODO: handle wasted bits... 15 flac-read 0b111111111111100 = [ sync-code-error ] unless ;
[ bits-per-sample>> ] [ predictor-order>> ] bi* swap <repetition> [ flac-read-uint ] map ;
: read-flac-subframe-fixed ( frame-header subframe-header -- fixed-subframe ) : read-flac-frame-header ( stream-info -- frame-header )
2dup [ read-flac-subframe-warmup-samples ] [ flac-read-residuals ] 2bi* [
flac-subframe-fixed boa ; read/assert-frame-sync-code
1 flac-read <flac-frame-blocking-strategy>
4 flac-read ! blocksize code
4 flac-read ! sample rate code
4 flac-read decode-channel-assignment
] dip
3 flac-read decode-bits-per-sample
1 flac-read drop ! ignore magic sync for now
flac-read-coded-number
! decoding blocksize/samplerate potentially reads from end of header
[ decode-block-size ] 4dip
[ decode-sample-rate ] 3dip
8 flac-read
flac-frame-header boa ;
: read-flac-subframe-qlp-coeff-precision ( -- precision ) : read-flac-subframe-wasted-bits ( -- k )
4 flac-read-uint 1 + ; 1 flac-read 1 = [ 0 [ 1 + 1 flac-read 0 = ] loop ] [ 0 ] if ;
: read-flac-qlp-shift ( -- quantization-level ) : read-flac-subframe-constant ( blocksize bps wasted-bits -- constant-subframe )
5 flac-read-uint ; [ flac-read-int32 ] dip shift <repetition> [ ] map flac-subframe-constant boa ;
: read-flac-qlp-coeff ( subframe-header coeff-precision -- seq ) : read-flac-subframe-verbatim ( blocksize bps wasted-bits -- verbatim-subframe )
[ predictor-order>> ] dip <repetition> [ flac-read-uint ] map ; [ <repetition> ] dip swap [ flac-read-int32 swap shift ] with map flac-subframe-verbatim boa ;
: read-residual-coding-method-type ( -- coding-method param-bits param-escape )
2 flac-read dup
2 > [ reserved-residual-coding-type ] when
<flac-entropy-coding-method-type>
dup entropy-coding-partitioned-rice = [ 4 0xf ] [ 5 0x1f ] if ;
: read-flac-subframe-lpc ( frame-header subframe-header -- lpc-subframe ) : read-flac-subframe-lpc ( frame-header subframe-header -- lpc-subframe )
2drop 1 ; 2drop 1 ;
! : read-flac-subframe-lpc ( frame-header subframe-header -- lpc-subframe )
! [ read-flac-subframe-warmup-samples ] 2keep
! [
! nip
! read-flac-subframe-qlp-coeff-precision dup
! read-flac-qlp-shift
! [ swap read-flac-qlp-coeff ] dip
! ]
! [ flac-read-residuals ] 2tri
! flac-subframe boa ;
:: flac-read-residuals ( blocksize -- sequence )
read-residual-coding-method-type :> ( coding-type param-bits param-escape )
1 ;
: read-flac-subframe-sync ( -- ) : read-flac-subframe-warmup-samples ( bps order -- seq )
1 flac-read-uint 1 = [ invalid-subframe-sync ] when ; <repetition> [ flac-read-int32 ] map ;
:: read-flac-subframe-fixed ( blocksize bps order -- fixed-subframe )
bps order read-flac-subframe-warmup-samples :> warmup
4 flac-read :> partition-order
partition-order 2^ :> partitions
! 2dup [ read-flac-subframe-warmup-samples ] [ flac-read-residuals ] 2bi*
! flac-subframe-fixed boa ;
: read-flac-subframe-qlp-coeff-precision ( -- precision )
4 flac-read 1 + ;
: read-flac-qlp-shift ( -- quantization-level )
5 flac-read ;
: read-flac-qlp-coeff ( subframe-header coeff-precision -- seq )
[ predictor-order>> ] dip <repetition> [ flac-read ] map ;
! 000000 constant ! 000000 constant
! 000001 verbatim ! 000001 verbatim
@ -154,75 +129,58 @@ IN: flac.decoder
! 01xxxx reserved ! 01xxxx reserved
! 1xxxxx lpc ! 1xxxxx lpc
: read-flac-subframe-type ( -- subframe-type order ) : read-flac-subframe-type ( -- subframe-type order )
6 flac-read-uint dup 6 flac-read dup
{ {
{ [ 0b0 = ] [ drop f subframe-type-constant ] } { [ 0b0000 = ] [ drop f subframe-type-constant ] }
{ [ 0b1 = ] [ drop f subframe-type-verbatim ] } { [ 0b0001 = ] [ drop f subframe-type-verbatim ] }
{ [ 0b1000 0b1100 between? ] [ 3 clear-bit subframe-type-fixed ] } { [ 0b1000 0b1100 between? ] [ 3 clear-bit subframe-type-fixed ] }
{ [ 0b100000 0b111111 between? ] [ 5 clear-bit 1 + subframe-type-lpc ] } { [ 0b100000 0b111111 between? ] [ 5 clear-bit 1 + subframe-type-lpc ] }
[ drop reserved-subframe-type ] [ drop reserved-subframe-type ]
} cond-case swap ; } cond-case swap ;
: read-flac-subframe-wasted-bits ( -- k ) : read/assert-flac-subframe-sync ( -- )
1 flac-read-uint 1 flac-read 1 = [ invalid-subframe-sync ] when ;
1 = [ [ flac-read-uint dup 0 = ] [ 1 + ] while ] [ 0 ] if* ;
: read-flac-subframe-header ( -- subframe-header ) : read-flac-subframe-header ( -- subframe-header )
read-flac-subframe-sync read/assert-flac-subframe-sync
read-flac-subframe-type read-flac-subframe-type
read-flac-subframe-wasted-bits read-flac-subframe-wasted-bits
flac-subframe-header boa ; flac-subframe-header boa ;
: read-flac-subframe ( frame-header -- subframe ) : calculate-bits-per-sample ( bps wasted-bits subframe-type channel -- bps' )
read-flac-subframe-header dup dup [ - ] 2dip swap
[
subframe-type>>
{ {
{ subframe-type-constant [ read-flac-subframe-constant ] } { channel-assignment-left [ 1 = [ 1 ] [ 0 ] if ] }
{ subframe-type-verbatim [ read-flac-subframe-verbatim ] } { channel-assignment-right [ 0 = [ 1 ] [ 0 ] if ] }
{ subframe-type-fixed [ read-flac-subframe-fixed ] } { channel-assignment-mid [ 1 = [ 1 ] [ 0 ] if ] }
{ subframe-type-lpc [ read-flac-subframe-lpc ] } [ 2drop 0 ]
} case + ;
:: read-flac-subframe ( frame-header channel -- subframe )
read-flac-subframe-header :> subframe-header
subframe-header wasted-bits>> :> wasted-bits
subframe-header subframe-type>> :> subframe-type
subframe-header predictor-order>> :> order
frame-header bits-per-sample>> wasted-bits subframe-type channel calculate-bits-per-sample :> bps
frame-header blocksize>> :> blocksize
subframe-type
{
{ subframe-type-constant [ blocksize bps wasted-bits read-flac-subframe-constant ] }
{ subframe-type-verbatim [ blocksize bps wasted-bits read-flac-subframe-verbatim ] }
! { subframe-type-fixed [ blocksize bps wasted-bits read-flac-subframe-fixed ] }
! { subframe-type-lpc [ blocksize bps wasted-bits read-flac-subframe-lpc ] }
} case } case
] dip swap subframe-header swap flac-subframe boa ;
flac-subframe boa ;
: read-flac-subframes ( frame-header -- seq ) : read-flac-subframes ( stream-info frame-header -- seq )
dup channels>> swap <repetition> [ read-flac-subframe ] map ; [ channels>> ] dip swap <iota> [ read-flac-subframe ] with map ;
: read-flac-sync-frame ( -- )
14 flac-read-uint drop ! sync
1 flac-read-uint drop ; ! TODO: handle unparsable frame
: read-flac-frame-header ( -- frame-header )
read-flac-sync-frame
1 flac-read-uint <flac-frame-blocking-strategy>
4 flac-read-uint ! blocksize code
4 flac-read-uint ! sample rate code
4 flac-read-uint decode-channels
3 flac-read-uint decode-bits-per-sample
1 flac-read-uint drop ! ignore magic sync for now
flac-read-utf8-uint
! decoding blocksize/samplerate potentially reads from end of header
[ decode-block-size ] 5 ndip
[ decode-sample-rate ] 4dip
8 flac-read-uint
flac-frame-header boa ;
: read-flac-frame-footer ( -- frame-footer ) : read-flac-frame-footer ( -- frame-footer )
16 flac-read-uint flac-frame-footer boa ; 16 flac-read flac-frame-footer boa ;
: read-flac-frame ( -- frame ) : read-flac-frame ( stream-info -- frame )
read-flac-frame-header dup [ read-flac-frame-header ] keep swap
read-flac-subframes [ read-flac-subframes ] keep swap
read-flac-frame-footer read-flac-frame-footer
flac-frame boa ; flac-frame boa ;
: read-flac-file ( filename -- flac-stream )
[
read-flac-metadata drop
read-flac-frame drop
read-flac-frame drop
read-flac-frame drop
read-flac-frame
] with-flac-file-reader ;

55
flac/format/format.factor
View File

@ -1,5 +1,3 @@
! Copyright (C) 2020 .
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax math byte-arrays sequences kernel strings arrays assocs ; USING: alien.syntax math byte-arrays sequences kernel strings arrays assocs ;
IN: flac.format IN: flac.format
@ -20,16 +18,17 @@ CONSTANT: MAX-QLP-COEEF-PRECISION 15
CONSTANT: MAX-FIXED-ORDER 4 CONSTANT: MAX-FIXED-ORDER 4
CONSTANT: MAX-RICE-PARTITION-ORDER 15 CONSTANT: MAX-RICE-PARTITION-ORDER 15
ERROR: not-a-flac-file ; ERROR: not-a-flac-stream ;
ERROR: sync-code-error ; ERROR: sync-code-error ;
ERROR: invalid-channel-assignment ; ERROR: invalid-channel-assignment ;
ERROR: reserved-block-size ; ERROR: reserved-block-size ;
ERROR: reserved-sample-size ; ERROR: reserved-sample-size ;
ERROR: invalid-sample-rate ; ERROR: invalid-sample-rate ;
ERROR: reserved-subframe-type ; ERROR: reserved-subframe-type ;
ERROR: reserved-channel-assignment ;
ERROR: invalid-subframe-sync ; ERROR: invalid-subframe-sync ;
ERROR: reserved-residual-coding-type ; ERROR: reserved-residual-coding-type ;
ERROR: invalid-blocksize/rice-partitions ERROR: invalid-blocksize/rice-partitions ;
ENUM: flac-frame-blocking-strategy ENUM: flac-frame-blocking-strategy
fixed-blocksize variable-blocksize ; fixed-blocksize variable-blocksize ;
@ -39,35 +38,20 @@ ENUM: flac-frame-number-type
frame-number-type-sample ; frame-number-type-sample ;
ENUM: flac-channel-assignment ENUM: flac-channel-assignment
channels-mono channel-assignment-independent
channels-left/right channel-assignment-left
channels-left/right/center channel-assignment-right
channels-left/right/left-surround/right-surround channel-assignment-mid ;
channels-left/right/center/left-surround/right-surround
channels-left/right/center/lfe/left-surround/right-surround
channels-left/right/center/lfe/center-surround/side-left/side-right
channels-left/right/center/lfe/left-surround/right-surround/side-left/side-right
channels-left
channels-right
channels-mid ;
TUPLE: flac-frame-header TUPLE: flac-frame-header
{ blocking-strategy maybe{ fixed-blocksize variable-blocksize } } { blocking-strategy maybe{ fixed-blocksize variable-blocksize } }
{ blocksize integer } { blocksize integer }
{ sample-rate integer } { sample-rate integer }
{ channels integer }
{ channel-assignment { channel-assignment
maybe{ channels-mono maybe{ channel-assignment-independent
channels-left/right channel-assignment-left
channels-left/right/center channel-assignment-right
channels-left/right/left-surround/right-surround channel-assignment-mid } }
channels-left/right/center/left-surround/right-surround
channels-left/right/center/lfe/left-surround/right-surround
channels-left/right/center/lfe/center-surround/side-left/side-right
channels-left/right/center/lfe/left-surround/right-surround/side-left/side-right
channels-left
channels-right
channels-mid } }
{ bits-per-sample integer } { bits-per-sample integer }
{ frame|sample-number integer } { frame|sample-number integer }
{ crc integer } ; { crc integer } ;
@ -84,11 +68,12 @@ ENUM: flac-entropy-coding-method-type
TUPLE: flac-entropy-coding-method-partitioned-rice-contents TUPLE: flac-entropy-coding-method-partitioned-rice-contents
{ parameters sequence } { parameters sequence }
{ raw-bits sequence } ; { raw-bits sequence }
{ capacity-by-order integer } ;
TUPLE: flac-entropy-coding-method-partitioned-rice TUPLE: flac-entropy-coding-method-partitioned-rice
{ order integer } { order integer }
{ contents flac-entropy-coding-method-partitioned-rice-contents } ; { contents sequence } ;
TUPLE: flac-entropy-coding-method TUPLE: flac-entropy-coding-method
{ type maybe{ entropy-coding-partitioned-rice { type maybe{ entropy-coding-partitioned-rice
@ -96,15 +81,16 @@ TUPLE: flac-entropy-coding-method
{ data flac-entropy-coding-method-partitioned-rice } ; { data flac-entropy-coding-method-partitioned-rice } ;
TUPLE: flac-subframe-constant TUPLE: flac-subframe-constant
{ data sequence } ; { value sequence } ;
TUPLE: flac-subframe-verbatim TUPLE: flac-subframe-verbatim
{ data sequence } ; { value sequence } ;
TUPLE: flac-subframe-fixed TUPLE: flac-subframe-fixed
{ warmup sequence }
{ entropy-coding-method flac-entropy-coding-method } { entropy-coding-method flac-entropy-coding-method }
residual ; { order integer }
{ warmup sequence }
{ residual sequence } ;
TUPLE: flac-subframe-lpc TUPLE: flac-subframe-lpc
{ entropy-coding-method maybe{ entropy-coding-partitioned-rice { entropy-coding-method maybe{ entropy-coding-partitioned-rice
@ -113,7 +99,8 @@ TUPLE: flac-subframe-lpc
{ quantization-level integer } { quantization-level integer }
{ qlp-coeff sequence } { qlp-coeff sequence }
{ warmup sequence } { warmup sequence }
residual ; { residual sequence }
{ value sequence } ;
TUPLE: flac-subframe-header TUPLE: flac-subframe-header
{ subframe-type maybe{ subframe-type-constant { subframe-type maybe{ subframe-type-constant

109
flac/metadata/metadata.factor
View File

@ -1,52 +1,50 @@
! Copyright (C) 2020 . USING: kernel math math.parser endian sequences pack io.streams.byte-array io.encodings.utf8 io.encodings.string io.encodings.binary io.encodings.ascii splitting assocs arrays byte-arrays accessors combinators ;
! See http://factorcode.org/license.txt for BSD license.
USING: endian sequences kernel classes.struct io.binary io.files io.encodings io.encodings.string io.encodings.utf8 io.encodings.binary alien.c-types alien.endian math locals accessors prettyprint combinators math.parser strings arrays io.streams.byte-array sequences.generalizations assocs splitting byte-arrays alien.syntax alien.enums io.encodings.ascii pack ;
USING: flac.bitstream flac.format ;
QUALIFIED: bitstreams
QUALIFIED: io QUALIFIED: io
USING: flac.stream flac.format ;
IN: flac.metadata IN: flac.metadata
<PRIVATE
ERROR: cuesheet-index-reserved-must-be-zero ; ERROR: cuesheet-index-reserved-must-be-zero ;
: read-metadata-block-header ( -- header ) : read-metadata-block-header ( -- header )
1 flac-read-uint 1 = 1 flac-read 1 =
7 flac-read-uint <metadata-type> 7 flac-read <metadata-type>
24 flac-read-uint 24 flac-read
metadata-block-header boa ; metadata-block-header boa ;
: read-metadata-block-stream-info ( -- stream-info ) : read-metadata-block-stream-info ( -- stream-info )
16 flac-read-uint 16 flac-read
16 flac-read-uint 16 flac-read
24 flac-read-uint 24 flac-read
24 flac-read-uint 24 flac-read
20 flac-read-uint 20 flac-read
3 flac-read-uint 1 + 3 flac-read 1 +
5 flac-read-uint 1 + 5 flac-read 1 +
36 flac-read-uint 36 flac-read
128 flac-read-uint 16 >be bytes>hex-string 128 flac-read 16 >be bytes>hex-string
stream-info boa ; stream-info boa ;
: read-metadata-block-seek-table ( length -- seek-table ) : read-metadata-block-seek-table ( length -- seek-table )
18 / <iota> [ 18 / <iota> [
drop drop
64 flac-read-uint 64 flac-read
64 flac-read-uint 64 flac-read
16 flac-read-uint 16 flac-read
seek-point boa seek-point boa
] map ] map
seek-table boa ; seek-table boa ;
: read-metadata-block-vorbis-comment ( length -- vorbis-comment ) : read-metadata-block-vorbis-comment ( length -- vorbis-comment )
! vorbis comments are in little endian... ! vorbis comments are in little endian...
drop drop
32 flac-read-uint 4 >le be> dup 8 * flac-read-uint swap >n-byte-array utf8 decode 32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array utf8 decode
32 flac-read-uint 4 >le be> <iota> 32 flac-read 4 >le be> <iota>
[ [
drop drop
32 flac-read-uint 4 >le be> dup 8 * flac-read-uint swap >n-byte-array utf8 decode 32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array utf8 decode
"=" split "=" split
] map ] map
>alist vorbis-comment boa ; >alist vorbis-comment boa ;
@ -70,13 +68,13 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
length>> <byte-array> ; length>> <byte-array> ;
: read-metadata-block-padding ( length -- padding ) : read-metadata-block-padding ( length -- padding )
dup 8 * flac-read-uint drop flac-padding boa ; dup 8 * flac-read drop flac-padding boa ;
: read-metadata-block-application ( length -- application ) : read-metadata-block-application ( length -- application )
8 * flac-read-uint drop application new ; 8 * flac-read drop application new ;
: read-metadata-block-cuesheet ( length -- cuesheet ) : read-metadata-block-cuesheet ( length -- cuesheet )
dup [ 8 * flac-read-uint ] dip >be dup [ 8 * flac-read ] dip >be
binary binary
[ [
128 io:read ascii decode 128 io:read ascii decode
@ -101,14 +99,14 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
: read-metadata-block-picture ( length -- picture ) : read-metadata-block-picture ( length -- picture )
drop drop
32 flac-read-uint <picture-type> 32 flac-read <picture-type>
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array utf8 decode 32 flac-read dup 8 * flac-read swap >n-byte-array utf8 decode
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array utf8 decode 32 flac-read dup 8 * flac-read swap >n-byte-array utf8 decode
32 flac-read-uint 32 flac-read
32 flac-read-uint 32 flac-read
32 flac-read-uint 32 flac-read
32 flac-read-uint 32 flac-read
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array 32 flac-read dup 8 * flac-read swap >n-byte-array
picture boa ; picture boa ;
: append-picture ( metadata picture -- metadata ) : append-picture ( metadata picture -- metadata )
@ -127,8 +125,7 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
} case } case
] with-big-endian ; ] with-big-endian ;
: read/assert-flac-magic ( -- ) PRIVATE>
32 flac-read-uint FLAC-MAGIC = [ not-a-flac-file ] unless ;
: read-flac-metadata ( -- metadata ) : read-flac-metadata ( -- metadata )
read/assert-flac-magic read/assert-flac-magic
@ -142,27 +139,27 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
: <flac-stream-info> ( filename -- stream-info ) : <flac-stream-info> ( filename -- stream-info )
[ [
read/assert-flac-magic read/assert-flac-magic
32 flac-read-uint drop 32 flac-read drop
read-metadata-block-stream-info read-metadata-block-stream-info
] with-flac-file-reader ; ] with-flac-file-reader ;
: <flac-tags> ( filename -- tags ) ! : <flac-tags> ( filename -- tags )
[ ! [
read/assert-flac-magic ! read/assert-flac-magic
[ read-metadata-block-header [ length>> ] [ type>> metadata-vorbis-comment = ] [ last?>> ] tri or ] ! [ read-metadata-block-header [ length>> ] [ type>> metadata-vorbis-comment = ] [ last?>> ] tri or ]
[ flac-seek ] until [ read-metadata-block-vorbis-comment ] with-big-endian ! [ flac-seek ] until [ read-metadata-block-vorbis-comment ] with-big-endian
] with-flac-file-reader ; ! ] with-flac-file-reader ;
!
: <flac-pictures> ( filename -- pictures ) ! : <flac-pictures> ( filename -- pictures )
[ ! [
read/assert-flac-magic ! read/assert-flac-magic
[ read-metadata-block-header dup last?>> not ] ! [ read-metadata-block-header dup last?>> not ]
[ ! [
[ length>> ] [ type>> metadata-picture = ] bi ! [ length>> ] [ type>> metadata-picture = ] bi
[ read-metadata-block-picture ] ! [ read-metadata-block-picture ]
[ flac-seek f ] if ! [ flac-seek f ] if
] produce nip sift ! ] produce nip sift
] with-flac-file-reader ; ! ] with-flac-file-reader ;
: <flac-metadata> ( filename -- metadata ) : <flac-metadata> ( filename -- metadata )