! Copyright (C) 2009 Tim Wawrzynczak
! See http://factorcode.org/license.txt for BSD license.
USING: sequences io io.encodings.binary io.files io.pathnames strings kernel math io.mmap io.mmap.uchar accessors syntax combinators math.ranges unicode.categories byte-arrays fry ;
IN: id3

TUPLE: id3v2header version flags size ;

TUPLE: frame frame-id flags size data ;

: <id3v2header> ( -- object ) id3v2header new ;

: <frame> ( -- object ) frame new ;

: <frame-boa> ( id size flags data -- frame ) frame boa ;

: id3v2? ( mmap -- ? )
    "ID3" head? ;

: id3v1? ( mmap -- ? )
    128 tail-slice* "TAG" head? ;

! utility words

: >28bitword ( seq -- int )
    0 [ swap 7 shift bitor ] reduce ;

: dips ( x y quot -- y z )
    dip swap ; inline

! frame stuff

: valid-frame-id? ( id -- ? )
    [ [ digit? ] [ LETTER? ] bi or ] all? ;

: read-frame-id ( mmap -- id )
    4 head-slice ;

: read-frame-size ( mmap -- size )
    4 8 rot subseq ;

: read-frame-flags ( mmap -- flags )
    8 10 rot subseq ;

: read-frame-data ( mmap -- data )
    over size>> 10 + 11 swap rot subseq ;

: read-frame ( mmap -- frame )
    [ <frame> ] dip
    {
        [ read-frame-id    >string     >>frame-id ]
        [ read-frame-flags >byte-array >>flags ]
        [ read-frame-size  >28bitword  >>size ]
        [ read-frame-data  >string     >>data ]
    } cleave ;

! : read-frames ( mmap -- frames )

! header stuff

: header-supported-version? ( mmap -- ? )
    3 tail-slice [ { 4 } head? ] [ { 3 } head? ] bi or ;

: header-flags ( mmap -- flags )
    5 swap nth ;

: header-size ( mmap -- size )
    6 10 rot subseq >28bitword ;

: read-v2-header ( mmap -- id3header )
    dup dup <id3v2header>
    [ header-supported-version? ] dips >>version
    [ header-flags ] dips >>flags
    [ header-size ] dips >>size ;

: drop-header ( seq1 seq2 -- seq2 seq1 )
    dup 10 tail-slice swap ;

: read-v2-tag-data ( seq -- header frame )
    drop-header read-v2-header swap read-frame ;

: id3stuff ( path -- header )
    [
        {
            { [ dup id3v2? ] [ read-v2-tag-data ] }
            { [ dup id3v1? ] [ drop "id3v1" ] }
            [ drop "none" ]
        } cond
    ] with-mapped-uchar-file ;