1 ! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: sequences io io.encodings.binary io.files io.pathnames
4 strings kernel math io.mmap io.mmap.uchar accessors syntax
5 combinators math.ranges unicode.categories byte-arrays
6 io.encodings.string io.encodings.utf16 assocs math.parser
7 combinators.short-circuit fry namespaces combinators.smart
8 splitting io.encodings.ascii arrays io.files.info unicode.case
9 io.directories.search ;
16 "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk"
17 "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies" "Other"
18 "Pop" "R&B" "Rap" "Reggae" "Rock" "Techno" "Industrial"
19 "Alternative" "Ska" "Death Metal" "Pranks" "Soundtrack"
20 "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk"
21 "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
22 "Game" "Sound Clip" "Gospel" "Noise" "AlternRock" "Bass"
23 "Soul" "Punk" "Space" "Meditative" "Instrumental Pop"
24 "Instrumental Rock" "Ethnic" "Gothic" "Darkwave"
25 "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance"
26 "Dream" "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40"
27 "Christian Rap" "Pop/Funk" "Jungle" "Native American"
28 "Cabaret" "New Wave" "Psychedelic" "Rave" "Showtunes"
29 "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka"
30 "Retro" "Musical" "Rock & Roll" "Hard Rock" "Folk"
31 "Folk-Rock" "National Folk" "Swing" "Fast Fusion" "Bebop"
32 "Latin" "Revival" "Celtic" "Bluegrass" "Avantgarde"
33 "Gothic Rock" "Progressive Rock" "Psychedelic Rock"
34 "Symphonic Rock" "Slow Rock" "Big Band" "Chorus"
35 "Easy Listening" "Acoustic" "Humour" "Speech" "Chanson"
36 "Opera" "Chamber Music" "Sonata" "Symphony" "Booty Bass"
37 "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
38 "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul"
39 "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella"
40 "Euro-House" "Dance Hall"
43 TUPLE: header version flags size ;
45 TUPLE: frame frame-id flags size data ;
47 TUPLE: id3v2-info header frames ;
49 TUPLE: id3v1-info title artist album year comment genre ;
51 : <id3v1-info> ( -- object ) id3v1-info new ;
53 : <id3v2-info> ( header frames -- object )
54 [ [ frame-id>> ] keep ] H{ } map>assoc
57 : <header> ( -- object ) header new ;
59 : <frame> ( -- object ) frame new ;
61 : id3v2? ( mmap -- ? ) "ID3" head? ; inline
63 : id3v1? ( mmap -- ? )
64 { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline
66 : id3v1-frame ( string key -- frame )
71 : id3v1>id3v2 ( id3v1 -- id3v2 )
74 [ title>> "TIT2" id3v1-frame ]
75 [ artist>> "TPE1" id3v1-frame ]
76 [ album>> "TALB" id3v1-frame ]
77 [ year>> "TYER" id3v1-frame ]
78 [ comment>> "COMM" id3v1-frame ]
79 [ genre>> "TCON" id3v1-frame ]
81 ] output>array f swap <id3v2-info> ;
83 : >28bitword ( seq -- int )
84 0 [ [ 7 shift ] dip bitor ] reduce ; inline
86 : filter-text-data ( data -- filtered )
87 [ printable? ] filter ; inline
89 : valid-frame-id? ( id -- ? )
90 [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
92 : read-frame-data ( frame mmap -- frame data )
93 [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
95 : decode-text ( string -- string' )
97 { { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
98 utf16 ascii ? decode ; inline
100 : (read-frame) ( mmap -- frame )
103 [ 4 head-slice decode-text >>frame-id ]
104 [ [ 4 8 ] dip subseq >28bitword >>size ]
105 [ [ 8 10 ] dip subseq >byte-array >>flags ]
106 [ read-frame-data decode-text >>data ]
109 : read-frame ( mmap -- frame/f )
110 dup 4 head-slice valid-frame-id?
111 [ (read-frame) ] [ drop f ] if ;
113 : remove-frame ( mmap frame -- mmap )
114 size>> 10 + tail-slice ; inline
116 : read-frames ( mmap -- frames )
117 [ dup read-frame dup ]
118 [ [ remove-frame ] keep ]
123 : read-v2-header ( seq -- id3header )
126 [ [ 3 5 ] dip <slice> >array >>version ]
127 [ [ 5 ] dip nth >>flags ]
128 [ [ 6 10 ] dip <slice> >28bitword >>size ]
131 : read-v2-tag-data ( seq -- id3v2-info )
134 [ read-frames ] bi* <id3v2-info> ; inline
138 : skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
140 : (read-v1-tag-data) ( seq -- mp3-file )
143 [ 30 head-slice decode-text filter-text-data >>title ]
144 [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
145 [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
146 [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
147 [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
148 [ [ 124 ] dip nth number>string >>genre ]
151 : read-v1-tag-data ( seq -- mp3-file )
152 skip-to-v1-data (read-v1-tag-data) ; inline
154 : parse-genre ( string -- n/f )
155 dup "(" ?head-slice drop ")" ?tail-slice drop
156 string>number dup number? [
164 : frame-named ( id3 name quot -- obj )
165 [ swap frames>> at* ] dip
166 [ data>> ] prepose [ drop f ] if ; inline
168 : id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline
170 : id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline
172 : id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline
174 : id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline
176 : id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline
178 : id3-genre ( id3 -- genre/f )
179 "TCON" [ parse-genre ] frame-named ; inline
181 : id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline
183 : (file-id3-tags) ( path -- id3v2-info/f )
186 { [ dup id3v2? ] [ read-v2-tag-data ] }
187 { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
190 ] with-mapped-uchar-file ;
192 : file-id3-tags ( path -- id3v2-info/f )
193 dup file-info size>> 0 <= [ drop f ] [ (file-id3-tags) ] if ;
195 : parse-id3s ( path -- seq )
196 [ >lower ".mp3" tail? ] find-all-files
197 [ dup file-id3-tags ] { } map>assoc ;