wip
parent
77d5b75257
commit
440365c072
|
@ -1,19 +1,39 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg
|
||||
! 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
|
||||
|
||||
TUPLE: flac-bitstream < disposable
|
||||
stream ;
|
||||
SYMBOL: flac-input-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-bitstream new
|
||||
swap >>path ;
|
||||
: <flac-stream-reader> ( path -- flac-stream-reader )
|
||||
binary <file-reader> B{ } bitstreams:<msb0-bit-reader> flac-stream-reader boa ;
|
||||
|
||||
: with-flac-bitstream ( flac-bitstream quot -- )
|
||||
[ open-flac-bitstream ] dip with-stream ; inline
|
||||
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>> 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 .
|
||||
! 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: flac.metadata.private flac.metadata flac.format ;
|
||||
|
||||
QUALIFIED: bitstreams
|
||||
USING: flac.bitstream flac.metadata.private flac.format ;
|
||||
|
||||
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 ;
|
||||
|
@ -19,6 +14,9 @@ ERROR: invalid-sample-rate ;
|
|||
ERROR: reserved-subframe-type ;
|
||||
ERROR: invalid-subframe-sync ;
|
||||
|
||||
: read-flac-magic ( -- ? )
|
||||
32 flac-read-uint FLAC-MAGIC = ;
|
||||
|
||||
: 0xxxxxxx? ( n -- ? ) 0x80 mask? not ;
|
||||
: 110xxxxx? ( n -- ? ) [ 0xc0 mask? ] [ 0x20 mask? not ] bi and ;
|
||||
: 1110xxxx? ( n -- ? ) [ 0xe0 mask? ] [ 0x10 mask? not ] bi and ;
|
||||
|
@ -37,20 +35,20 @@ ERROR: invalid-subframe-sync ;
|
|||
{ [ 11111110? ] [ 6 ] }
|
||||
} cond-case ;
|
||||
|
||||
:: decode-utf8-uint ( frame-length bitstream -- n )
|
||||
frame-length 7 -
|
||||
bitstream read-bit
|
||||
frame-length <iota> [
|
||||
drop
|
||||
2 bitstream read-bit drop
|
||||
6 shift 6 bitstream read-bit bitor
|
||||
] each ;
|
||||
! :: decode-utf8-uint ( frame-length bitstream -- n )
|
||||
! frame-length 7 -
|
||||
! bitstream read-bit
|
||||
! frame-length <iota> [
|
||||
! drop
|
||||
! 2 bitstream read-bit drop
|
||||
! 6 shift 6 bitstream read-bit bitor
|
||||
! ] each ;
|
||||
|
||||
: read-utf8-uint ( -- n )
|
||||
1 read dup
|
||||
be> 0xxxxxxx?
|
||||
[ be> ]
|
||||
[ dup be> remaining-bytes read B{ } append-as be> ] if ;
|
||||
! : read-utf8-uint ( -- n )
|
||||
! 1 read dup
|
||||
! be> 0xxxxxxx?
|
||||
! [ be> ]
|
||||
! [ dup be> remaining-bytes read B{ } append-as be> ] if ;
|
||||
|
||||
: decode-block-size ( n -- n )
|
||||
dup
|
||||
|
@ -88,9 +86,9 @@ ERROR: invalid-subframe-sync ;
|
|||
{ 0b1001 [ 44100 ] }
|
||||
{ 0b1010 [ 48000 ] }
|
||||
{ 0b1011 [ 96000 ] }
|
||||
{ 0b1100 [ 1 read be> 1000 * ] }
|
||||
{ 0b1101 [ 2 read be> ] }
|
||||
{ 0b1110 [ 2 read be> 10 * ] }
|
||||
{ 0b1100 [ 8 flac-read-uint 1000 * ] }
|
||||
{ 0b1101 [ 16 flac-read-uint ] }
|
||||
{ 0b1110 [ 16 flac-read-uint 10 * ] }
|
||||
{ 0b1111 [ invalid-sample-rate ] }
|
||||
} case ;
|
||||
|
||||
|
@ -103,93 +101,98 @@ ERROR: invalid-subframe-sync ;
|
|||
} cond swap
|
||||
<flac-channel-assignment> ;
|
||||
|
||||
:: decode-header ( bitstream -- frame-header )
|
||||
[
|
||||
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
|
||||
flac-frame-header boa ;
|
||||
! :: decode-header ( bitstream -- frame-header )
|
||||
! [
|
||||
! 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
|
||||
! 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 )
|
||||
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-file ( filename -- flac-stream )
|
||||
[
|
||||
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 ;
|
||||
] with-flac-stream-reader ;
|
||||
|
|
|
@ -1,9 +1,11 @@
|
|||
! Copyright (C) 2020 .
|
||||
! 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
|
||||
|
||||
CONSTANT: FLAC-MAGIC 0x664c6143 ! fLaC
|
||||
|
||||
CONSTANT: MIN-BLOCK-SIZE 16
|
||||
CONSTANT: MAX-BLOCK-SIZE 65535
|
||||
CONSTANT: MAX-SAMPLE-SIZE: 4608
|
||||
|
@ -17,6 +19,7 @@ CONSTANT: MAX-QLP-COEEF-PRECISION 15
|
|||
CONSTANT: MAX-FIXED-ORDER 4
|
||||
CONSTANT: MAX-RICE-PARTITION-ORDER 15
|
||||
|
||||
ERROR: not-a-flac-file ;
|
||||
|
||||
ENUM: flac-frame-number-type
|
||||
frame-number-type-frame
|
||||
|
@ -122,3 +125,115 @@ TUPLE: flac-frame
|
|||
{ header flac-frame-header }
|
||||
{ subframes sequence }
|
||||
{ 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 .
|
||||
! 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: io
|
||||
|
||||
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 ;
|
||||
|
||||
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: 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
|
||||
: read-metadata-block-header ( -- header )
|
||||
1 flac-read-uint 1 =
|
||||
7 flac-read-uint <metadata-type>
|
||||
24 flac-read-uint
|
||||
metadata-block-header boa ;
|
||||
|
||||
: decode-metadata-block-header ( byte-array -- header )
|
||||
bitstreams:<msb0-bit-reader> (decode-metadata-block-header) ;
|
||||
|
||||
: read-metadata-block-header ( -- header )
|
||||
4 read decode-metadata-block-header ;
|
||||
|
||||
:: (decode-stream-info) ( bitstream -- stream-info )
|
||||
[
|
||||
16 bitstream read-bit
|
||||
16 bitstream read-bit
|
||||
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
|
||||
:: (decode-stream-info) ( bs -- stream-info )
|
||||
16 bs bitstreams:read
|
||||
16 bs bitstreams:read
|
||||
24 bs bitstreams:read
|
||||
24 bs bitstreams:read
|
||||
20 bs bitstreams:read
|
||||
3 bs bitstreams:read 1 +
|
||||
5 bs bitstreams:read 1 +
|
||||
36 bs bitstreams:read
|
||||
128 bs bitstreams:read 16 >be bytes>hex-string
|
||||
stream-info boa ;
|
||||
|
||||
: decode-stream-info ( byte-array -- stream-info )
|
||||
|
@ -164,41 +36,41 @@ TUPLE: metadata
|
|||
binary
|
||||
[
|
||||
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
|
||||
seek-table boa ;
|
||||
|
||||
: decode-vorbis-comment ( byte-array -- comments )
|
||||
binary
|
||||
[
|
||||
4 read le> read utf8 decode
|
||||
4 read le> <iota> [
|
||||
4 io:read le> io:read utf8 decode
|
||||
4 io:read le> <iota> [
|
||||
drop
|
||||
4 read le> read utf8 decode
|
||||
4 io:read le> io:read utf8 decode
|
||||
"=" split
|
||||
] map
|
||||
] with-byte-reader >alist vorbis-comment boa ;
|
||||
|
||||
: 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 )
|
||||
dup binary [
|
||||
length 4 >le write
|
||||
[ 2array "=" join encode-vorbis-string write ] assoc-each
|
||||
length 4 >le io:write
|
||||
[ 2array "=" join encode-vorbis-string io: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
|
||||
[ vendor-string>> encode-vorbis-string io:write ]
|
||||
[ comments>> encode-vorbis-comments io:write ] bi
|
||||
] with-byte-writer ;
|
||||
|
||||
: encode-padding ( padding -- byte-array )
|
||||
length>> <byte-array> ;
|
||||
|
||||
: decode-padding ( byte-array -- padding )
|
||||
length padding boa ;
|
||||
length flac-padding boa ;
|
||||
|
||||
: decode-application ( byte-array -- application )
|
||||
drop application new ;
|
||||
|
@ -206,74 +78,65 @@ TUPLE: metadata
|
|||
: decode-cuesheet ( byte-array -- cuesheet )
|
||||
binary
|
||||
[
|
||||
128 read ascii decode
|
||||
8 read be>
|
||||
259 read drop f
|
||||
1 read be> <iota> [
|
||||
drop
|
||||
8 read be>
|
||||
1 read be>
|
||||
12 read ascii decode
|
||||
21 read drop 0 <cuesheet-track-type> t
|
||||
1 read <iota> [
|
||||
drop
|
||||
8 read be>
|
||||
1 read be>
|
||||
3 read be> = 0 [ cuesheet-index-reserved-must-be-zero ] unless
|
||||
cuesheet-index boa
|
||||
] map
|
||||
cuesheet-track boa
|
||||
128 io:read ascii decode
|
||||
8 io:read be>
|
||||
259 io:read drop f
|
||||
1 io:read be> <iota> [
|
||||
drop
|
||||
8 io:read be>
|
||||
1 io:read be>
|
||||
12 io:read ascii decode
|
||||
21 io:read drop 0 <cuesheet-track-type> t
|
||||
1 io:read <iota> [
|
||||
drop
|
||||
8 io:read be>
|
||||
1 io:read be>
|
||||
3 io:read be> = 0 [ cuesheet-index-reserved-must-be-zero ] unless
|
||||
cuesheet-index boa
|
||||
] map
|
||||
cuesheet-track boa
|
||||
] map
|
||||
] with-byte-reader cuesheet boa ;
|
||||
|
||||
: decode-picture ( byte-array -- picture )
|
||||
binary
|
||||
[
|
||||
4 read be> <picture-type>
|
||||
4 read be> read utf8 decode
|
||||
4 read be> read utf8 decode
|
||||
4 read be>
|
||||
4 read be>
|
||||
4 read be>
|
||||
4 read be>
|
||||
4 read be> read
|
||||
4 io:read be> <picture-type>
|
||||
4 io:read be> io:read utf8 decode
|
||||
4 io:read be> io:read utf8 decode
|
||||
4 io:read be>
|
||||
4 io:read be>
|
||||
4 io:read be>
|
||||
4 io:read be>
|
||||
4 io:read be> io:read
|
||||
] with-byte-reader picture boa ;
|
||||
|
||||
: 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
|
||||
[ length>> read drop ] [ last?>> not ] bi
|
||||
[ length>> io:read ] [ type>> ] [ last?>> not ] tri
|
||||
[ decode-metadata-block ] dip
|
||||
] loop ;
|
||||
|
||||
! TODO: handle other formats gracefully such as ID3
|
||||
: read-metadata ( filename -- metadata )
|
||||
binary
|
||||
[
|
||||
read-flac-magic [ not-a-flac-file ] unless
|
||||
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 ;
|
||||
! metadata new
|
||||
! [
|
||||
! read-metadata-block-header
|
||||
! [ length>> io:read ] [ type>> ] [ last?>> not ] tri
|
||||
! [ decode-metadata-block ] dip
|
||||
! ] loop ;
|
||||
|
|
Loading…
Reference in New Issue