flac.factor

! 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 ;
QUALIFIED: bitstreams

IN: flac

ALIAS: read-bit bitstreams:read

CONSTANT: FLAC-MAGIC "fLaC"

ERROR: not-a-flac-file ;

TUPLE: metadata-block-header
    { last? boolean }
    { type integer }
    { 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: metadata
    { stream-info stream-info }
    { seek-table maybe{ seek-table } } ;

TUPLE: vorbis-comment
    { vendor-string string }
    { comments assoc } ;

: read-flac-magic ( -- magic )
    4 read utf8 decode FLAC-MAGIC = ;

:: parse-metadata-block-header ( bitstream -- header )
    [
        1 bitstream read-bit 1 = 
        7 bitstream read-bit
        24 bitstream read-bit
    ] with-big-endian
    metadata-block-header boa ;

: read-metadata-block-header ( -- header )
    4 read bitstreams:<msb0-bit-reader>
    parse-metadata-block-header ;

:: parse-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
    stream-info boa ;

: parse-seek-table ( byte-array -- seek-table )
    dup
    binary
    [
        length 18 / <iota>
        [ drop 8 read be> 8 read be> 2 read be> seek-point boa ] map
    ] with-byte-reader
    seek-table boa ;

: parse-vorbis-comment ( byte-array -- comments )
    binary
    [
        4 read le> read utf8 decode
        4 read le>
        <iota>
        [
            drop
            4 read le> read utf8 decode
            "=" split
        ] map
    ] with-byte-reader >alist vorbis-comment boa ;

: read-metadata-block ( header -- stream-info )
    dup type>>
    {
        { 0 [ length>> read bitstreams:<msb0-bit-reader> parse-stream-info ] }
        { 1 [ length>> read ] }
        { 2 [ length>> read ] }
        { 3 [ length>> read parse-seek-table ] }
        { 4 [ length>> read parse-vorbis-comment ] }
        { 5 [ length>> read ] }
        { 6 [ length>> read ] }
    } case ;

: read-metadata ( filename -- metadata )
    binary
    [
        read-flac-magic [ not-a-flac-file ] unless
        [ read-metadata-block-header dup last?>> not ]
        [ read-metadata-block ] produce nip
    ] with-file-reader ;