Paste: id3

Author:	inforichand
Mode:	factor
Date:	Sun, 1 Feb 2009 04:03:51

Plain Text |

Delete Paste

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

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

: supported-version? ( seq -- ? )
    dup { 4 } head? swap { 3 } head? or ;

: id3stuff ( path -- mapped-file ? )
    [ dup id3v2? [ 3 tail supported-version? ] [ dup id3v1? [ "id3v1"  ] [ "none"  ] if  ] if ]
    with-mapped-uchar-file ;

Annotation: new version

Author:	inforichland
Mode:	factor
Date:	Sun, 1 Feb 2009 04:20:02

Plain Text |

Delete Annotation

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

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

: supported-version? ( seq -- ? )
    [ { 4 } head? ] [ { 3 } head? ] bi or ;

: id3stuff ( path -- mapped-file ? )
    [
        {
            { [ dup id3v2? ] [ 3 tail-slice supported-version? ] }
            { [ dup id3v1? ] [ "id3v1" ] }
            [ drop "none" ]
        } cond
    ] with-mapped-uchar-file ;

Annotation: latest

Author:	inforichland
Mode:	factor
Date:	Tue, 3 Feb 2009 03:55:33

Plain Text |

Delete Annotation

! 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 size flags data ;

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

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

: 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 ( seq -- id )
    4 head-slice ;

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

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

: read-frame-data ( mmap  -- data )
    

: read-frame ( mmap -- frame )
    dup dup dup <frame>
    [ read-frame-id ] dips >string >>frame-id
    [ read-frame-flags ] dips >byte-array >>flags
    [ read-frame-size ] dips >28bitword >>size 
    '[ _ read-frame-data ]  dips >string >>data ;

! : 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
    [ header-supported-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 ;

Annotation: very latest

Author:	inforichland
Mode:	factor
Date:	Tue, 3 Feb 2009 04:57:17

Plain Text |

Delete Annotation

! 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 ;

Annotation: newest

Author:	inforichland
Mode:	factor
Date:	Thu, 5 Feb 2009 02:24:15

Plain Text |

Delete Annotation

! 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 prettyprint ;
IN: id3

! tuples

TUPLE: header version flags size ;

TUPLE: frame frame-id flags size data ;

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

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

! utility words

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

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

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

! frame details 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 ( frame mmap -- frame data )
    over size>> 10 + 10 swap rot <slice> ;

! read whole frames

: (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-frame ( mmap -- frame/f )
    dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ;

: (read-frames) ( vector mmap -- vector mmap )
    dup read-frame [ pick [ dup size>> ] dip rot swap push 10 + tail-slice (read-frames) ] when* ;

: read-frames ( mmap -- vector )
    V{ } clone swap (read-frames) ;

! header stuff

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

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

: read-header-size ( mmap -- size )
    6 10 rot <slice> >28bitword ;

: read-v2-header ( mmap -- id3header )
    [ <header> ] dip
    {
        [ read-header-supported-version?  >>version ]
        [ read-header-flags >>flags ]
        [ read-header-size >>size ]
    } cleave ;

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

! main stuff
: read-v2-tag-data ( seq -- header frames )
    drop-header read-v2-header swap read-frames ;

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

! end

Annotation: today's

Author:	inforichland
Mode:	factor
Date:	Fri, 6 Feb 2009 00:16:37

Plain Text |

Delete Annotation

! 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 prettyprint make ;
IN: id3

! tuples

TUPLE: header version flags size ;

TUPLE: frame frame-id flags size data ;

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

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

! utility words

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

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

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

! frame details 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 ] dip subseq ;

: read-frame-flags ( mmap -- flags )
    [ 8 10 ] dip subseq ;

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

! read whole frames

: (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-frame ( mmap -- frame/f )
    dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ;

: (read-frames) ( mmap -- mmap )
    dup read-frame [ [ , ] [ size>> 10 + ] bi tail-slice (read-frames) ] when* ;
    
: read-frames ( mmap -- seq )
    [ (read-frames) ] { } make nip ;

! header stuff

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

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

: read-header-size ( mmap -- size )
    6 10 rot <slice> >28bitword ;

: read-v2-header ( mmap -- id3header )
    [ <header> ] dip
    {
        [ read-header-supported-version?  >>version ]
        [ read-header-flags >>flags ]
        [ read-header-size >>size ]
    } cleave ;

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

! main stuff

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

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

! end

Annotation: super-newest

Author:	inforichland
Mode:	factor
Date:	Sun, 8 Feb 2009 01:41:04

Plain Text |

Delete Annotation

! 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 prettyprint make ;
IN: id3

! tuples

TUPLE: header version flags size ;

TUPLE: frame frame-id flags size data ;

TUPLE: mp3v2-file header frames ;

TUPLE: mp3v1-file title artist album year comment genre ;

: <mp3v1-file> ( -- object ) mp3v1-file new ;

: <mp3v2-file> ( header frames -- object ) mp3v2-file boa ;

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

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

! utility words

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

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

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

: filter-text-data ( data -- filtered )
    [ printable? ] filter ;

! frame details 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 ] dip subseq ;

: read-frame-flags ( mmap -- flags )
    [ 8 10 ] dip subseq ;

: read-frame-data ( frame mmap -- frame data )
    over size>> 10 + 10 swap rot <slice> filter-text-data ;

! read whole frames

: (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-frame ( mmap -- frame/f )
    dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ;

: remove-frame ( mmap frame -- mmap )
    size>> 10 + tail-slice ;

: (read-frames) ( mmap -- slices frames )
    [ dup read-frame dup ] [ dup [ remove-frame ] dip ] [ drop ] produce ;
    
: read-frames ( mmap -- seq )
    (read-frames) nip ;

! header stuff

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

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

: read-header-size ( mmap -- size )
    6 10 rot <slice> >28bitword ;

: read-v2-header ( mmap -- id3header )
    [ <header> ] dip
    {
        [ read-header-supported-version?  >>version ]
        [ read-header-flags >>flags ]
        [ read-header-size >>size ]
    } cleave ;

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

: read-v2-tag-data ( seq -- mp3v2-file )
    drop-header read-v2-header swap read-frames <mp3v2-file> ;

! v1 header

: skip-to-v1-data ( seq -- seq )
    125 tail-slice* ;

: read-title ( seq -- title )
    30 head-slice ;

: read-artist ( seq -- title )
    [ 30 60 ] dip <slice> ;

: read-album ( seq -- album )
    [ 60 90 ] dip <slice> ;

: read-year ( seq -- year )
    [ 90 94 ] dip <slice> ;

: read-comment ( seq -- comment )
    [ 94 124 ] dip <slice> ;

: read-genre ( seq -- genre )
    [ 125 ] dip nth ;

: (read-v1-tag-data) ( seq -- mp3-file )
    [ <mp3v1-file> ] dip
    {
        [ read-title   >string  >>title ]
        [ read-artist  >string  >>artist ]
        [ read-album   >string  >>album ]
        [ read-year    >string  >>year ]
        [ read-comment >string  >>comment ]
        [ read-genre   >string  >>genre ]
    } cleave ;

: read-v1-tag-data ( seq -- mp3-file )
    skip-to-v1-data (read-v1-tag-data) ;

! main stuff

: id3stuff ( path -- object )
    [
        {
            { [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- mp3-file )
            { [ dup id3v1? ] [ read-v1-tag-data ] }
            [ drop f ]
        } cond
    ] with-mapped-uchar-file ;

! end

Annotation: oops

Author:	inforichland
Mode:	factor
Date:	Sun, 8 Feb 2009 02:06:16

Plain Text |

Delete Annotation

! 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 prettyprint make ;
IN: id3

! tuples

TUPLE: header version flags size ;

TUPLE: frame frame-id flags size data ;

TUPLE: mp3v2-file header frames ;

TUPLE: mp3v1-file title artist album year comment genre ;

: <mp3v1-file> ( -- object ) mp3v1-file new ;

: <mp3v2-file> ( header frames -- object ) mp3v2-file boa ;

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

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

! utility words

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

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

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

: filter-text-data ( data -- filtered )
    [ printable? ] filter ;

! frame details 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 ] dip subseq ;

: read-frame-flags ( mmap -- flags )
    [ 8 10 ] dip subseq ;

: read-frame-data ( frame mmap -- frame data )
    over size>> 10 + 10 swap rot <slice> filter-text-data ;

! read whole frames

: (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-frame ( mmap -- frame/f )
    dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ;

: remove-frame ( mmap frame -- mmap )
    size>> 10 + tail-slice ;

: (read-frames) ( mmap -- slices frames )
    [ dup read-frame dup ] [ dup [ remove-frame ] dip ] [ drop ] produce ;
    
: read-frames ( mmap -- seq )
    (read-frames) nip ;

! header stuff

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

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

: read-header-size ( mmap -- size )
    6 10 rot <slice> >28bitword ;

: read-v2-header ( mmap -- id3header )
    [ <header> ] dip
    {
        [ read-header-supported-version?  >>version ]
        [ read-header-flags >>flags ]
        [ read-header-size >>size ]
    } cleave ;

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

: read-v2-tag-data ( seq -- mp3v2-file )
    drop-header read-v2-header swap read-frames <mp3v2-file> ;

! v1 information

: skip-to-v1-data ( seq -- seq )
    125 tail-slice* ;

: read-title ( seq -- title )
    30 head-slice ;

: read-artist ( seq -- title )
    [ 30 60 ] dip subseq ;

: read-album ( seq -- album )
    [ 60 90 ] dip subseq ;

: read-year ( seq -- year )
    [ 90 94 ] dip subseq ;

: read-comment ( seq -- comment )
    [ 94 124 ] dip subseq ;

: read-genre ( seq -- genre )
    [ 124 ] dip nth ;

: (read-v1-tag-data) ( seq -- mp3-file )
    [ <mp3v1-file> ] dip
    {
        [ read-title   >string  >>title ]
        [ read-artist  >string  >>artist ]
        [ read-album   >string  >>album ]
        [ read-year    >string  >>year ]
        [ read-comment >string  >>comment ]
        [ read-genre   >fixnum  >>genre ]
    } cleave ;

: read-v1-tag-data ( seq -- mp3-file )
    skip-to-v1-data (read-v1-tag-data) ;

! main stuff

: id3stuff ( path -- object )
    [
        {
            { [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- mp3-file )
            { [ dup id3v1? ] [ read-v1-tag-data ] }
            [ drop f ]
        } cond
    ] with-mapped-uchar-file ;

! end

New Annotation

Summary:
Author:
Mode:	textPostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonqdocrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsparqlsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt
Body:

Done