wip
parent
77d5b75257
commit
440365c072
|
@ -1,19 +1,39 @@
|
||||||
! Copyright (C) 2009 Daniel Ehrenberg
|
! Copyright (C) 2009 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel system destructors accessors io.streams.duplex ;
|
USING: kernel system destructors accessors byte-arrays math locals io.files io.encodings.binary combinators sequences namespaces ;
|
||||||
|
QUALIFIED: bitstreams
|
||||||
|
QUALIFIED: io
|
||||||
|
USING: prettyprint ;
|
||||||
|
|
||||||
IN: flac.bitstream
|
IN: flac.bitstream
|
||||||
|
|
||||||
TUPLE: flac-bitstream < disposable
|
SYMBOL: flac-input-stream
|
||||||
stream ;
|
|
||||||
|
|
||||||
HOOK: open-flac-bitstream os ( flac-bitstream -- flac-bitstream' )
|
TUPLE: flac-stream-reader stream bitstream ;
|
||||||
|
|
||||||
M: flac-bitstream dispose* ( flac-bitstream -- ) stream>> dispose ;
|
GENERIC: read-uint ( n flac-stream-reader -- n )
|
||||||
|
GENERIC: align-to-byte ( flac-stream-reader -- )
|
||||||
|
|
||||||
: <flac-bitstream> ( path -- flac-bitstream )
|
: <flac-stream-reader> ( path -- flac-stream-reader )
|
||||||
flac-bitstream new
|
binary <file-reader> B{ } bitstreams:<msb0-bit-reader> flac-stream-reader boa ;
|
||||||
swap >>path ;
|
|
||||||
|
|
||||||
: with-flac-bitstream ( flac-bitstream quot -- )
|
M: flac-stream-reader dispose stream>> dispose ;
|
||||||
[ open-flac-bitstream ] dip with-stream ; inline
|
|
||||||
|
: 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>> 1 swap io:stream-read ] [ bitstream>> ] bi
|
||||||
|
dup bytes>> swap [ prepend ] dip swap >>bytes drop
|
||||||
|
] while flac-input-stream get bitstream>> bitstreams:read ;
|
||||||
|
|
||||||
|
: 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 quote -- )
|
||||||
|
[ <flac-stream-reader> ] dip with-flac-stream-reader ; inline
|
||||||
|
|
|
@ -1,16 +1,11 @@
|
||||||
! Copyright (C) 2020 .
|
! Copyright (C) 2020 .
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: math io.encodings.binary kernel io io.files locals endian bit-arrays math.intervals combinators combinators.extras math.order sequences io.streams.peek io.binary namespaces accessors byte-arrays math.bitwise ;
|
USING: math io.encodings.binary kernel io io.files locals endian bit-arrays math.intervals combinators combinators.extras math.order sequences namespaces accessors byte-arrays math.bitwise ;
|
||||||
USING: prettyprint ;
|
USING: prettyprint ;
|
||||||
USING: flac.metadata.private flac.metadata flac.format ;
|
USING: flac.bitstream flac.metadata.private flac.format ;
|
||||||
|
|
||||||
QUALIFIED: bitstreams
|
|
||||||
|
|
||||||
IN: flac.decoder
|
IN: flac.decoder
|
||||||
|
|
||||||
ALIAS: read-bit bitstreams:read
|
|
||||||
ALIAS: peek-bits bitstreams:peek
|
|
||||||
|
|
||||||
CONSTANT: sync-code 16382
|
CONSTANT: sync-code 16382
|
||||||
ERROR: sync-code-error ;
|
ERROR: sync-code-error ;
|
||||||
ERROR: invalid-channel-assignment ;
|
ERROR: invalid-channel-assignment ;
|
||||||
|
@ -19,6 +14,9 @@ ERROR: invalid-sample-rate ;
|
||||||
ERROR: reserved-subframe-type ;
|
ERROR: reserved-subframe-type ;
|
||||||
ERROR: invalid-subframe-sync ;
|
ERROR: invalid-subframe-sync ;
|
||||||
|
|
||||||
|
: read-flac-magic ( -- ? )
|
||||||
|
32 flac-read-uint FLAC-MAGIC = ;
|
||||||
|
|
||||||
: 0xxxxxxx? ( n -- ? ) 0x80 mask? not ;
|
: 0xxxxxxx? ( n -- ? ) 0x80 mask? not ;
|
||||||
: 110xxxxx? ( n -- ? ) [ 0xc0 mask? ] [ 0x20 mask? not ] bi and ;
|
: 110xxxxx? ( n -- ? ) [ 0xc0 mask? ] [ 0x20 mask? not ] bi and ;
|
||||||
: 1110xxxx? ( n -- ? ) [ 0xe0 mask? ] [ 0x10 mask? not ] bi and ;
|
: 1110xxxx? ( n -- ? ) [ 0xe0 mask? ] [ 0x10 mask? not ] bi and ;
|
||||||
|
@ -37,20 +35,20 @@ ERROR: invalid-subframe-sync ;
|
||||||
{ [ 11111110? ] [ 6 ] }
|
{ [ 11111110? ] [ 6 ] }
|
||||||
} cond-case ;
|
} cond-case ;
|
||||||
|
|
||||||
:: decode-utf8-uint ( frame-length bitstream -- n )
|
! :: decode-utf8-uint ( frame-length bitstream -- n )
|
||||||
frame-length 7 -
|
! frame-length 7 -
|
||||||
bitstream read-bit
|
! bitstream read-bit
|
||||||
frame-length <iota> [
|
! frame-length <iota> [
|
||||||
drop
|
! drop
|
||||||
2 bitstream read-bit drop
|
! 2 bitstream read-bit drop
|
||||||
6 shift 6 bitstream read-bit bitor
|
! 6 shift 6 bitstream read-bit bitor
|
||||||
] each ;
|
! ] each ;
|
||||||
|
|
||||||
: read-utf8-uint ( -- n )
|
! : read-utf8-uint ( -- n )
|
||||||
1 read dup
|
! 1 read dup
|
||||||
be> 0xxxxxxx?
|
! be> 0xxxxxxx?
|
||||||
[ be> ]
|
! [ be> ]
|
||||||
[ dup be> remaining-bytes read B{ } append-as be> ] if ;
|
! [ dup be> remaining-bytes read B{ } append-as be> ] if ;
|
||||||
|
|
||||||
: decode-block-size ( n -- n )
|
: decode-block-size ( n -- n )
|
||||||
dup
|
dup
|
||||||
|
@ -88,9 +86,9 @@ ERROR: invalid-subframe-sync ;
|
||||||
{ 0b1001 [ 44100 ] }
|
{ 0b1001 [ 44100 ] }
|
||||||
{ 0b1010 [ 48000 ] }
|
{ 0b1010 [ 48000 ] }
|
||||||
{ 0b1011 [ 96000 ] }
|
{ 0b1011 [ 96000 ] }
|
||||||
{ 0b1100 [ 1 read be> 1000 * ] }
|
{ 0b1100 [ 8 flac-read-uint 1000 * ] }
|
||||||
{ 0b1101 [ 2 read be> ] }
|
{ 0b1101 [ 16 flac-read-uint ] }
|
||||||
{ 0b1110 [ 2 read be> 10 * ] }
|
{ 0b1110 [ 16 flac-read-uint 10 * ] }
|
||||||
{ 0b1111 [ invalid-sample-rate ] }
|
{ 0b1111 [ invalid-sample-rate ] }
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
|
@ -103,93 +101,98 @@ ERROR: invalid-subframe-sync ;
|
||||||
} cond swap
|
} cond swap
|
||||||
<flac-channel-assignment> ;
|
<flac-channel-assignment> ;
|
||||||
|
|
||||||
:: decode-header ( bitstream -- frame-header )
|
! :: decode-header ( bitstream -- frame-header )
|
||||||
[
|
! [
|
||||||
14 bitstream read-bit drop ! ignore sync
|
! 14 bitstream read-bit drop ! ignore sync
|
||||||
1 bitstream read-bit drop ! reserved
|
! 1 bitstream read-bit drop ! reserved
|
||||||
1 bitstream read-bit
|
! 1 bitstream read-bit
|
||||||
4 bitstream read-bit
|
! 4 bitstream read-bit
|
||||||
4 bitstream read-bit
|
! 4 bitstream read-bit
|
||||||
4 bitstream read-bit
|
! 4 bitstream read-bit
|
||||||
3 bitstream read-bit
|
! 3 bitstream read-bit
|
||||||
1 bitstream read-bit drop ! ignore magic sync
|
! 1 bitstream read-bit drop ! ignore magic sync
|
||||||
read-utf8-uint
|
! read-utf8-uint
|
||||||
[
|
! [
|
||||||
{
|
! {
|
||||||
[ <flac-frame-number-type> ]
|
! [ <flac-frame-number-type> ]
|
||||||
[ decode-block-size ]
|
! [ decode-block-size ]
|
||||||
[ decode-sample-rate ]
|
! [ decode-sample-rate ]
|
||||||
[ decode-channels ]
|
! [ decode-channels ]
|
||||||
[ decode-bits-per-sample ]
|
! [ decode-bits-per-sample ]
|
||||||
} spread
|
! } spread
|
||||||
] dip
|
! ] dip
|
||||||
1 read be>
|
! 1 read be>
|
||||||
] with-big-endian
|
! ] with-big-endian
|
||||||
flac-frame-header boa ;
|
! flac-frame-header boa ;
|
||||||
|
!
|
||||||
|
! : decode-subframe-type ( n -- order type )
|
||||||
|
! dup
|
||||||
|
! {
|
||||||
|
! { [ 0 = ] [ drop f 0 ] }
|
||||||
|
! { [ 1 = ] [ drop f 1 ] }
|
||||||
|
! { [ 8 12 between? ] [ -1 shift 7 bitand 2 ] }
|
||||||
|
! { [ 32 63 between? ] [ -1 shift 31 bitand 3 ] }
|
||||||
|
! [ drop reserved-subframe-type ]
|
||||||
|
! } cond-case <flac-subframe-type> swap ;
|
||||||
|
!
|
||||||
|
! : read-residual ( order -- residual )
|
||||||
|
! drop "TODO" ;
|
||||||
|
!
|
||||||
|
! : read-constant-subframe ( frame-header subframe-header -- constant-subframe )
|
||||||
|
! drop bits-per-sample>> 8 / read be> flac-subframe-constant boa ;
|
||||||
|
!
|
||||||
|
! : read-fixed-subframe ( fame-header subframe-header -- fixed-subframe )
|
||||||
|
! order>> swap bits-per-sample>> <repetition> [
|
||||||
|
! 8 / read be>
|
||||||
|
! ] map flac-subframe-fixed new swap >>warmup dup . ;
|
||||||
|
!
|
||||||
|
! : read-lpc-subframe ( predictive-order -- lpc-subframe )
|
||||||
|
! drop "TODO" ;
|
||||||
|
!
|
||||||
|
! :: decode-subframe-header ( bitstream -- subframe-header )
|
||||||
|
! 1 bitstream read-bit 1 = [ invalid-subframe-sync ] when
|
||||||
|
! 6 bitstream read-bit decode-subframe-type
|
||||||
|
! 1 bitstream read-bit ! TODO: wasted-bits: 0 for now..
|
||||||
|
! flac-subframe-header boa ;
|
||||||
|
!
|
||||||
|
! ! TODO: actually decode based on subframe type
|
||||||
|
! ! TODO: handle wasted bits assuming 1 byte for now :/
|
||||||
|
! : read-subframe ( frame-header -- subframe )
|
||||||
|
! 1 read bitstreams:<msb0-bit-reader> decode-subframe-header dup dup
|
||||||
|
! [
|
||||||
|
! subframe-type>>
|
||||||
|
! {
|
||||||
|
! { subframe-type-constant [ read-constant-subframe ] }
|
||||||
|
! { subframe-type-fixed [ read-fixed-subframe ] }
|
||||||
|
! } case
|
||||||
|
! ] dip swap flac-subframe boa ;
|
||||||
|
!
|
||||||
|
! : read-subframes ( frame-header -- seq )
|
||||||
|
! dup channels>> swap <repetition> [ dup . read-subframe ] map ;
|
||||||
|
!
|
||||||
|
! : read-frame-header ( -- frame-header )
|
||||||
|
! 4 read bitstreams:<msb0-bit-reader> decode-header ;
|
||||||
|
!
|
||||||
|
! : read-frame-footer ( -- frame-footer )
|
||||||
|
! 2 read be> flac-frame-footer boa ;
|
||||||
|
!
|
||||||
|
! : read-frame ( -- frame )
|
||||||
|
! read-frame-header dup
|
||||||
|
! read-subframes
|
||||||
|
! read-frame-footer
|
||||||
|
! flac-frame boa ;
|
||||||
|
!
|
||||||
|
! : read-flac-file ( filename -- something )
|
||||||
|
! binary
|
||||||
|
! [
|
||||||
|
! read-flac-magic [ not-a-flac-file ] unless
|
||||||
|
! read-stream-info .
|
||||||
|
! skip-metadata
|
||||||
|
! ! 51448296 seek-absolute seek-input
|
||||||
|
! 4 <iota> [ drop read-frame ] map
|
||||||
|
! ] with-file-reader ;
|
||||||
|
|
||||||
: decode-subframe-type ( n -- order type )
|
: read-flac-file ( filename -- flac-stream )
|
||||||
dup
|
|
||||||
{
|
|
||||||
{ [ 0 = ] [ drop f 0 ] }
|
|
||||||
{ [ 1 = ] [ drop f 1 ] }
|
|
||||||
{ [ 8 12 between? ] [ -1 shift 7 bitand 2 ] }
|
|
||||||
{ [ 32 63 between? ] [ -1 shift 31 bitand 3 ] }
|
|
||||||
[ drop reserved-subframe-type ]
|
|
||||||
} cond-case <flac-subframe-type> swap ;
|
|
||||||
|
|
||||||
: read-residual ( order -- residual )
|
|
||||||
drop "TODO" ;
|
|
||||||
|
|
||||||
: read-constant-subframe ( frame-header subframe-header -- constant-subframe )
|
|
||||||
drop bits-per-sample>> 8 / read be> flac-subframe-constant boa ;
|
|
||||||
|
|
||||||
: read-fixed-subframe ( fame-header subframe-header -- fixed-subframe )
|
|
||||||
order>> swap bits-per-sample>> <repetition> [
|
|
||||||
8 / read be>
|
|
||||||
] map flac-subframe-fixed new swap >>warmup dup . ;
|
|
||||||
|
|
||||||
: read-lpc-subframe ( predictive-order -- lpc-subframe )
|
|
||||||
drop "TODO" ;
|
|
||||||
|
|
||||||
:: decode-subframe-header ( bitstream -- subframe-header )
|
|
||||||
1 bitstream read-bit 1 = [ invalid-subframe-sync ] when
|
|
||||||
6 bitstream read-bit decode-subframe-type
|
|
||||||
1 bitstream read-bit ! TODO: wasted-bits: 0 for now..
|
|
||||||
flac-subframe-header boa ;
|
|
||||||
|
|
||||||
! TODO: actually decode based on subframe type
|
|
||||||
! TODO: handle wasted bits assuming 1 byte for now :/
|
|
||||||
: read-subframe ( frame-header -- subframe )
|
|
||||||
1 read bitstreams:<msb0-bit-reader> decode-subframe-header dup dup
|
|
||||||
[
|
|
||||||
subframe-type>>
|
|
||||||
{
|
|
||||||
{ subframe-type-constant [ read-constant-subframe ] }
|
|
||||||
{ subframe-type-fixed [ read-fixed-subframe ] }
|
|
||||||
} case
|
|
||||||
] dip swap flac-subframe boa ;
|
|
||||||
|
|
||||||
: read-subframes ( frame-header -- seq )
|
|
||||||
dup channels>> swap <repetition> [ dup . read-subframe ] map ;
|
|
||||||
|
|
||||||
: read-frame-header ( -- frame-header )
|
|
||||||
4 read bitstreams:<msb0-bit-reader> decode-header ;
|
|
||||||
|
|
||||||
: read-frame-footer ( -- frame-footer )
|
|
||||||
2 read be> flac-frame-footer boa ;
|
|
||||||
|
|
||||||
: read-frame ( -- frame )
|
|
||||||
read-frame-header dup
|
|
||||||
read-subframes
|
|
||||||
read-frame-footer
|
|
||||||
flac-frame boa ;
|
|
||||||
|
|
||||||
: read-flac-file ( filename -- something )
|
|
||||||
binary
|
|
||||||
[
|
[
|
||||||
read-flac-magic [ not-a-flac-file ] unless
|
read-flac-magic [ not-a-flac-file ] unless
|
||||||
read-stream-info .
|
] with-flac-stream-reader ;
|
||||||
skip-metadata
|
|
||||||
! 51448296 seek-absolute seek-input
|
|
||||||
4 <iota> [ drop read-frame ] map
|
|
||||||
] with-file-reader ;
|
|
||||||
|
|
|
@ -1,9 +1,11 @@
|
||||||
! Copyright (C) 2020 .
|
! Copyright (C) 2020 .
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.syntax math byte-arrays sequences ;
|
USING: alien.syntax math byte-arrays sequences kernel strings arrays assocs ;
|
||||||
|
|
||||||
IN: flac.format
|
IN: flac.format
|
||||||
|
|
||||||
|
CONSTANT: FLAC-MAGIC 0x664c6143 ! fLaC
|
||||||
|
|
||||||
CONSTANT: MIN-BLOCK-SIZE 16
|
CONSTANT: MIN-BLOCK-SIZE 16
|
||||||
CONSTANT: MAX-BLOCK-SIZE 65535
|
CONSTANT: MAX-BLOCK-SIZE 65535
|
||||||
CONSTANT: MAX-SAMPLE-SIZE: 4608
|
CONSTANT: MAX-SAMPLE-SIZE: 4608
|
||||||
|
@ -17,6 +19,7 @@ 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 ;
|
||||||
|
|
||||||
ENUM: flac-frame-number-type
|
ENUM: flac-frame-number-type
|
||||||
frame-number-type-frame
|
frame-number-type-frame
|
||||||
|
@ -122,3 +125,115 @@ TUPLE: flac-frame
|
||||||
{ header flac-frame-header }
|
{ header flac-frame-header }
|
||||||
{ subframes sequence }
|
{ subframes sequence }
|
||||||
{ footer flac-frame-footer } ;
|
{ footer flac-frame-footer } ;
|
||||||
|
|
||||||
|
ENUM: metadata-type
|
||||||
|
metadata-stream-info
|
||||||
|
metadata-padding
|
||||||
|
metadata-application
|
||||||
|
metadata-seek-table
|
||||||
|
metadata-vorbis-comment
|
||||||
|
metadata-cuesheet
|
||||||
|
metadata-picture
|
||||||
|
{ metadata-invalid 127 } ;
|
||||||
|
|
||||||
|
|
||||||
|
TUPLE: metadata-block-header
|
||||||
|
{ last? boolean }
|
||||||
|
{ type maybe{ metadata-stream-info
|
||||||
|
metadata-padding
|
||||||
|
metadata-application
|
||||||
|
metadata-seek-table
|
||||||
|
metadata-vorbis-comment
|
||||||
|
metadata-cuesheet
|
||||||
|
metadata-picture
|
||||||
|
metadata-invalid } }
|
||||||
|
{ length integer } ;
|
||||||
|
|
||||||
|
TUPLE: stream-info
|
||||||
|
{ min-block-size integer }
|
||||||
|
{ max-block-size integer }
|
||||||
|
{ min-frame-size integer }
|
||||||
|
{ max-frame-size integer }
|
||||||
|
{ sample-rate integer }
|
||||||
|
{ channels integer }
|
||||||
|
{ bits-per-sample integer }
|
||||||
|
{ samples integer }
|
||||||
|
{ md5 string } ;
|
||||||
|
|
||||||
|
TUPLE: seek-table
|
||||||
|
{ seek-points array } ;
|
||||||
|
TUPLE: seek-point
|
||||||
|
{ sample-number integer }
|
||||||
|
{ offset integer }
|
||||||
|
{ total-samples } ;
|
||||||
|
|
||||||
|
TUPLE: vorbis-comment
|
||||||
|
{ vendor-string string }
|
||||||
|
{ comments assoc } ;
|
||||||
|
|
||||||
|
TUPLE: flac-padding
|
||||||
|
{ length integer } ;
|
||||||
|
|
||||||
|
TUPLE: application
|
||||||
|
{ id string }
|
||||||
|
{ data byte-array } ;
|
||||||
|
|
||||||
|
ENUM: cuesheet-track-type audio non-audio ;
|
||||||
|
|
||||||
|
TUPLE: cuesheet-track
|
||||||
|
{ offset integer }
|
||||||
|
{ number number }
|
||||||
|
{ isrc string }
|
||||||
|
{ type integer }
|
||||||
|
{ pre-emphasis boolean }
|
||||||
|
{ indices array } ;
|
||||||
|
TUPLE: cuesheet-index
|
||||||
|
{ offset integer }
|
||||||
|
{ number integer } ;
|
||||||
|
TUPLE: cuesheet
|
||||||
|
{ catalog-number integer }
|
||||||
|
{ lead-in integer }
|
||||||
|
{ cd? boolean }
|
||||||
|
{ tracks array } ;
|
||||||
|
|
||||||
|
ENUM: picture-type
|
||||||
|
other
|
||||||
|
file-icon
|
||||||
|
other-file-icon
|
||||||
|
front-cover
|
||||||
|
back-cover
|
||||||
|
leaflet-page
|
||||||
|
media
|
||||||
|
lead-artist/performer/soloist
|
||||||
|
artist/performer
|
||||||
|
conductor
|
||||||
|
band/orchestra
|
||||||
|
composer
|
||||||
|
lyricist/text-writer
|
||||||
|
recording-location
|
||||||
|
during-recording
|
||||||
|
during-performance
|
||||||
|
movie/video-screen-capture
|
||||||
|
bright-coloured-fish
|
||||||
|
illustration
|
||||||
|
badn/artist-logotype
|
||||||
|
publisher/studio-logotype ;
|
||||||
|
|
||||||
|
TUPLE: picture
|
||||||
|
type
|
||||||
|
{ mime-type string }
|
||||||
|
{ description string }
|
||||||
|
{ width integer }
|
||||||
|
{ height integer }
|
||||||
|
{ depth integer }
|
||||||
|
{ colors integer }
|
||||||
|
{ data byte-array } ;
|
||||||
|
|
||||||
|
TUPLE: metadata
|
||||||
|
{ stream-info stream-info }
|
||||||
|
{ padding maybe{ flac-padding } }
|
||||||
|
{ application maybe{ application } }
|
||||||
|
{ seek-table maybe{ seek-table } }
|
||||||
|
{ vorbis-comment maybe{ vorbis-comment } }
|
||||||
|
{ cuesheet maybe{ cuesheet } }
|
||||||
|
{ picture maybe{ picture } } ;
|
||||||
|
|
|
@ -1,159 +1,31 @@
|
||||||
! Copyright (C) 2020 .
|
! Copyright (C) 2020 .
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: endian sequences kernel classes.struct io 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 pack math.parser strings arrays io.streams.byte-array sequences.generalizations assocs splitting byte-arrays alien.syntax alien.enums io.encodings.ascii ;
|
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 ;
|
||||||
|
USING: flac.bitstream flac.format ;
|
||||||
|
|
||||||
QUALIFIED: bitstreams
|
QUALIFIED: bitstreams
|
||||||
|
QUALIFIED: io
|
||||||
|
|
||||||
IN: flac.metadata
|
IN: flac.metadata
|
||||||
|
|
||||||
ALIAS: read-bit bitstreams:read
|
|
||||||
|
|
||||||
CONSTANT: FLAC-MAGIC "fLaC"
|
|
||||||
|
|
||||||
ENUM: metadata-type
|
|
||||||
metadata-stream-info
|
|
||||||
metadata-padding
|
|
||||||
metadata-application
|
|
||||||
metadata-seek-table
|
|
||||||
metadata-vorbis-comment
|
|
||||||
metadata-cuesheet
|
|
||||||
metadata-picture
|
|
||||||
{ metadata-invalid 127 } ;
|
|
||||||
|
|
||||||
ERROR: not-a-flac-file ;
|
|
||||||
ERROR: cuesheet-index-reserved-must-be-zero ;
|
ERROR: cuesheet-index-reserved-must-be-zero ;
|
||||||
|
|
||||||
TUPLE: metadata-block-header
|
: read-metadata-block-header ( -- header )
|
||||||
{ last? boolean }
|
1 flac-read-uint 1 =
|
||||||
{ type maybe{ metadata-stream-info
|
7 flac-read-uint <metadata-type>
|
||||||
metadata-padding
|
24 flac-read-uint
|
||||||
metadata-application
|
|
||||||
metadata-seek-table
|
|
||||||
metadata-vorbis-comment
|
|
||||||
metadata-cuesheet
|
|
||||||
metadata-picture
|
|
||||||
metadata-invalid } }
|
|
||||||
{ length integer } ;
|
|
||||||
|
|
||||||
TUPLE: stream-info
|
|
||||||
{ min-block-size integer }
|
|
||||||
{ max-block-size integer }
|
|
||||||
{ min-frame-size integer }
|
|
||||||
{ max-frame-size integer }
|
|
||||||
{ sample-rate integer }
|
|
||||||
{ channels integer }
|
|
||||||
{ bits-per-sample integer }
|
|
||||||
{ samples integer }
|
|
||||||
{ md5 string } ;
|
|
||||||
|
|
||||||
TUPLE: seek-table
|
|
||||||
{ seek-points array } ;
|
|
||||||
TUPLE: seek-point
|
|
||||||
{ sample-number integer }
|
|
||||||
{ offset integer }
|
|
||||||
{ total-samples } ;
|
|
||||||
|
|
||||||
TUPLE: vorbis-comment
|
|
||||||
{ vendor-string string }
|
|
||||||
{ comments assoc } ;
|
|
||||||
|
|
||||||
TUPLE: padding
|
|
||||||
{ length integer } ;
|
|
||||||
|
|
||||||
TUPLE: application
|
|
||||||
{ id string }
|
|
||||||
{ data byte-array } ;
|
|
||||||
|
|
||||||
ENUM: cuesheet-track-type audio non-audio ;
|
|
||||||
|
|
||||||
TUPLE: cuesheet-track
|
|
||||||
{ offset integer }
|
|
||||||
{ number number }
|
|
||||||
{ isrc string }
|
|
||||||
{ type integer }
|
|
||||||
{ pre-emphasis boolean }
|
|
||||||
{ indices array } ;
|
|
||||||
TUPLE: cuesheet-index
|
|
||||||
{ offset integer }
|
|
||||||
{ number integer } ;
|
|
||||||
TUPLE: cuesheet
|
|
||||||
{ catalog-number integer }
|
|
||||||
{ lead-in integer }
|
|
||||||
{ cd? boolean }
|
|
||||||
{ tracks array } ;
|
|
||||||
|
|
||||||
ENUM: picture-type
|
|
||||||
other
|
|
||||||
file-icon
|
|
||||||
other-file-icon
|
|
||||||
front-cover
|
|
||||||
back-cover
|
|
||||||
leaflet-page
|
|
||||||
media
|
|
||||||
lead-artist/performer/soloist
|
|
||||||
artist/performer
|
|
||||||
conductor
|
|
||||||
band/orchestra
|
|
||||||
composer
|
|
||||||
lyricist/text-writer
|
|
||||||
recording-location
|
|
||||||
during-recording
|
|
||||||
during-performance
|
|
||||||
movie/video-screen-capture
|
|
||||||
bright-coloured-fish
|
|
||||||
illustration
|
|
||||||
badn/artist-logotype
|
|
||||||
publisher/studio-logotype ;
|
|
||||||
|
|
||||||
TUPLE: picture
|
|
||||||
type
|
|
||||||
{ mime-type string }
|
|
||||||
{ description string }
|
|
||||||
{ width integer }
|
|
||||||
{ height integer }
|
|
||||||
{ depth integer }
|
|
||||||
{ colors integer }
|
|
||||||
{ data byte-array } ;
|
|
||||||
|
|
||||||
TUPLE: metadata
|
|
||||||
{ stream-info stream-info }
|
|
||||||
{ padding maybe{ padding } }
|
|
||||||
{ application maybe{ application } }
|
|
||||||
{ seek-table maybe{ seek-table } }
|
|
||||||
{ vorbis-comment maybe{ vorbis-comment } }
|
|
||||||
{ cuesheet maybe{ cuesheet } }
|
|
||||||
{ picture maybe{ picture } } ;
|
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: read-flac-magic ( -- ? )
|
|
||||||
4 read utf8 decode FLAC-MAGIC = ;
|
|
||||||
|
|
||||||
:: (decode-metadata-block-header) ( bitstream -- header )
|
|
||||||
[
|
|
||||||
1 bitstream read-bit 1 =
|
|
||||||
7 bitstream read-bit <metadata-type>
|
|
||||||
24 bitstream read-bit
|
|
||||||
] with-big-endian
|
|
||||||
metadata-block-header boa ;
|
metadata-block-header boa ;
|
||||||
|
|
||||||
: decode-metadata-block-header ( byte-array -- header )
|
:: (decode-stream-info) ( bs -- stream-info )
|
||||||
bitstreams:<msb0-bit-reader> (decode-metadata-block-header) ;
|
16 bs bitstreams:read
|
||||||
|
16 bs bitstreams:read
|
||||||
: read-metadata-block-header ( -- header )
|
24 bs bitstreams:read
|
||||||
4 read decode-metadata-block-header ;
|
24 bs bitstreams:read
|
||||||
|
20 bs bitstreams:read
|
||||||
:: (decode-stream-info) ( bitstream -- stream-info )
|
3 bs bitstreams:read 1 +
|
||||||
[
|
5 bs bitstreams:read 1 +
|
||||||
16 bitstream read-bit
|
36 bs bitstreams:read
|
||||||
16 bitstream read-bit
|
128 bs bitstreams:read 16 >be bytes>hex-string
|
||||||
24 bitstream read-bit
|
|
||||||
24 bitstream read-bit
|
|
||||||
20 bitstream read-bit
|
|
||||||
3 bitstream read-bit 1 +
|
|
||||||
5 bitstream read-bit 1 +
|
|
||||||
36 bitstream read-bit
|
|
||||||
128 bitstream read-bit u128>byte-array bytes>hex-string
|
|
||||||
] with-big-endian
|
|
||||||
stream-info boa ;
|
stream-info boa ;
|
||||||
|
|
||||||
: decode-stream-info ( byte-array -- stream-info )
|
: decode-stream-info ( byte-array -- stream-info )
|
||||||
|
@ -164,41 +36,41 @@ TUPLE: metadata
|
||||||
binary
|
binary
|
||||||
[
|
[
|
||||||
length 18 / <iota>
|
length 18 / <iota>
|
||||||
[ drop 8 read be> 8 read be> 2 read be> seek-point boa ] map
|
[ drop 8 io:read be> 8 io:read be> 2 io:read be> seek-point boa ] map
|
||||||
] with-byte-reader
|
] with-byte-reader
|
||||||
seek-table boa ;
|
seek-table boa ;
|
||||||
|
|
||||||
: decode-vorbis-comment ( byte-array -- comments )
|
: decode-vorbis-comment ( byte-array -- comments )
|
||||||
binary
|
binary
|
||||||
[
|
[
|
||||||
4 read le> read utf8 decode
|
4 io:read le> io:read utf8 decode
|
||||||
4 read le> <iota> [
|
4 io:read le> <iota> [
|
||||||
drop
|
drop
|
||||||
4 read le> read utf8 decode
|
4 io:read le> io:read utf8 decode
|
||||||
"=" split
|
"=" split
|
||||||
] map
|
] map
|
||||||
] with-byte-reader >alist vorbis-comment boa ;
|
] with-byte-reader >alist vorbis-comment boa ;
|
||||||
|
|
||||||
: encode-vorbis-string ( str -- byte-array )
|
: encode-vorbis-string ( str -- byte-array )
|
||||||
dup binary [ length 4 >le write utf8 encode write ] with-byte-writer ;
|
dup binary [ length 4 >le io:write utf8 encode io:write ] with-byte-writer ;
|
||||||
|
|
||||||
: encode-vorbis-comments ( assoc -- byte-array )
|
: encode-vorbis-comments ( assoc -- byte-array )
|
||||||
dup binary [
|
dup binary [
|
||||||
length 4 >le write
|
length 4 >le io:write
|
||||||
[ 2array "=" join encode-vorbis-string write ] assoc-each
|
[ 2array "=" join encode-vorbis-string io:write ] assoc-each
|
||||||
] with-byte-writer ;
|
] with-byte-writer ;
|
||||||
|
|
||||||
: encode-vorbis-comment ( vorbis-comment -- byte-array )
|
: encode-vorbis-comment ( vorbis-comment -- byte-array )
|
||||||
binary [
|
binary [
|
||||||
[ vendor-string>> encode-vorbis-string write ]
|
[ vendor-string>> encode-vorbis-string io:write ]
|
||||||
[ comments>> encode-vorbis-comments write ] bi
|
[ comments>> encode-vorbis-comments io:write ] bi
|
||||||
] with-byte-writer ;
|
] with-byte-writer ;
|
||||||
|
|
||||||
: encode-padding ( padding -- byte-array )
|
: encode-padding ( padding -- byte-array )
|
||||||
length>> <byte-array> ;
|
length>> <byte-array> ;
|
||||||
|
|
||||||
: decode-padding ( byte-array -- padding )
|
: decode-padding ( byte-array -- padding )
|
||||||
length padding boa ;
|
length flac-padding boa ;
|
||||||
|
|
||||||
: decode-application ( byte-array -- application )
|
: decode-application ( byte-array -- application )
|
||||||
drop application new ;
|
drop application new ;
|
||||||
|
@ -206,74 +78,65 @@ TUPLE: metadata
|
||||||
: decode-cuesheet ( byte-array -- cuesheet )
|
: decode-cuesheet ( byte-array -- cuesheet )
|
||||||
binary
|
binary
|
||||||
[
|
[
|
||||||
128 read ascii decode
|
128 io:read ascii decode
|
||||||
8 read be>
|
8 io:read be>
|
||||||
259 read drop f
|
259 io:read drop f
|
||||||
1 read be> <iota> [
|
1 io:read be> <iota> [
|
||||||
drop
|
drop
|
||||||
8 read be>
|
8 io:read be>
|
||||||
1 read be>
|
1 io:read be>
|
||||||
12 read ascii decode
|
12 io:read ascii decode
|
||||||
21 read drop 0 <cuesheet-track-type> t
|
21 io:read drop 0 <cuesheet-track-type> t
|
||||||
1 read <iota> [
|
1 io:read <iota> [
|
||||||
drop
|
drop
|
||||||
8 read be>
|
8 io:read be>
|
||||||
1 read be>
|
1 io:read be>
|
||||||
3 read be> = 0 [ cuesheet-index-reserved-must-be-zero ] unless
|
3 io:read be> = 0 [ cuesheet-index-reserved-must-be-zero ] unless
|
||||||
cuesheet-index boa
|
cuesheet-index boa
|
||||||
] map
|
] map
|
||||||
cuesheet-track boa
|
cuesheet-track boa
|
||||||
] map
|
] map
|
||||||
] with-byte-reader cuesheet boa ;
|
] with-byte-reader cuesheet boa ;
|
||||||
|
|
||||||
: decode-picture ( byte-array -- picture )
|
: decode-picture ( byte-array -- picture )
|
||||||
binary
|
binary
|
||||||
[
|
[
|
||||||
4 read be> <picture-type>
|
4 io:read be> <picture-type>
|
||||||
4 read be> read utf8 decode
|
4 io:read be> io:read utf8 decode
|
||||||
4 read be> read utf8 decode
|
4 io:read be> io:read utf8 decode
|
||||||
4 read be>
|
4 io:read be>
|
||||||
4 read be>
|
4 io:read be>
|
||||||
4 read be>
|
4 io:read be>
|
||||||
4 read be>
|
4 io:read be>
|
||||||
4 read be> read
|
4 io:read be> io:read
|
||||||
] with-byte-reader picture boa ;
|
] with-byte-reader picture boa ;
|
||||||
|
|
||||||
: decode-metadata-block ( metadata byte-array type -- metadata )
|
: decode-metadata-block ( metadata byte-array type -- metadata )
|
||||||
{
|
|
||||||
{ 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 decode-stream-info ;
|
|
||||||
|
|
||||||
: skip-metadata ( -- )
|
|
||||||
[
|
[
|
||||||
|
{
|
||||||
|
{ 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
|
||||||
|
] with-big-endian ;
|
||||||
|
|
||||||
|
: read-flac-metadata ( -- metadata )
|
||||||
|
32 flac-read-uint FLAC-MAGIC = [ not-a-flac-file ] unless
|
||||||
|
metadata new
|
||||||
|
"HI" .
|
||||||
|
[
|
||||||
|
"HI" .
|
||||||
read-metadata-block-header
|
read-metadata-block-header
|
||||||
[ length>> read drop ] [ last?>> not ] bi
|
[ length>> io:read ] [ type>> ] [ last?>> not ] tri
|
||||||
|
[ decode-metadata-block ] dip
|
||||||
] loop ;
|
] loop ;
|
||||||
|
! metadata new
|
||||||
! TODO: handle other formats gracefully such as ID3
|
! [
|
||||||
: read-metadata ( filename -- metadata )
|
! read-metadata-block-header
|
||||||
binary
|
! [ length>> io:read ] [ type>> ] [ last?>> not ] tri
|
||||||
[
|
! [ decode-metadata-block ] dip
|
||||||
read-flac-magic [ not-a-flac-file ] unless
|
! ] loop ;
|
||||||
metadata new
|
|
||||||
[
|
|
||||||
read-metadata-block-header
|
|
||||||
[ length>> read ] [ type>> ] [ last?>> not ] tri
|
|
||||||
[ decode-metadata-block ] dip
|
|
||||||
] loop
|
|
||||||
] with-file-reader ;
|
|
||||||
|
|
||||||
: <flac-metadata> ( filename -- metadata )
|
|
||||||
read-metadata ;
|
|
||||||
|
|
Loading…
Reference in New Issue