wip
parent
c455f399a2
commit
f2cc5c7cc3
|
|
@ -1,23 +1,35 @@
|
|||
! Copyright (C) 2020 .
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax math io.encodings.binary kernel io io.files locals endian bit-arrays ;
|
||||
USING: alien.syntax math io.encodings.binary kernel io io.files locals endian bit-arrays math.intervals combinators math.order sequences io.streams.peek io.binary namespaces accessors ;
|
||||
USING: prettyprint ;
|
||||
USING: flac.metadata.private flac.metadata ;
|
||||
|
||||
QUALIFIED: bitstreams
|
||||
|
||||
|
||||
IN: flac.decoder
|
||||
|
||||
ALIAS: read-bit bitstreams:read
|
||||
ALIAS: peek-bits bitstreams:peek
|
||||
|
||||
CONSTANT: sync-code 16382
|
||||
ERROR: sync-code-error ;
|
||||
ERROR: invalid-channel-assignment ;
|
||||
ERROR: reserved-block-size ;
|
||||
ERROR: invalid-sample-rate ;
|
||||
|
||||
ENUM: flac-channel-assignment
|
||||
channel-assignment-independent
|
||||
channel-assignment-left-side
|
||||
channel-assignment-right-side
|
||||
channel-assignment-mid-side ;
|
||||
channels-mono
|
||||
channels-left/right
|
||||
channels-left/right/center
|
||||
channels-left/right/left-surround/right-surround
|
||||
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 ;
|
||||
|
||||
ENUM: flac-frame-number-type
|
||||
frame-number-type-frame
|
||||
frame-number-type-sample ;
|
||||
|
|
@ -39,44 +51,167 @@ TUPLE: subframe
|
|||
subframe-type-lpc } } ;
|
||||
|
||||
TUPLE: frame-header
|
||||
{ number-type maybe{ frame-number-type-frame frame-number-type-sample } }
|
||||
{ blocksize integer }
|
||||
{ sample-rate integer }
|
||||
{ channels integer }
|
||||
{ channel-assignment maybe{ channel-assignment-independent
|
||||
channel-assignment-left-side
|
||||
channel-assignment-right-side
|
||||
channel-assignment-mid-side } }
|
||||
{ channel-assignment maybe{ channels-mono
|
||||
channels-left/right
|
||||
channels-left/right/center
|
||||
channels-left/right/left-surround/right-surround
|
||||
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 }
|
||||
{ number-type maybe{ frame-number-type-frame frame-number-type-sample } }
|
||||
{ number integer }
|
||||
{ frame|sample-number integer }
|
||||
{ crc integer } ;
|
||||
|
||||
TUPLE: frame-footer
|
||||
{ crc integer } ;
|
||||
|
||||
:: read-sync-code ( bitstream -- ? )
|
||||
14 bitstream read-bit sync-code = ;
|
||||
: 0xxxxxxx? ( n -- ? ) 0x80 bitand 0x80 = not ;
|
||||
: 110xxxxx? ( n -- ? ) dup [ 0xc0 bitand 0xc0 = ] [ 0x20 bitand 0x20 = not ] bi* and ;
|
||||
: 1110xxxx? ( n -- ? ) dup [ 0xe0 bitand 0xe0 = ] [ 0x10 bitand 0x10 = not ] bi* and ;
|
||||
: 11110xxx? ( n -- ? ) dup [ 0xf0 bitand 0xf0 = ] [ 0x08 bitand 0x08 = not ] bi* and ;
|
||||
: 111110xx? ( n -- ? ) dup [ 0xf8 bitand 0xf8 = ] [ 0x04 bitand 0x04 = not ] bi* and ;
|
||||
: 1111110x? ( n -- ? ) dup [ 0xfc bitand 0xfc = ] [ 0x02 bitand 0x02 = not ] bi* and ;
|
||||
: 11111110? ( n -- ? ) dup [ 0xfe bitand 0xfe = ] [ 0x01 bitand 0x01 = not ] bi* and ;
|
||||
|
||||
:: (decode-frame-header) ( bitstream -- )
|
||||
: remaining-bytes ( n -- n )
|
||||
{
|
||||
{ [ dup 110xxxxx? ] [ drop 1 ] }
|
||||
{ [ dup 1110xxxx? ] [ drop 2 ] }
|
||||
{ [ dup 11110xxx? ] [ drop 3 ] }
|
||||
{ [ dup 111110xx? ] [ drop 4 ] }
|
||||
{ [ dup 1111110x? ] [ drop 5 ] }
|
||||
{ [ dup 11111110? ] [ drop 6 ] }
|
||||
} cond ;
|
||||
|
||||
! : frame-bytes ( byte-array -- n )
|
||||
! bitstreams:<msb0-bit-reader>
|
||||
! 0
|
||||
! {
|
||||
! { 0b00000000 [ 1 ] }
|
||||
! { 0b11000000 [ 2 ] }
|
||||
! { 0b11100000 [ 3 ] }
|
||||
! { 0b11110000 [ 4 ] }
|
||||
! { 0b11111000 [ 5 ] }
|
||||
! { 0b11111100 [ 6 ] }
|
||||
! } case ;
|
||||
|
||||
:: decode-utf8-uint ( frame-length bitstream -- n )
|
||||
frame-length 7 -
|
||||
bitstream read-bit
|
||||
frame-length <iota>
|
||||
[
|
||||
bitstream read-sync-code [ sync-code-error ] unless
|
||||
1 bitstream read-bit drop
|
||||
1 bitstream read-bit drop
|
||||
4 bitstream read-bit integer>bit-array .
|
||||
4 bitstream read-bit integer>bit-array .
|
||||
drop
|
||||
2 bitstream read-bit drop
|
||||
6 shift 6 bitstream read-bit bitor
|
||||
] each ;
|
||||
|
||||
] with-big-endian ;
|
||||
: read-utf8-uint ( -- n )
|
||||
1 read dup
|
||||
be> 0xxxxxxx?
|
||||
[ be> ]
|
||||
[
|
||||
dup be> remaining-bytes read
|
||||
B{ } append-as be>
|
||||
] if ;
|
||||
|
||||
: decode-frame-header ( -- )
|
||||
: decode-block-size ( n -- n )
|
||||
{
|
||||
{ [ dup 0b0000 = ] [ drop reserved-block-size ] }
|
||||
{ [ dup 0b0001 = ] [ drop 192 ] }
|
||||
{ [ dup 0b0010 0b0101 between? ] [ 2 - 2^ 567 * ] }
|
||||
{ [ dup 0b0110 0b0111 between? ] [ ] }
|
||||
{ [ dup 0b1000 0b1111 between? ] [ 8 - 2^ 256 * ] }
|
||||
} cond ;
|
||||
|
||||
: decode-bits-per-sample ( n -- n )
|
||||
{
|
||||
{ 0b000 [ -99 ] }
|
||||
{ 0b001 [ 8 ] }
|
||||
{ 0b010 [ 12 ] }
|
||||
{ 0b011 [ -99 ] }
|
||||
{ 0b100 [ 16 ] }
|
||||
{ 0b101 [ 20 ] }
|
||||
{ 0b110 [ 24 ] }
|
||||
{ 0b111 [ -99 ] }
|
||||
} case ;
|
||||
|
||||
: decode-sample-rate ( n -- n )
|
||||
{
|
||||
{ 0b0000 [ -99 ] }
|
||||
{ 0b0001 [ 88200 ] }
|
||||
{ 0b0010 [ 17640 ] }
|
||||
{ 0b0011 [ 19200 ] }
|
||||
{ 0b0100 [ 8000 ] }
|
||||
{ 0b0101 [ 16000 ] }
|
||||
{ 0b0110 [ 22050 ] }
|
||||
{ 0b0111 [ 24000 ] }
|
||||
{ 0b1000 [ 32000 ] }
|
||||
{ 0b1001 [ 44100 ] }
|
||||
{ 0b1010 [ 48000 ] }
|
||||
{ 0b1011 [ 96000 ] }
|
||||
{ 0b1100 [ 1 read be> 1000 * ] }
|
||||
{ 0b1101 [ 2 read be> ] }
|
||||
{ 0b1110 [ 2 read be> 10 * ] }
|
||||
{ 0b1111 [ invalid-sample-rate ] }
|
||||
} case ;
|
||||
|
||||
: decode-channels ( n -- channels channel-assignment )
|
||||
dup
|
||||
{
|
||||
{ [ dup 0b0000 0b0111 between? ] [ 1 + ] }
|
||||
{ [ 0b1000 0b1010 between? ] [ 2 ] }
|
||||
[ invalid-channel-assignment ]
|
||||
} cond swap
|
||||
<flac-channel-assignment> ;
|
||||
|
||||
:: decode-header ( bitstream -- frame-header )
|
||||
[
|
||||
3 read bitstreams:<msb0-bit-reader> (decode-frame-header)
|
||||
] with-big-endian ;
|
||||
14 bitstream read-bit drop ! ignore sync
|
||||
1 bitstream read-bit drop ! reserved
|
||||
1 bitstream read-bit
|
||||
4 bitstream read-bit
|
||||
4 bitstream read-bit
|
||||
4 bitstream read-bit
|
||||
3 bitstream read-bit
|
||||
1 bitstream read-bit drop ! ignore magic sync
|
||||
read-utf8-uint
|
||||
[
|
||||
{
|
||||
[ <flac-frame-number-type> ]
|
||||
[ decode-block-size ]
|
||||
[ decode-sample-rate ]
|
||||
[ decode-channels ]
|
||||
[ decode-bits-per-sample ]
|
||||
} spread
|
||||
] dip
|
||||
1 read be>
|
||||
] with-big-endian
|
||||
frame-header boa ;
|
||||
|
||||
: decode-file ( filename -- )
|
||||
: read-subframe ( frame-header channel -- subframe )
|
||||
drop drop -9 ;
|
||||
|
||||
: read-subframes ( frame-header -- seq )
|
||||
dup channels>> swap <repetition> [ read-subframe ] map-index ;
|
||||
|
||||
: read-frame-header ( -- frame-header )
|
||||
4 read bitstreams:<msb0-bit-reader> decode-header ;
|
||||
|
||||
: decode-file ( filename -- something )
|
||||
binary
|
||||
[
|
||||
read-flac-magic [ not-a-flac-file ] unless
|
||||
read-stream-info drop
|
||||
read-stream-info .
|
||||
skip-metadata
|
||||
decode-frame-header
|
||||
! 51448296 seek-absolute seek-input
|
||||
read-frame-header
|
||||
contents .
|
||||
] with-file-reader ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2020 .
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test ;
|
||||
|
||||
|
|
@ -125,10 +125,10 @@ TUPLE: metadata
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: read-flac-magic ( -- magic )
|
||||
: read-flac-magic ( -- ? )
|
||||
4 read utf8 decode FLAC-MAGIC = ;
|
||||
|
||||
:: (parse-metadata-block-header) ( bitstream -- header )
|
||||
:: (decode-metadata-block-header) ( bitstream -- header )
|
||||
[
|
||||
1 bitstream read-bit 1 =
|
||||
7 bitstream read-bit <metadata-type>
|
||||
|
|
@ -136,13 +136,13 @@ TUPLE: metadata
|
|||
] with-big-endian
|
||||
metadata-block-header boa ;
|
||||
|
||||
: parse-metadata-block-header ( byte-array -- header )
|
||||
bitstreams:<msb0-bit-reader> (parse-metadata-block-header) ;
|
||||
: decode-metadata-block-header ( byte-array -- header )
|
||||
bitstreams:<msb0-bit-reader> (decode-metadata-block-header) ;
|
||||
|
||||
: read-metadata-block-header ( -- header )
|
||||
4 read parse-metadata-block-header ;
|
||||
4 read decode-metadata-block-header ;
|
||||
|
||||
:: (parse-stream-info) ( bitstream -- stream-info )
|
||||
:: (decode-stream-info) ( bitstream -- stream-info )
|
||||
[
|
||||
16 bitstream read-bit
|
||||
16 bitstream read-bit
|
||||
|
|
@ -156,10 +156,10 @@ TUPLE: metadata
|
|||
] with-big-endian
|
||||
stream-info boa ;
|
||||
|
||||
: parse-stream-info ( byte-array -- stream-info )
|
||||
bitstreams:<msb0-bit-reader> (parse-stream-info) ;
|
||||
: decode-stream-info ( byte-array -- stream-info )
|
||||
bitstreams:<msb0-bit-reader> (decode-stream-info) ;
|
||||
|
||||
: parse-seek-table ( byte-array -- seek-table )
|
||||
: decode-seek-table ( byte-array -- seek-table )
|
||||
dup
|
||||
binary
|
||||
[
|
||||
|
|
@ -168,7 +168,7 @@ TUPLE: metadata
|
|||
] with-byte-reader
|
||||
seek-table boa ;
|
||||
|
||||
: parse-vorbis-comment ( byte-array -- comments )
|
||||
: decode-vorbis-comment ( byte-array -- comments )
|
||||
binary
|
||||
[
|
||||
4 read le> read utf8 decode
|
||||
|
|
@ -179,13 +179,31 @@ TUPLE: metadata
|
|||
] map
|
||||
] with-byte-reader >alist vorbis-comment boa ;
|
||||
|
||||
: parse-padding ( byte-array -- padding )
|
||||
: encode-vorbis-string ( str -- byte-array )
|
||||
dup binary [ length 4 >le write utf8 encode write ] with-byte-writer ;
|
||||
|
||||
: encode-vorbis-comments ( assoc -- byte-array )
|
||||
dup binary [
|
||||
length 4 >le write
|
||||
[ 2array "=" join encode-vorbis-string write ] assoc-each
|
||||
] with-byte-writer ;
|
||||
|
||||
: encode-vorbis-comment ( vorbis-comment -- byte-array )
|
||||
binary [
|
||||
[ vendor-string>> encode-vorbis-string write ]
|
||||
[ comments>> encode-vorbis-comments write ] bi
|
||||
] with-byte-writer ;
|
||||
|
||||
: encode-padding ( padding -- byte-array )
|
||||
length>> <byte-array> ;
|
||||
|
||||
: decode-padding ( byte-array -- padding )
|
||||
length padding boa ;
|
||||
|
||||
: parse-application ( byte-array -- application )
|
||||
: decode-application ( byte-array -- application )
|
||||
drop application new ;
|
||||
|
||||
: parse-cuesheet ( byte-array -- cuesheet )
|
||||
: decode-cuesheet ( byte-array -- cuesheet )
|
||||
binary
|
||||
[
|
||||
128 read ascii decode
|
||||
|
|
@ -208,7 +226,7 @@ TUPLE: metadata
|
|||
] map
|
||||
] with-byte-reader cuesheet boa ;
|
||||
|
||||
: parse-picture ( byte-array -- picture )
|
||||
: decode-picture ( byte-array -- picture )
|
||||
binary
|
||||
[
|
||||
4 read be> <picture-type>
|
||||
|
|
@ -221,22 +239,22 @@ TUPLE: metadata
|
|||
4 read be> read
|
||||
] with-byte-reader picture boa ;
|
||||
|
||||
: read-metadata-block ( metadata byte-array type -- metadata )
|
||||
: decode-metadata-block ( metadata byte-array type -- metadata )
|
||||
{
|
||||
{ metadata-stream-info [ parse-stream-info >>stream-info ] }
|
||||
{ metadata-padding [ parse-padding >>padding ] }
|
||||
{ metadata-application [ parse-application >>application ] }
|
||||
{ metadata-seek-table [ parse-seek-table >>seek-table ] }
|
||||
{ metadata-vorbis-comment [ parse-vorbis-comment >>vorbis-comment ] }
|
||||
{ metadata-cuesheet [ parse-cuesheet >>cuesheet ] }
|
||||
{ metadata-picture [ parse-picture >>picture ] }
|
||||
{ metadata-stream-info [ decode-stream-info >>stream-info ] }
|
||||
{ metadata-padding [ decode-padding >>padding ] }
|
||||
{ metadata-application [ decode-application >>application ] }
|
||||
{ metadata-seek-table [ decode-seek-table >>seek-table ] }
|
||||
{ metadata-vorbis-comment [ decode-vorbis-comment >>vorbis-comment ] }
|
||||
{ metadata-cuesheet [ decode-cuesheet >>cuesheet ] }
|
||||
{ metadata-picture [ decode-picture >>picture ] }
|
||||
} case ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: read-stream-info ( -- stream-info )
|
||||
read-metadata-block-header
|
||||
length>> read bitstreams:<msb0-bit-reader> parse-stream-info ;
|
||||
length>> read decode-stream-info ;
|
||||
|
||||
: skip-metadata ( -- )
|
||||
[
|
||||
|
|
@ -253,7 +271,7 @@ PRIVATE>
|
|||
[
|
||||
read-metadata-block-header
|
||||
[ length>> read ] [ type>> ] [ last?>> not ] tri
|
||||
[ read-metadata-block ] dip
|
||||
[ decode-metadata-block ] dip
|
||||
] loop
|
||||
] with-file-reader ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue