Compare commits
2 Commits
3246b2c064
...
13439f6e24
Author | SHA1 | Date |
---|---|---|
|
13439f6e24 | |
|
f2402fa759 |
|
@ -200,7 +200,7 @@ SYMBOL: current-flac-output
|
||||||
read-flac-subframe-wasted-bits
|
read-flac-subframe-wasted-bits
|
||||||
flac-subframe-header boa ;
|
flac-subframe-header boa ;
|
||||||
|
|
||||||
: calculate-sample-depth ( bps channel-assignment wasted-bits channel -- sample-depth )
|
: calculate-sample-depth ( bps wasted-bits channel-assignment channel -- sample-depth )
|
||||||
[ - ] 2dip swap
|
[ - ] 2dip swap
|
||||||
{
|
{
|
||||||
{ channel-assignment-left [ 1 = [ 1 ] [ 0 ] if ] }
|
{ channel-assignment-left [ 1 = [ 1 ] [ 0 ] if ] }
|
||||||
|
@ -238,7 +238,7 @@ SYMBOL: current-flac-output
|
||||||
frame-header bits-per-sample>> :> bps
|
frame-header bits-per-sample>> :> bps
|
||||||
frame-header blocksize>> :> blocksize
|
frame-header blocksize>> :> blocksize
|
||||||
frame-header channel-assignment>> :> channel-assignment
|
frame-header channel-assignment>> :> channel-assignment
|
||||||
bps channel-assignment wasted-bits channel calculate-sample-depth :> sample-depth
|
bps wasted-bits channel-assignment channel calculate-sample-depth :> sample-depth
|
||||||
|
|
||||||
subframe-type
|
subframe-type
|
||||||
{
|
{
|
||||||
|
|
|
@ -0,0 +1,49 @@
|
||||||
|
USING: kernel audio.wav io io.files io.encodings.ascii io.encodings.binary io.encodings.string endian accessors math sequences ;
|
||||||
|
USING: flac.decoder flac.stream flac.metadata ;
|
||||||
|
|
||||||
|
USING: specialized-arrays alien.c-types prettyprint io.encodings.utf8 ;
|
||||||
|
|
||||||
|
IN: flac
|
||||||
|
|
||||||
|
:: wav-header ( stream-info -- byte-array )
|
||||||
|
RIFF-MAGIC ascii encode
|
||||||
|
stream-info samples>> stream-info channels>> stream-info bits-per-sample>> 8 /i * * 36 + 4 >le
|
||||||
|
WAVE-MAGIC ascii encode
|
||||||
|
FMT-MAGIC ascii encode
|
||||||
|
16 4 >le
|
||||||
|
1 2 >le
|
||||||
|
stream-info channels>> 2 >le
|
||||||
|
stream-info sample-rate>> 4 >le
|
||||||
|
stream-info sample-rate>> stream-info channels>> stream-info bits-per-sample>> 8 /i * * 4 >le
|
||||||
|
stream-info channels>> stream-info bits-per-sample>> 8 /i * 2 >le
|
||||||
|
stream-info bits-per-sample>> 2 >le
|
||||||
|
DATA-MAGIC ascii encode
|
||||||
|
stream-info samples>> stream-info channels>> stream-info bits-per-sample>> 8 /i * * 4 >le
|
||||||
|
'{ _ _ _ _ _ _ _ _ _ _ _ _ _ } B{ } concat-as ;
|
||||||
|
|
||||||
|
:: write-frame ( sample-depth channels blocksize samples -- )
|
||||||
|
sample-depth 8 /i :> sample-bytes
|
||||||
|
sample-depth 8 = [ 128 ] [ 0 ] if :> addend
|
||||||
|
blocksize <iota> [| block |
|
||||||
|
channels <iota> [| channel |
|
||||||
|
block channel samples nth nth addend + sample-bytes >le write
|
||||||
|
] each
|
||||||
|
] each ;
|
||||||
|
|
||||||
|
! TODO: actually write good code
|
||||||
|
: decode-file ( flac-file -- )
|
||||||
|
[
|
||||||
|
"/home/steve/FACTOR.wav" binary [
|
||||||
|
read-stream-info/seek-data
|
||||||
|
dup
|
||||||
|
[ wav-header write ]
|
||||||
|
[ samples>> ] bi
|
||||||
|
swap <repetition>
|
||||||
|
[
|
||||||
|
[ [ bits-per-sample>> ] [ channels>> ] bi ]
|
||||||
|
[ read-flac-frame ] bi
|
||||||
|
[ header>> blocksize>> ] [ samples>> ] bi
|
||||||
|
write-frame
|
||||||
|
] each
|
||||||
|
] with-file-writer
|
||||||
|
] with-flac-file-reader ;
|
|
@ -40,11 +40,11 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
|
||||||
: 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 4 >le be> dup 8 * flac-read swap >n-byte-array utf8 decode
|
32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array reverse utf8 decode
|
||||||
32 flac-read 4 >le be> <iota>
|
32 flac-read 4 >le be> <iota>
|
||||||
[
|
[
|
||||||
drop
|
drop
|
||||||
32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array utf8 decode
|
32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array reverse utf8 decode
|
||||||
"=" split
|
"=" split
|
||||||
] map
|
] map
|
||||||
>alist vorbis-comment boa ;
|
>alist vorbis-comment boa ;
|
||||||
|
@ -100,17 +100,18 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
|
||||||
: read-metadata-block-picture ( length -- picture )
|
: read-metadata-block-picture ( length -- picture )
|
||||||
drop
|
drop
|
||||||
32 flac-read <picture-type>
|
32 flac-read <picture-type>
|
||||||
32 flac-read dup 8 * flac-read swap >n-byte-array utf8 decode
|
32 flac-read dup 8 * flac-read swap >n-byte-array reverse utf8 decode
|
||||||
32 flac-read dup 8 * flac-read swap >n-byte-array utf8 decode
|
32 flac-read dup 8 * flac-read swap >n-byte-array reverse utf8 decode
|
||||||
32 flac-read
|
32 flac-read
|
||||||
32 flac-read
|
32 flac-read
|
||||||
32 flac-read
|
32 flac-read
|
||||||
32 flac-read
|
32 flac-read
|
||||||
32 flac-read dup 8 * flac-read swap >n-byte-array
|
32 flac-read dup 8 *
|
||||||
|
32 flac-read dup 8 * flac-read swap >n-byte-array reverse
|
||||||
picture boa ;
|
picture boa ;
|
||||||
|
|
||||||
: append-picture ( metadata picture -- metadata )
|
: append-picture ( metadata picture -- metadata )
|
||||||
[ dup picture>> ] dip 1array append >>picture ;
|
[ dup picture>> ] dip suffix >>picture ;
|
||||||
|
|
||||||
: read-metadata-block ( metadata length type -- metadata )
|
: read-metadata-block ( metadata length type -- metadata )
|
||||||
[
|
[
|
||||||
|
@ -136,6 +137,12 @@ PRIVATE>
|
||||||
[ read-metadata-block ] dip
|
[ read-metadata-block ] dip
|
||||||
] loop ;
|
] loop ;
|
||||||
|
|
||||||
|
: read-stream-info/seek-data ( -- stream-info )
|
||||||
|
read/assert-flac-magic
|
||||||
|
32 flac-read drop
|
||||||
|
read-metadata-block-stream-info
|
||||||
|
[ read-metadata-block-header [ length>> 8 * flac-seek ] [ last?>> not ] bi ] loop ;
|
||||||
|
|
||||||
: <flac-stream-info> ( filename -- stream-info )
|
: <flac-stream-info> ( filename -- stream-info )
|
||||||
[
|
[
|
||||||
read/assert-flac-magic
|
read/assert-flac-magic
|
||||||
|
@ -143,6 +150,7 @@ PRIVATE>
|
||||||
read-metadata-block-stream-info
|
read-metadata-block-stream-info
|
||||||
] with-flac-file-reader ;
|
] with-flac-file-reader ;
|
||||||
|
|
||||||
|
! TODO: write these
|
||||||
! : <flac-tags> ( filename -- tags )
|
! : <flac-tags> ( filename -- tags )
|
||||||
! [
|
! [
|
||||||
! read/assert-flac-magic
|
! read/assert-flac-magic
|
||||||
|
@ -161,6 +169,5 @@ PRIVATE>
|
||||||
! ] produce nip sift
|
! ] produce nip sift
|
||||||
! ] with-flac-file-reader ;
|
! ] with-flac-file-reader ;
|
||||||
|
|
||||||
|
|
||||||
: <flac-metadata> ( filename -- metadata )
|
: <flac-metadata> ( filename -- metadata )
|
||||||
[ read-flac-metadata ] with-flac-file-reader ;
|
[ read-flac-metadata ] with-flac-file-reader ;
|
||||||
|
|
|
@ -1,14 +1,13 @@
|
||||||
USING: kernel namespaces accessors sequences destructors io.files io.encodings.binary math math.functions math.bitwise ;
|
USING: kernel namespaces accessors sequences destructors io io.files io.encodings.binary math math.functions math.bitwise ;
|
||||||
FROM: flac.format => FLAC-MAGIC not-a-flac-stream ;
|
FROM: flac.format => FLAC-MAGIC not-a-flac-stream ;
|
||||||
QUALIFIED: bitstreams
|
QUALIFIED: bitstreams
|
||||||
QUALIFIED: io
|
QUALIFIED: io
|
||||||
|
|
||||||
USING: prettyprint ;
|
|
||||||
IN: flac.stream
|
IN: flac.stream
|
||||||
|
|
||||||
SYMBOL: flac-input-stream
|
SYMBOL: flac-input-stream
|
||||||
|
|
||||||
CONSTANT: default-bitreader-capacity 65536
|
CONSTANT: default-bitreader-capacity 6553600
|
||||||
|
|
||||||
TUPLE: flac-stream-reader stream bitstream ;
|
TUPLE: flac-stream-reader stream bitstream ;
|
||||||
|
|
||||||
|
@ -25,6 +24,14 @@ M: flac-stream-reader dispose stream>> dispose ;
|
||||||
dup bytes>> swap [ prepend ] dip swap >>bytes drop
|
dup bytes>> swap [ prepend ] dip swap >>bytes drop
|
||||||
] while flac-input-stream get bitstream>> bitstreams:read ;
|
] while flac-input-stream get bitstream>> bitstreams:read ;
|
||||||
|
|
||||||
|
: flac-seek ( 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:seek ;
|
||||||
|
|
||||||
: flac-align-to-byte ( -- )
|
: flac-align-to-byte ( -- )
|
||||||
8 flac-input-stream get bitstream>> bitstreams:align ;
|
8 flac-input-stream get bitstream>> bitstreams:align ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue