2009-02-26 22:39:53 -05:00
|
|
|
! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
|
2009-02-09 22:50:04 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-02-26 18:54:44 -05:00
|
|
|
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
|
|
|
|
io.encodings.string io.encodings.utf8 assocs math.parser
|
2009-02-26 22:39:53 -05:00
|
|
|
combinators.short-circuit fry namespaces multiline
|
|
|
|
combinators.smart splitting ;
|
2009-02-09 22:50:04 -05:00
|
|
|
IN: id3
|
|
|
|
|
2009-02-18 22:32:31 -05:00
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
CONSTANT: genres
|
2009-02-26 22:39:53 -05:00
|
|
|
{
|
|
|
|
"Blues"
|
|
|
|
"Classic Rock"
|
|
|
|
"Country"
|
|
|
|
"Dance"
|
|
|
|
"Disco"
|
|
|
|
"Funk"
|
|
|
|
"Grunge"
|
|
|
|
"Hip-Hop"
|
|
|
|
"Jazz"
|
|
|
|
"Metal"
|
|
|
|
"New Age"
|
|
|
|
"Oldies"
|
|
|
|
"Other"
|
|
|
|
"Pop"
|
|
|
|
"R&B"
|
|
|
|
"Rap"
|
|
|
|
"Reggae"
|
|
|
|
"Rock"
|
|
|
|
"Techno"
|
|
|
|
"Industrial"
|
|
|
|
"Alternative"
|
|
|
|
"Ska"
|
|
|
|
"Death Metal"
|
|
|
|
"Pranks"
|
|
|
|
"Soundtrack"
|
|
|
|
"Euro-Techno"
|
|
|
|
"Ambient"
|
|
|
|
"Trip-Hop"
|
|
|
|
"Vocal"
|
|
|
|
"Jazz+Funk"
|
|
|
|
"Fusion"
|
|
|
|
"Trance"
|
|
|
|
"Classical"
|
|
|
|
"Instrumental"
|
|
|
|
"Acid"
|
|
|
|
"House"
|
|
|
|
"Game"
|
|
|
|
"Sound Clip"
|
|
|
|
"Gospel"
|
|
|
|
"Noise"
|
|
|
|
"AlternRock"
|
|
|
|
"Bass"
|
|
|
|
"Soul"
|
|
|
|
"Punk"
|
|
|
|
"Space"
|
|
|
|
"Meditative"
|
|
|
|
"Instrumental Pop"
|
|
|
|
"Instrumental Rock"
|
|
|
|
"Ethnic"
|
|
|
|
"Gothic"
|
|
|
|
"Darkwave"
|
|
|
|
"Techno-Industrial"
|
|
|
|
"Electronic"
|
|
|
|
"Pop-Folk"
|
|
|
|
"Eurodance"
|
|
|
|
"Dream"
|
|
|
|
"Southern Rock"
|
|
|
|
"Comedy"
|
|
|
|
"Cult"
|
|
|
|
"Gangsta"
|
|
|
|
"Top 40"
|
|
|
|
"Christian Rap"
|
|
|
|
"Pop/Funk"
|
|
|
|
"Jungle"
|
|
|
|
"Native American"
|
|
|
|
"Cabaret"
|
|
|
|
"New Wave"
|
|
|
|
"Psychedelic"
|
|
|
|
"Rave"
|
|
|
|
"Showtunes"
|
|
|
|
"Trailer"
|
|
|
|
"Lo-Fi"
|
|
|
|
"Tribal"
|
|
|
|
"Acid Punk"
|
|
|
|
"Acid Jazz"
|
|
|
|
"Polka"
|
|
|
|
"Retro"
|
|
|
|
"Musical"
|
|
|
|
"Rock & Roll"
|
|
|
|
"Hard Rock"
|
|
|
|
"Folk"
|
|
|
|
"Folk-Rock"
|
|
|
|
"National Folk"
|
|
|
|
"Swing"
|
|
|
|
"Fast Fusion"
|
|
|
|
"Bebop"
|
|
|
|
"Latin"
|
|
|
|
"Revival"
|
|
|
|
"Celtic"
|
|
|
|
"Bluegrass"
|
|
|
|
"Avantgarde"
|
|
|
|
"Gothic Rock"
|
|
|
|
"Progressive Rock"
|
|
|
|
"Psychedelic Rock"
|
|
|
|
"Symphonic Rock"
|
|
|
|
"Slow Rock"
|
|
|
|
"Big Band"
|
|
|
|
"Chorus"
|
|
|
|
"Easy Listening"
|
|
|
|
"Acoustic"
|
|
|
|
"Humour"
|
|
|
|
"Speech"
|
|
|
|
"Chanson"
|
|
|
|
"Opera"
|
|
|
|
"Chamber Music"
|
|
|
|
"Sonata"
|
|
|
|
"Symphony"
|
|
|
|
"Booty Bass"
|
|
|
|
"Primus"
|
|
|
|
"Porn Groove"
|
|
|
|
"Satire"
|
|
|
|
"Slow Jam"
|
|
|
|
"Club"
|
|
|
|
"Tango"
|
|
|
|
"Samba"
|
|
|
|
"Folklore"
|
|
|
|
"Ballad"
|
|
|
|
"Power Ballad"
|
|
|
|
"Rhythmic Soul"
|
|
|
|
"Freestyle"
|
|
|
|
"Duet"
|
|
|
|
"Punk Rock"
|
|
|
|
"Drum Solo"
|
|
|
|
"A capella"
|
|
|
|
"Euro-House"
|
|
|
|
"Dance Hall"
|
|
|
|
}
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
TUPLE: header version flags size ;
|
|
|
|
|
|
|
|
TUPLE: frame frame-id flags size data ;
|
|
|
|
|
2009-02-18 22:32:31 -05:00
|
|
|
TUPLE: id3v2-info header frames ;
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-18 22:32:31 -05:00
|
|
|
TUPLE: id3-info title artist album year comment genre ;
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-18 22:32:31 -05:00
|
|
|
: <id3-info> ( -- object ) id3-info new ;
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: <id3v2-info> ( header frames -- object )
|
|
|
|
[ [ frame-id>> ] keep ] H{ } map>assoc
|
|
|
|
id3v2-info boa ;
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: <header> ( -- object ) header new ;
|
|
|
|
|
|
|
|
: <frame> ( -- object ) frame new ;
|
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: id3v2? ( mmap -- ? ) "ID3" head? ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: id3v1? ( mmap -- ? )
|
2009-02-26 22:39:53 -05:00
|
|
|
{ [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline
|
|
|
|
|
|
|
|
: id3v1-frame ( string key -- frame )
|
|
|
|
<frame>
|
|
|
|
swap >>frame-id
|
|
|
|
swap >>data ;
|
|
|
|
|
|
|
|
: id3v1>id3v2 ( id3v1 -- id3v2 )
|
|
|
|
[
|
|
|
|
{
|
|
|
|
[ title>> "TIT2" id3v1-frame ]
|
|
|
|
[ artist>> "TPE1" id3v1-frame ]
|
|
|
|
[ album>> "TALB" id3v1-frame ]
|
|
|
|
[ year>> "TYER" id3v1-frame ]
|
|
|
|
[ comment>> "COMM" id3v1-frame ]
|
|
|
|
[ genre>> "TCON" id3v1-frame ]
|
|
|
|
} cleave
|
|
|
|
] output>array f swap <id3v2-info> ;
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: >28bitword ( seq -- int )
|
2009-02-26 22:39:53 -05:00
|
|
|
0 [ [ 7 shift ] dip bitor ] reduce ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: filter-text-data ( data -- filtered )
|
2009-02-26 22:39:53 -05:00
|
|
|
[ printable? ] filter ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
! frame details stuff
|
|
|
|
|
|
|
|
: valid-frame-id? ( id -- ? )
|
2009-02-26 22:39:53 -05:00
|
|
|
[ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: read-frame-id ( mmap -- id )
|
2009-02-26 22:39:53 -05:00
|
|
|
4 head-slice ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: read-frame-size ( mmap -- size )
|
2009-02-26 22:39:53 -05:00
|
|
|
[ 4 8 ] dip subseq ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: read-frame-flags ( mmap -- flags )
|
2009-02-26 22:39:53 -05:00
|
|
|
[ 8 10 ] dip subseq ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: read-frame-data ( frame mmap -- frame data )
|
2009-02-26 22:39:53 -05:00
|
|
|
[ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
! read whole frames
|
|
|
|
|
|
|
|
: (read-frame) ( mmap -- frame )
|
|
|
|
[ <frame> ] dip
|
|
|
|
{
|
2009-02-18 22:32:31 -05:00
|
|
|
[ read-frame-id utf8 decode >>frame-id ]
|
2009-02-09 22:50:04 -05:00
|
|
|
[ read-frame-flags >byte-array >>flags ]
|
|
|
|
[ read-frame-size >28bitword >>size ]
|
2009-02-18 22:32:31 -05:00
|
|
|
[ read-frame-data utf8 decode >>data ]
|
2009-02-09 22:50:04 -05:00
|
|
|
} cleave ;
|
|
|
|
|
|
|
|
: read-frame ( mmap -- frame/f )
|
2009-02-26 22:39:53 -05:00
|
|
|
dup read-frame-id valid-frame-id?
|
|
|
|
[ (read-frame) ] [ drop f ] if ;
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: remove-frame ( mmap frame -- mmap )
|
2009-02-26 22:39:53 -05:00
|
|
|
size>> 10 + tail-slice ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: read-frames ( mmap -- frames )
|
|
|
|
[ dup read-frame dup ]
|
|
|
|
[ [ remove-frame ] keep ]
|
|
|
|
[ drop ] produce nip ;
|
|
|
|
|
|
|
|
! header stuff
|
|
|
|
|
|
|
|
: read-header-supported-version? ( mmap -- ? )
|
2009-02-26 22:39:53 -05:00
|
|
|
3 tail-slice first { 3 4 } member? ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: read-header-flags ( mmap -- flags ) 5 swap nth ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: read-header-size ( mmap -- size )
|
2009-02-26 22:39:53 -05:00
|
|
|
[ 6 10 ] dip <slice> >28bitword ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: read-v2-header ( mmap -- id3header )
|
|
|
|
[ <header> ] dip
|
|
|
|
{
|
2009-02-26 19:03:15 -05:00
|
|
|
[ read-header-supported-version? >>version ]
|
2009-02-09 22:50:04 -05:00
|
|
|
[ read-header-flags >>flags ]
|
|
|
|
[ read-header-size >>size ]
|
2009-02-26 22:39:53 -05:00
|
|
|
} cleave ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: drop-header ( mmap -- seq1 seq2 )
|
2009-02-26 22:39:53 -05:00
|
|
|
[ 10 tail-slice ] [ ] bi ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: read-v2-tag-data ( seq -- id3v2-info )
|
|
|
|
drop-header read-v2-header
|
|
|
|
swap read-frames <id3v2-info> ; inline
|
2009-02-18 22:32:31 -05:00
|
|
|
|
2009-02-09 22:50:04 -05:00
|
|
|
! v1 information
|
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: read-title ( seq -- title ) 30 head-slice ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: read-artist ( seq -- title ) [ 30 60 ] dip subseq ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: read-album ( seq -- album ) [ 60 90 ] dip subseq ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: read-year ( seq -- year ) [ 90 94 ] dip subseq ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: read-comment ( seq -- comment ) [ 94 124 ] dip subseq ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: read-genre ( seq -- genre ) [ 124 ] dip nth ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: (read-v1-tag-data) ( seq -- mp3-file )
|
2009-02-18 22:32:31 -05:00
|
|
|
[ <id3-info> ] dip
|
2009-02-09 22:50:04 -05:00
|
|
|
{
|
2009-02-18 22:32:31 -05:00
|
|
|
[ read-title utf8 decode filter-text-data >>title ]
|
|
|
|
[ read-artist utf8 decode filter-text-data >>artist ]
|
|
|
|
[ read-album utf8 decode filter-text-data >>album ]
|
|
|
|
[ read-year utf8 decode filter-text-data >>year ]
|
|
|
|
[ read-comment utf8 decode filter-text-data >>comment ]
|
2009-02-26 22:39:53 -05:00
|
|
|
[ read-genre number>string >>genre ]
|
|
|
|
} cleave ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
: read-v1-tag-data ( seq -- mp3-file )
|
2009-02-26 22:39:53 -05:00
|
|
|
skip-to-v1-data (read-v1-tag-data) ; inline
|
|
|
|
|
|
|
|
: parse-genre ( string -- n/f )
|
|
|
|
dup "(" ?head-slice drop ")" ?tail-slice drop
|
|
|
|
string>number dup number? [
|
|
|
|
genres ?nth swap or
|
|
|
|
] [
|
|
|
|
drop
|
|
|
|
] if ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: frame-named ( id3 name quot -- obj )
|
|
|
|
[ swap frames>> at* ] dip
|
|
|
|
[ data>> ] prepose [ drop f ] if ; inline
|
|
|
|
|
|
|
|
: id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline
|
|
|
|
|
|
|
|
: id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline
|
|
|
|
|
|
|
|
: id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline
|
2009-02-09 22:50:04 -05:00
|
|
|
|
2009-02-26 22:39:53 -05:00
|
|
|
: id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline
|
|
|
|
|
|
|
|
: id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline
|
|
|
|
|
|
|
|
: id3-genre ( id3 -- genre/f )
|
|
|
|
"TCON" [ parse-genre ] frame-named ; inline
|
|
|
|
|
|
|
|
: id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline
|
|
|
|
|
|
|
|
: file-id3-tags ( path -- id3v2-info/f )
|
2009-02-09 22:50:04 -05:00
|
|
|
[
|
|
|
|
{
|
2009-02-26 22:39:53 -05:00
|
|
|
{ [ dup id3v2? ] [ read-v2-tag-data ] }
|
|
|
|
{ [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
|
|
|
|
[ drop f ]
|
2009-02-09 22:50:04 -05:00
|
|
|
} cond
|
|
|
|
] with-mapped-uchar-file ;
|