working decoder?
parent
3ba96d3f44
commit
edaa3600cc
|
|
@ -1,4 +1,4 @@
|
|||
USING: kernel math math.order combinators combinators.extras generalizations math.bitwise accessors sequences ;
|
||||
USING: kernel math math.order combinators combinators.extras generalizations math.bitwise accessors sequences arrays ;
|
||||
USING: flac.format flac.stream ;
|
||||
USING: prettyprint ;
|
||||
|
||||
|
|
@ -82,11 +82,14 @@ SYMBOL: current-flac-output
|
|||
: read-flac-subframe-wasted-bits ( -- k )
|
||||
1 flac-read 1 = [ 0 [ 1 + 1 flac-read 0 = ] loop ] [ 0 ] if ;
|
||||
|
||||
: read-flac-subframe-constant ( blocksize bps wasted-bits -- constant-subframe )
|
||||
[ flac-read-int32 ] dip shift <repetition> [ ] map flac-subframe-constant boa ;
|
||||
: read-flac-subframe-constant ( blocksize bps -- samples )
|
||||
flac-read-int <repetition> [ ] map ;
|
||||
|
||||
: read-flac-subframe-verbatim ( blocksize bps wasted-bits -- verbatim-subframe )
|
||||
[ <repetition> ] dip swap [ flac-read-int32 swap shift ] with map flac-subframe-verbatim boa ;
|
||||
: read-flac-subframe-verbatim ( blocksize bps -- samples )
|
||||
<repetition> [ flac-read-int ] map ;
|
||||
|
||||
: adjust-wasted-bits ( wasted-bits samples -- samples' )
|
||||
[ swap shift ] with map! ;
|
||||
|
||||
: read-residual-coding-method-type ( -- coding-method param-bits param-escape )
|
||||
2 flac-read dup
|
||||
|
|
@ -94,32 +97,82 @@ SYMBOL: current-flac-output
|
|||
<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 )
|
||||
2drop 1 ;
|
||||
: read-partition-order/count ( -- partition-order partitions )
|
||||
4 flac-read dup 2^ ;
|
||||
|
||||
:: flac-read-residuals ( blocksize -- sequence )
|
||||
read-residual-coding-method-type :> ( coding-type param-bits param-escape )
|
||||
1 ;
|
||||
! TODO: even with locals this is pretty gnarly
|
||||
:: read-residuals ( blocksize predictor-order -- residuals )
|
||||
read-residual-coding-method-type :> ( coding-type parameter-bits escape-parameter )
|
||||
read-partition-order/count :> ( partition-order partitions )
|
||||
blocksize partition-order neg shift :> partition-samples
|
||||
{ } :> residuals!
|
||||
|
||||
: read-flac-subframe-warmup-samples ( bps order -- seq )
|
||||
<repetition> [ flac-read-int32 ] map ;
|
||||
partitions <iota>
|
||||
[| partition |
|
||||
parameter-bits flac-read :> rice-parameter
|
||||
rice-parameter escape-parameter <
|
||||
[
|
||||
partition 0 = [ partition-samples predictor-order - ] [ partition-samples ] if <iota>
|
||||
[ drop residuals rice-parameter flac-read-rice-signed-int suffix residuals! ] each
|
||||
]
|
||||
[
|
||||
5 flac-read :> num-bits
|
||||
partition-samples partition 0 = [ predictor-order ] [ 0 ] if - <iota>
|
||||
[| order |
|
||||
residuals num-bits 0 = [ 0 suffix ] [ num-bits flac-read-int suffix ] if residuals!
|
||||
] each
|
||||
] if
|
||||
] each
|
||||
residuals ;
|
||||
|
||||
:: 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
|
||||
: fixed-coefficients ( -- coefficients ) { { } { 1 } { 2 -1 } { 3 -3 1 } { 4 -6 4 1 } } ;
|
||||
|
||||
! 2dup [ read-flac-subframe-warmup-samples ] [ flac-read-residuals ] 2bi*
|
||||
! flac-subframe-fixed boa ;
|
||||
: read-warmup-samples ( sample-depth order -- samples )
|
||||
swap <repetition> [ flac-read-int ] map ;
|
||||
|
||||
: read-flac-subframe-qlp-coeff-precision ( -- precision )
|
||||
4 flac-read 1 + ;
|
||||
! TODO: even with locals this is also gnarly
|
||||
:: restore-linear-prediction ( residuals warmup coefficients quantization-level -- samples )
|
||||
coefficients length :> order
|
||||
residuals warmup
|
||||
[| samples residual |
|
||||
samples
|
||||
|
||||
: read-flac-qlp-shift ( -- quantization-level )
|
||||
residual
|
||||
|
||||
coefficients
|
||||
samples order tail*
|
||||
0
|
||||
[ * + ] 2reduce
|
||||
|
||||
quantization-level neg shift
|
||||
+
|
||||
|
||||
suffix
|
||||
|
||||
] reduce ;
|
||||
|
||||
:: read-flac-subframe-fixed ( blocksize sample-depth order -- samples )
|
||||
sample-depth order read-warmup-samples :> warmup
|
||||
blocksize order read-residuals :> residuals
|
||||
order fixed-coefficients nth :> coefficients
|
||||
residuals warmup coefficients 0 restore-linear-prediction ;
|
||||
|
||||
: read-qlp-shift ( -- quantization-level )
|
||||
5 flac-read ;
|
||||
|
||||
: read-flac-qlp-coeff ( subframe-header coeff-precision -- seq )
|
||||
[ predictor-order>> ] dip <repetition> [ flac-read ] map ;
|
||||
: read-qlp-coefficient-precision ( -- precision )
|
||||
4 flac-read 1 + ;
|
||||
|
||||
: read-lpc-coefficients ( order precision -- coefficients )
|
||||
<repetition> [ flac-read-int ] map ;
|
||||
|
||||
:: read-flac-subframe-lpc ( blocksize sample-depth order -- samples )
|
||||
sample-depth order read-warmup-samples :> warmup
|
||||
read-qlp-coefficient-precision :> precision
|
||||
read-qlp-shift :> qlp-shift
|
||||
order precision read-lpc-coefficients reverse :> coefficients
|
||||
blocksize order read-residuals :> residuals
|
||||
residuals warmup coefficients qlp-shift restore-linear-prediction ;
|
||||
|
||||
! 000000 constant
|
||||
! 000001 verbatim
|
||||
|
|
@ -131,10 +184,10 @@ SYMBOL: current-flac-output
|
|||
: read-flac-subframe-type ( -- subframe-type order )
|
||||
6 flac-read dup
|
||||
{
|
||||
{ [ 0b0000 = ] [ drop f subframe-type-constant ] }
|
||||
{ [ 0b0001 = ] [ drop f subframe-type-verbatim ] }
|
||||
{ [ 0b1000 0b1100 between? ] [ 3 clear-bit subframe-type-fixed ] }
|
||||
{ [ 0b100000 0b111111 between? ] [ 5 clear-bit 1 + subframe-type-lpc ] }
|
||||
{ [ 0b000000 = ] [ drop f subframe-type-constant ] }
|
||||
{ [ 0b000001 = ] [ drop f subframe-type-verbatim ] }
|
||||
{ [ 0b001000 0b001111 between? ] [ 2 0 bit-range subframe-type-fixed ] }
|
||||
{ [ 0b100000 0b111111 between? ] [ 4 0 bit-range 1 + subframe-type-lpc ] }
|
||||
[ drop reserved-subframe-type ]
|
||||
} cond-case swap ;
|
||||
|
||||
|
|
@ -147,7 +200,7 @@ SYMBOL: current-flac-output
|
|||
read-flac-subframe-wasted-bits
|
||||
flac-subframe-header boa ;
|
||||
|
||||
: calculate-bits-per-sample ( bps wasted-bits subframe-type channel -- bps' )
|
||||
: calculate-sample-depth ( bps channel-assignment wasted-bits channel -- sample-depth )
|
||||
[ - ] 2dip swap
|
||||
{
|
||||
{ channel-assignment-left [ 1 = [ 1 ] [ 0 ] if ] }
|
||||
|
|
@ -156,31 +209,58 @@ SYMBOL: current-flac-output
|
|||
[ 2drop 0 ]
|
||||
} case + ;
|
||||
|
||||
:: read-flac-subframe ( frame-header channel -- subframe )
|
||||
: stereo-decorrelation ( samples channel-assignment -- samples' )
|
||||
{
|
||||
{ channel-assignment-independent [ ] } ! do nothing
|
||||
{
|
||||
channel-assignment-left
|
||||
[ [ first ] [ first ] [ second ] tri [ - ] 2map 2array ]
|
||||
}
|
||||
{
|
||||
channel-assignment-right
|
||||
[ [ second ] [ first ] [ second ] tri [ + ] 2map swap 2array ]
|
||||
}
|
||||
{
|
||||
channel-assignment-mid
|
||||
[
|
||||
[ first ] [ second ] bi
|
||||
{ { } { } }
|
||||
[ [ over ] dip [ [ first ] dip suffix ] [ [ second ] dip suffix ] 2bi* 2array ] 2reduce
|
||||
]
|
||||
}
|
||||
} case ;
|
||||
|
||||
:: read-flac-subframe ( frame-header channel -- samples )
|
||||
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
|
||||
subframe-header predictor-order>> :> predictor-order
|
||||
frame-header bits-per-sample>> :> bps
|
||||
frame-header blocksize>> :> blocksize
|
||||
frame-header channel-assignment>> :> channel-assignment
|
||||
bps channel-assignment wasted-bits channel calculate-sample-depth :> sample-depth
|
||||
|
||||
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
|
||||
subframe-header swap flac-subframe boa ;
|
||||
{ subframe-type-constant [ blocksize sample-depth read-flac-subframe-constant ] }
|
||||
{ subframe-type-verbatim [ blocksize sample-depth read-flac-subframe-verbatim ] }
|
||||
{ subframe-type-fixed [ blocksize sample-depth predictor-order read-flac-subframe-fixed ] }
|
||||
{ subframe-type-lpc [ blocksize sample-depth predictor-order read-flac-subframe-lpc ] }
|
||||
} case :> samples!
|
||||
|
||||
: read-flac-subframes ( stream-info frame-header -- seq )
|
||||
[ channels>> ] dip swap <iota> [ read-flac-subframe ] with map ;
|
||||
wasted-bits samples adjust-wasted-bits ;
|
||||
|
||||
: read-flac-subframes ( frame-header channels -- samples )
|
||||
[ dup channel-assignment>> swap ] dip
|
||||
<iota> [ read-flac-subframe ] with map
|
||||
swap stereo-decorrelation ;
|
||||
!
|
||||
: read-flac-frame-footer ( -- frame-footer )
|
||||
16 flac-read flac-frame-footer boa ;
|
||||
16 flac-read flac-frame-footer boa ;
|
||||
|
||||
: read-flac-frame ( stream-info -- frame )
|
||||
[ read-flac-frame-header ] keep swap
|
||||
[ read-flac-subframes ] keep swap
|
||||
[ read-flac-frame-header dup ] [ channels>> ] bi
|
||||
read-flac-subframes
|
||||
flac-align-to-byte
|
||||
read-flac-frame-footer
|
||||
flac-frame boa ;
|
||||
|
|
|
|||
|
|
@ -68,12 +68,11 @@ ENUM: flac-entropy-coding-method-type
|
|||
|
||||
TUPLE: flac-entropy-coding-method-partitioned-rice-contents
|
||||
{ parameters sequence }
|
||||
{ raw-bits sequence }
|
||||
{ capacity-by-order integer } ;
|
||||
{ raw-bits sequence } ;
|
||||
|
||||
TUPLE: flac-entropy-coding-method-partitioned-rice
|
||||
{ order integer }
|
||||
{ contents sequence } ;
|
||||
{ contents flac-entropy-coding-method-partitioned-rice-contents } ;
|
||||
|
||||
TUPLE: flac-entropy-coding-method
|
||||
{ type maybe{ entropy-coding-partitioned-rice
|
||||
|
|
@ -99,8 +98,7 @@ TUPLE: flac-subframe-lpc
|
|||
{ quantization-level integer }
|
||||
{ qlp-coeff sequence }
|
||||
{ warmup sequence }
|
||||
{ residual sequence }
|
||||
{ value sequence } ;
|
||||
{ residual sequence } ;
|
||||
|
||||
TUPLE: flac-subframe-header
|
||||
{ subframe-type maybe{ subframe-type-constant
|
||||
|
|
@ -122,7 +120,7 @@ TUPLE: flac-frame-footer
|
|||
|
||||
TUPLE: flac-frame
|
||||
{ header flac-frame-header }
|
||||
{ subframes sequence }
|
||||
{ samples sequence }
|
||||
{ footer flac-frame-footer } ;
|
||||
|
||||
ENUM: metadata-type
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ FROM: flac.format => FLAC-MAGIC not-a-flac-stream ;
|
|||
QUALIFIED: bitstreams
|
||||
QUALIFIED: io
|
||||
|
||||
USING: prettyprint ;
|
||||
IN: flac.stream
|
||||
|
||||
SYMBOL: flac-input-stream
|
||||
|
|
@ -24,16 +25,16 @@ M: flac-stream-reader dispose stream>> dispose ;
|
|||
dup bytes>> swap [ prepend ] dip swap >>bytes drop
|
||||
] while flac-input-stream get bitstream>> bitstreams:read ;
|
||||
|
||||
: >32int ( x -- x' )
|
||||
32 >signed ;
|
||||
: flac-align-to-byte ( -- )
|
||||
8 flac-input-stream get bitstream>> bitstreams:align ;
|
||||
|
||||
: flac-read-int32 ( n -- m )
|
||||
flac-read >32int ;
|
||||
: flac-read-int ( n -- m )
|
||||
dup flac-read swap >signed ;
|
||||
|
||||
: flac-read-rice-signed-int ( param -- n )
|
||||
[ 0 [ 1 flac-read 0 = ] [ 1 + ] do while ] dip
|
||||
[ 0 [ 1 flac-read 0 = ] [ 1 + ] while ] dip
|
||||
[ shift ] keep flac-read bitor
|
||||
[ -1 shift ] [ 1 bitand -1 * ] bi ^ ;
|
||||
[ -1 shift ] [ 1 bitand -1 * ] bi bitxor ;
|
||||
|
||||
: flac-read-coded-number ( -- n )
|
||||
8 flac-read
|
||||
|
|
|
|||
Loading…
Reference in New Issue