-! Copyright (C) 2009 Tim Wawrzynczak
+! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
! 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.utf8 assocs math.parser
-combinators.short-circuit fry ;
+combinators.short-circuit fry namespaces multiline
+combinators.smart splitting ;
IN: id3
<PRIVATE
CONSTANT: genres
- H{
- { 0 "Blues" }
- { 1 "Classic Rock" }
- { 2 "Country" }
- { 3 "Dance" }
- { 4 "Disco" }
- { 5 "Funk" }
- { 6 "Grunge" }
- { 7 "Hip-Hop" }
- { 8 "Jazz" }
- { 9 "Metal" }
- { 10 "New Age" }
- { 11 "Oldies" }
- { 12 "Other" }
- { 13 "Pop" }
- { 14 "R&B" }
- { 15 "Rap" }
- { 16 "Reggae" }
- { 17 "Rock" }
- { 18 "Techno" }
- { 19 "Industrial" }
- { 20 "Alternative" }
- { 21 "Ska" }
- { 22 "Death Metal" }
- { 23 "Pranks" }
- { 24 "Soundtrack" }
- { 25 "Euro-Techno" }
- { 26 "Ambient" }
- { 27 "Trip-Hop" }
- { 28 "Vocal" }
- { 29 "Jazz+Funk" }
- { 30 "Fusion" }
- { 31 "Trance" }
- { 32 "Classical" }
- { 33 "Instrumental" }
- { 34 "Acid" }
- { 35 "House" }
- { 36 "Game" }
- { 37 "Sound Clip" }
- { 38 "Gospel" }
- { 39 "Noise" }
- { 40 "AlternRock" }
- { 41 "Bass" }
- { 42 "Soul" }
- { 43 "Punk" }
- { 44 "Space" }
- { 45 "Meditative" }
- { 46 "Instrumental Pop" }
- { 47 "Instrumental Rock" }
- { 48 "Ethnic" }
- { 49 "Gothic" }
- { 50 "Darkwave" }
- { 51 "Techno-Industrial" }
- { 52 "Electronic" }
- { 53 "Pop-Folk" }
- { 54 "Eurodance" }
- { 55 "Dream" }
- { 56 "Southern Rock" }
- { 57 "Comedy" }
- { 58 "Cult" }
- { 59 "Gangsta" }
- { 60 "Top 40" }
- { 61 "Christian Rap" }
- { 62 "Pop/Funk" }
- { 63 "Jungle" }
- { 64 "Native American" }
- { 65 "Cabaret" }
- { 66 "New Wave" }
- { 67 "Psychedelic" }
- { 68 "Rave" }
- { 69 "Showtunes" }
- { 70 "Trailer" }
- { 71 "Lo-Fi" }
- { 72 "Tribal" }
- { 73 "Acid Punk" }
- { 74 "Acid Jazz" }
- { 75 "Polka" }
- { 76 "Retro" }
- { 77 "Musical" }
- { 78 "Rock & Roll" }
- { 79 "Hard Rock" }
- { 80 "Folk" }
- { 81 "Folk-Rock" }
- { 82 "National Folk" }
- { 83 "Swing" }
- { 84 "Fast Fusion" }
- { 85 "Bebop" }
- { 86 "Latin" }
- { 87 "Revival" }
- { 88 "Celtic" }
- { 89 "Bluegrass" }
- { 90 "Avantgarde" }
- { 91 "Gothic Rock" }
- { 92 "Progressive Rock" }
- { 93 "Psychedelic Rock" }
- { 94 "Symphonic Rock" }
- { 95 "Slow Rock" }
- { 96 "Big Band" }
- { 97 "Chorus" }
- { 98 "Easy Listening" }
- { 99 "Acoustic" }
- { 100 "Humour" }
- { 101 "Speech" }
- { 102 "Chanson" }
- { 103 "Opera" }
- { 104 "Chamber Music" }
- { 105 "Sonata" }
- { 106 "Symphony" }
- { 107 "Booty Bass" }
- { 108 "Primus" }
- { 109 "Porn Groove" }
- { 110 "Satire" }
- { 111 "Slow Jam" }
- { 112 "Club" }
- { 113 "Tango" }
- { 114 "Samba" }
- { 115 "Folklore" }
- { 116 "Ballad" }
- { 117 "Power Ballad" }
- { 118 "Rhythmic Soul" }
- { 119 "Freestyle" }
- { 120 "Duet" }
- { 121 "Punk Rock" }
- { 122 "Drum Solo" }
- { 123 "A capella" }
- { 124 "Euro-House" }
- { 125 "Dance Hall" }
-} ! end genre hashtable
-
-! tuples
+ {
+ "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"
+ }
TUPLE: header version flags size ;
: <id3-info> ( -- object ) id3-info new ;
-: <id3v2-info> ( header frames -- object ) id3v2-info boa ;
+: <id3v2-info> ( header frames -- object )
+ [ [ frame-id>> ] keep ] H{ } map>assoc
+ id3v2-info boa ;
: <header> ( -- object ) header new ;
: <frame> ( -- object ) frame new ;
-! utility words
-
-: id3v2? ( mmap -- ? )
- "ID3" head? ;
+: id3v2? ( mmap -- ? ) "ID3" head? ; inline
: id3v1? ( mmap -- ? )
- { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ;
+ { [ 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> ;
: >28bitword ( seq -- int )
- 0 [ swap 7 shift bitor ] reduce ;
+ 0 [ [ 7 shift ] dip bitor ] reduce ; inline
: filter-text-data ( data -- filtered )
- [ printable? ] filter ;
+ [ printable? ] filter ; inline
! frame details stuff
: valid-frame-id? ( id -- ? )
- [ [ digit? ] [ LETTER? ] bi or ] all? ;
+ [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
: read-frame-id ( mmap -- id )
- 4 head-slice ;
+ 4 head-slice ; inline
: read-frame-size ( mmap -- size )
- [ 4 8 ] dip subseq ;
+ [ 4 8 ] dip subseq ; inline
: read-frame-flags ( mmap -- flags )
- [ 8 10 ] dip subseq ;
+ [ 8 10 ] dip subseq ; inline
: read-frame-data ( frame mmap -- frame data )
- [ 10 over size>> 10 + ] dip <slice> filter-text-data ;
+ [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
! read whole frames
} cleave ;
: read-frame ( mmap -- frame/f )
- dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ;
+ dup read-frame-id valid-frame-id?
+ [ (read-frame) ] [ drop f ] if ;
: remove-frame ( mmap frame -- mmap )
- size>> 10 + tail-slice ;
+ size>> 10 + tail-slice ; inline
: read-frames ( mmap -- frames )
[ dup read-frame dup ]
! header stuff
: read-header-supported-version? ( mmap -- ? )
- 3 tail-slice [ { 4 } head? ] [ { 3 } head? ] bi or ;
+ 3 tail-slice first { 3 4 } member? ; inline
-: read-header-flags ( mmap -- flags )
- 5 swap nth ;
+: read-header-flags ( mmap -- flags ) 5 swap nth ; inline
: read-header-size ( mmap -- size )
- [ 6 10 ] dip <slice> >28bitword ;
+ [ 6 10 ] dip <slice> >28bitword ; inline
: read-v2-header ( mmap -- id3header )
[ <header> ] dip
[ read-header-supported-version? >>version ]
[ read-header-flags >>flags ]
[ read-header-size >>size ]
- } cleave ;
+ } cleave ; inline
: drop-header ( mmap -- seq1 seq2 )
- dup 10 tail-slice swap ;
-
-: frame-tag ( frame string -- tag/f )
- '[ frame-id>> _ = ] find nip ; inline
-
-: parse-frames ( id3v2-info -- id3-info )
- [ <id3-info> ] dip frames>>
- {
- [ "TIT2" frame-tag [ data>> >>title ] when* ]
- [ "TALB" frame-tag [ data>> >>album ] when* ]
- [ "TPE1" frame-tag [ data>> >>artist ] when* ]
- [ "TCON" frame-tag [ data>> [ [ digit? ] filter string>number ] keep swap [ genres at nip ] when*
- >>genre ] when* ]
- [ "COMM" frame-tag [ data>> >>comment ] when* ]
- [ "TYER" frame-tag [ data>> >>year ] when* ]
- } cleave ;
+ [ 10 tail-slice ] [ ] bi ; inline
-: read-v2-tag-data ( seq -- id3-info )
- drop-header read-v2-header swap read-frames <id3v2-info> parse-frames ;
+: read-v2-tag-data ( seq -- id3v2-info )
+ drop-header read-v2-header
+ swap read-frames <id3v2-info> ; inline
! v1 information
-: skip-to-v1-data ( seq -- seq )
- 125 tail-slice* ;
+: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
-: read-title ( seq -- title )
- 30 head-slice ;
+: read-title ( seq -- title ) 30 head-slice ; inline
-: read-artist ( seq -- title )
- [ 30 60 ] dip subseq ;
+: read-artist ( seq -- title ) [ 30 60 ] dip subseq ; inline
-: read-album ( seq -- album )
- [ 60 90 ] dip subseq ;
+: read-album ( seq -- album ) [ 60 90 ] dip subseq ; inline
-: read-year ( seq -- year )
- [ 90 94 ] dip subseq ;
+: read-year ( seq -- year ) [ 90 94 ] dip subseq ; inline
-: read-comment ( seq -- comment )
- [ 94 124 ] dip subseq ;
+: read-comment ( seq -- comment ) [ 94 124 ] dip subseq ; inline
-: read-genre ( seq -- genre )
- [ 124 ] dip nth ;
+: read-genre ( seq -- genre ) [ 124 ] dip nth ; inline
: (read-v1-tag-data) ( seq -- mp3-file )
[ <id3-info> ] dip
[ read-album utf8 decode filter-text-data >>album ]
[ read-year utf8 decode filter-text-data >>year ]
[ read-comment utf8 decode filter-text-data >>comment ]
- [ read-genre >fixnum genres at >>genre ]
- } cleave ;
+ [ read-genre number>string >>genre ]
+ } cleave ; inline
: read-v1-tag-data ( seq -- mp3-file )
- skip-to-v1-data (read-v1-tag-data) ;
+ 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
PRIVATE>
-! public interface
+: 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
-: file-id3-tags ( path -- object/f )
+: 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 )
[
{
- { [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- id3v2 )
- { [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- id3-info )
- [ drop f ] ! ( mmap -- f )
+ { [ dup id3v2? ] [ read-v2-tag-data ] }
+ { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
+ [ drop f ]
} cond
] with-mapped-uchar-file ;
-
-! end