factor/extra/id3/id3.factor

247 lines
7.8 KiB
Factor
Raw Normal View History

! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
2009-02-09 22:50:04 -05:00
! 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
io.encodings.string io.encodings.utf16 assocs math.parser
combinators.short-circuit fry namespaces combinators.smart
2009-03-02 20:41:58 -05:00
splitting io.encodings.ascii arrays io.files.info unicode.case
2009-04-09 19:23:05 -04:00
io.directories.search literals math.functions ;
2009-02-09 22:50:04 -05:00
IN: id3
<PRIVATE
CONSTANT: genres
{
"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"
2009-04-09 16:03:34 -04:00
"Euro-House" "Dance Hall" "Goa" "Drum & Bass" "Club-House"
"Hardcore" "Terror" "Indie" "BritPop" "Negerpunk"
"Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
"Black Metal" "Crossover" "Contemporary Christian"
"Christian Rock"
}
2009-02-09 22:50:04 -05:00
TUPLE: header version flags size ;
2009-04-09 16:03:34 -04:00
TUPLE: frame tag flags size data ;
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
TUPLE: id3 header frames
title artist album year comment genre
speed genre-name start-time end-time ;
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: <id3> ( -- id3 )
id3 new
H{ } clone >>frames ; inline
2009-02-09 22:50:04 -05:00
: <header> ( -- object ) header new ; inline
2009-02-09 22:50:04 -05:00
: <frame> ( -- object ) frame new ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: id3v2? ( seq -- ? ) "ID3" head? ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
CONSTANT: id3v1-length 128
CONSTANT: id3v1-offset 128
CONSTANT: id3v1+-length 227
CONSTANT: id3v1+-offset $[ 128 227 + ]
: id3v1? ( seq -- ? )
{
[ length id3v1-offset >= ]
[ id3v1-length tail-slice* "TAG" head? ]
} 1&& ; inline
2009-04-09 16:03:34 -04:00
: id3v1+? ( seq -- ? )
{
[ length id3v1+-offset >= ]
[ id3v1+-length tail-slice* "TAG+" head? ]
} 1&& ; inline
: pair>frame ( string key -- frame/f )
over [
<frame>
swap >>tag
swap >>data
] [
2drop f
] if ; inline
2009-04-09 16:03:34 -04:00
: id3v1>frames ( id3v1 -- seq )
[
{
2009-04-09 16:03:34 -04:00
[ title>> "TIT2" pair>frame ]
[ artist>> "TPE1" pair>frame ]
[ album>> "TALB" pair>frame ]
[ year>> "TYER" pair>frame ]
[ comment>> "COMM" pair>frame ]
[ genre>> "TCON" pair>frame ]
} cleave
2009-04-09 16:03:34 -04:00
] output>array sift ;
2009-02-09 22:50:04 -05:00
2009-04-09 19:23:05 -04:00
: seq>synchsafe ( seq -- n )
0 [ [ 7 shift ] dip bitor ] reduce ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 19:23:05 -04:00
: synchsafe>seq ( n -- seq )
dup 1+ log2 1+ 7 / ceiling
[ [ -7 shift ] keep HEX: 7f bitand ] replicate nip reverse ; inline
2009-02-09 22:50:04 -05:00
: filter-text-data ( data -- filtered )
[ printable? ] filter ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: valid-tag? ( id -- ? )
[ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: read-frame-data ( frame seq -- frame data )
[ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
2009-02-09 22:50:04 -05:00
: decode-text ( string -- string' )
dup 2 short head
{ { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
utf16 ascii ? decode ; inline
2009-04-09 16:03:34 -04:00
: (read-frame) ( seq -- frame )
2009-02-09 22:50:04 -05:00
[ <frame> ] dip
{
2009-04-09 16:03:34 -04:00
[ 4 head-slice decode-text >>tag ]
2009-04-09 19:23:05 -04:00
[ [ 4 8 ] dip subseq seq>synchsafe >>size ]
[ [ 8 10 ] dip subseq >byte-array >>flags ]
[ read-frame-data decode-text >>data ]
} cleave ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: read-frame ( seq -- frame/f )
dup 4 head-slice valid-tag?
[ (read-frame) ] [ drop f ] if ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: remove-frame ( seq frame -- seq )
size>> 10 + tail-slice ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: frames>assoc ( seq -- assoc )
[ [ tag>> ] keep ] H{ } map>assoc ; inline
: read-frames ( seq -- assoc )
[ dup read-frame dup ] [ [ remove-frame ] keep ] produce 2nip ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: read-v2-header ( seq -- header )
2009-02-09 22:50:04 -05:00
[ <header> ] dip
{
[ [ 3 5 ] dip <slice> >array >>version ]
[ [ 5 ] dip nth >>flags ]
2009-04-09 19:23:05 -04:00
[ [ 6 10 ] dip <slice> seq>synchsafe >>size ]
} cleave ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: merge-frames ( id3 assoc -- id3 )
[ dup frames>> ] dip update ; inline
: merge-id3v1 ( id3 -- id3 )
dup id3v1>frames frames>assoc merge-frames ; inline
: read-v2-tags ( id3 seq -- id3 )
10 cut-slice
2009-04-09 16:03:34 -04:00
[ read-v2-header >>header ]
[ read-frames frames>assoc merge-frames ] bi* ; inline
2009-04-09 16:03:34 -04:00
: extract-v1-tags ( id3 seq -- id3 )
2009-02-09 22:50:04 -05:00
{
[ 30 head-slice decode-text filter-text-data >>title ]
[ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
[ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
[ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
[ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
[ [ 124 ] dip nth number>string >>genre ]
} cleave ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: read-v1-tags ( id3 seq -- id3 )
id3v1-offset tail-slice* 3 tail-slice
extract-v1-tags ; inline
: extract-v1+-tags ( id3 seq -- id3 )
{
[ 60 head-slice decode-text filter-text-data [ append ] change-title ]
[
[ 60 120 ] dip subseq decode-text filter-text-data
[ append ] change-artist
]
[
[ 120 180 ] dip subseq decode-text filter-text-data
[ append ] change-album
]
[ [ 180 ] dip nth >>speed ]
[ [ 181 211 ] dip subseq decode-text >>genre-name ]
[ [ 211 217 ] dip subseq decode-text >>start-time ]
[ [ 217 223 ] dip subseq decode-text >>end-time ]
} cleave ; inline
: read-v1+-tags ( id3 seq -- id3 )
id3v1+-offset tail-slice* 4 tail-slice
extract-v1+-tags ; 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
2009-04-09 16:03:34 -04:00
: (mp3>id3) ( path -- id3v2/f )
[
2009-04-09 16:03:34 -04:00
[ <id3> ] dip
{
2009-04-09 16:03:34 -04:00
[ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
[ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
[ dup id3v2? [ read-v2-tags ] [ drop ] if ]
} cleave
] with-mapped-uchar-file ;
2009-02-09 22:50:04 -05:00
PRIVATE>
2009-04-09 16:03:34 -04:00
: mp3>id3 ( path -- id3/f )
dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline
: find-id3-frame ( id3 name -- obj/f )
2009-04-06 19:10:49 -04:00
swap frames>> at* [ data>> ] when ; inline
2009-02-09 22:50:04 -05:00
2009-04-09 16:03:34 -04:00
: title ( id3 -- string/f ) "TIT2" find-id3-frame ; inline
2009-04-09 16:03:34 -04:00
: artist ( id3 -- string/f ) "TPE1" find-id3-frame ; inline
2009-04-09 16:03:34 -04:00
: album ( id3 -- string/f ) "TALB" find-id3-frame ; inline
2009-04-09 16:03:34 -04:00
: year ( id3 -- string/f ) "TYER" find-id3-frame ; inline
2009-04-09 16:03:34 -04:00
: comment ( id3 -- string/f ) "COMM" find-id3-frame ; inline
2009-04-09 16:03:34 -04:00
: genre ( id3 -- string/f )
2009-04-06 19:10:49 -04:00
"TCON" find-id3-frame parse-genre ; inline
: find-mp3s ( path -- seq )
[ >lower ".mp3" tail? ] find-all-files ; inline
2009-03-02 13:05:36 -05:00
: mp3-paths>id3s ( seq -- seq' )
[ dup mp3>id3 ] { } map>assoc ; inline
2009-03-02 20:41:58 -05:00
: parse-mp3-directory ( path -- seq )
find-mp3s mp3-paths>id3s ;