factor-work/flac/metadata/metadata.factor

USING: kernel math math.parser endian sequences pack io.streams.byte-array io.encodings.utf8 io.encodings.string io.encodings.binary io.encodings.ascii splitting assocs arrays byte-arrays accessors combinators ;
QUALIFIED: io

USING: flac.stream flac.format ;

IN: flac.metadata

<PRIVATE

ERROR: cuesheet-index-reserved-must-be-zero ;

: read-metadata-block-header ( -- header )
    1 flac-read-uint 1 =
    7 flac-read-uint <metadata-type>
    24 flac-read-uint
    metadata-block-header boa ;

: read-metadata-block-stream-info ( -- stream-info )
    16 flac-read-uint
    16 flac-read-uint
    24 flac-read-uint
    24 flac-read-uint
    20 flac-read-uint
    3 flac-read-uint 1 +
    5 flac-read-uint 1 +
    36 flac-read-uint
    128 flac-read-uint 16 >be bytes>hex-string
    stream-info boa ;

: read-metadata-block-seek-table ( length -- seek-table )
    18 / <iota> [
        drop
        64 flac-read-uint
        64 flac-read-uint
        16 flac-read-uint
        seek-point boa
    ] map
    seek-table boa ;

: read-metadata-block-vorbis-comment ( length -- vorbis-comment )
    ! vorbis comments are in little endian...
    drop
    32 flac-read-uint 4 >le be> dup 8 * flac-read-uint swap >n-byte-array  utf8 decode
    32 flac-read-uint 4 >le be> <iota>
    [
        drop
        32 flac-read-uint 4 >le be> dup 8 * flac-read-uint swap >n-byte-array utf8 decode
        "=" split
    ] map
    >alist vorbis-comment boa ;

: encode-vorbis-string ( str -- byte-array )
    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 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 io:write ]
        [ comments>> encode-vorbis-comments io:write ] bi
    ] with-byte-writer ;

: encode-padding ( padding -- byte-array )
    length>> <byte-array> ;

: read-metadata-block-padding ( length -- padding )
    dup 8 * flac-read-uint drop flac-padding boa ;

: read-metadata-block-application ( length -- application )
    8 * flac-read-uint drop application new ;

: read-metadata-block-cuesheet ( length -- cuesheet )
    dup [ 8 * flac-read-uint ] dip >be
    binary
    [
        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 ;

: read-metadata-block-picture ( length -- picture )
    drop
    32 flac-read-uint <picture-type>
    32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array utf8 decode
    32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array utf8 decode
    32 flac-read-uint
    32 flac-read-uint
    32 flac-read-uint
    32 flac-read-uint
    32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array reverse
    picture boa ;

: append-picture ( metadata picture -- metadata )
    [ dup picture>> ] dip suffix >>picture ;

: read-metadata-block ( metadata length type -- metadata )
    [
        {
            { metadata-stream-info    [ drop read-metadata-block-stream-info >>stream-info ] }
            { metadata-padding        [ read-metadata-block-padding          >>padding ] }
            { metadata-application    [ read-metadata-block-application      >>application ] }
            { metadata-seek-table     [ read-metadata-block-seek-table       >>seek-table ] }
            { metadata-vorbis-comment [ read-metadata-block-vorbis-comment   >>vorbis-comment ] }
            { metadata-cuesheet       [ read-metadata-block-cuesheet         >>cuesheet ] }
            { metadata-picture        [ read-metadata-block-picture          append-picture ] }
        } case
    ] with-big-endian ;

PRIVATE>

: read-flac-metadata ( -- metadata )
    read/assert-flac-magic
    metadata new
    [
        read-metadata-block-header
        [ length>> ] [ type>> ] [ last?>> not ] tri
        [ read-metadata-block ] dip
    ] loop ;

! : read-stream-info/seek-data ( -- stream-info )
!      read/assert-flac-magic
!      32 flac-read-uint drop
!      read-metadata-block-stream-info
!     [ read-metadata-block-header [ length>> 8 * flac-seek ] [ last?>> not ] bi ] loop ;

: <flac-stream-info> ( filename -- stream-info )
    [
        read/assert-flac-magic
        32 flac-read-uint drop
        read-metadata-block-stream-info
    ] with-flac-file-reader ;

! TODO: write these
! : <flac-tags> ( filename -- tags )
!     [
!         read/assert-flac-magic
!         [ read-metadata-block-header [ length>> ] [ type>> metadata-vorbis-comment = ] [ last?>> ] tri or ]
!         [ flac-seek ] until [ read-metadata-block-vorbis-comment ] with-big-endian
!     ] with-flac-file-reader ;
!
! : <flac-pictures> ( filename -- pictures )
!     [
!         read/assert-flac-magic
!         [ read-metadata-block-header dup last?>> not ]
!         [
!             [ length>> ] [ type>> metadata-picture = ] bi
!             [ read-metadata-block-picture ]
!             [ flac-seek f ] if
!         ] produce nip sift
!     ] with-flac-file-reader ;

: <flac-metadata> ( filename -- metadata )
    [ read-flac-metadata ] with-flac-file-reader ;