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 accessors combinators math.ranges
5 unicode.categories byte-arrays io.encodings.string
6 io.encodings.utf16 assocs math.parser combinators.short-circuit
7 fry namespaces combinators.smart splitting io.encodings.ascii
8 arrays io.files.info unicode.case io.directories.search literals
9 math.functions continuations ;
10 FROM: alien.c-types => uchar ;
17 "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk"
18 "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies" "Other"
19 "Pop" "R&B" "Rap" "Reggae" "Rock" "Techno" "Industrial"
20 "Alternative" "Ska" "Death Metal" "Pranks" "Soundtrack"
21 "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk"
22 "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
23 "Game" "Sound Clip" "Gospel" "Noise" "AlternRock" "Bass"
24 "Soul" "Punk" "Space" "Meditative" "Instrumental Pop"
25 "Instrumental Rock" "Ethnic" "Gothic" "Darkwave"
26 "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance"
27 "Dream" "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40"
28 "Christian Rap" "Pop/Funk" "Jungle" "Native American"
29 "Cabaret" "New Wave" "Psychedelic" "Rave" "Showtunes"
30 "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka"
31 "Retro" "Musical" "Rock & Roll" "Hard Rock" "Folk"
32 "Folk-Rock" "National Folk" "Swing" "Fast Fusion" "Bebop"
33 "Latin" "Revival" "Celtic" "Bluegrass" "Avantgarde"
34 "Gothic Rock" "Progressive Rock" "Psychedelic Rock"
35 "Symphonic Rock" "Slow Rock" "Big Band" "Chorus"
36 "Easy Listening" "Acoustic" "Humour" "Speech" "Chanson"
37 "Opera" "Chamber Music" "Sonata" "Symphony" "Booty Bass"
38 "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
39 "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul"
40 "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella"
41 "Euro-House" "Dance Hall" "Goa" "Drum & Bass" "Club-House"
42 "Hardcore" "Terror" "Indie" "BritPop" "Negerpunk"
43 "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
44 "Black Metal" "Crossover" "Contemporary Christian"
48 TUPLE: header version flags size ;
50 TUPLE: frame tag flags size data ;
52 TUPLE: id3 header frames
53 title artist album year comment genre
54 speed genre-name start-time end-time ;
58 H{ } clone >>frames ; inline
60 : <header> ( -- object ) header new ; inline
62 : <frame> ( -- object ) frame new ; inline
64 : id3v2? ( seq -- ? ) "ID3" head? ; inline
66 CONSTANT: id3v1-length 128
67 CONSTANT: id3v1-offset 128
68 CONSTANT: id3v1+-length 227
69 : id3v1+-offset ( -- n ) id3v1-length id3v1+-length + ; inline
73 [ length id3v1-offset >= ]
74 [ id3v1-length tail-slice* "TAG" head? ]
77 : id3v1+? ( seq -- ? )
79 [ length id3v1+-offset >= ]
80 [ id3v1+-length tail-slice* "TAG+" head? ]
83 : pair>frame ( string key -- frame/f )
92 : id3v1>frames ( id3v1 -- seq )
95 [ title>> "TIT2" pair>frame ]
96 [ artist>> "TPE1" pair>frame ]
97 [ album>> "TALB" pair>frame ]
98 [ year>> "TYER" pair>frame ]
99 [ comment>> "COMM" pair>frame ]
100 [ genre>> "TCON" pair>frame ]
102 ] output>array sift ;
104 : sequence>synchsafe ( seq -- n )
105 0 [ [ 7 shift ] dip bitor ] reduce ;
107 : synchsafe>sequence ( n -- seq )
108 dup 1 + log2 1 + 7 / ceiling
109 [ [ -7 shift ] keep 0x7f bitand ] replicate nip reverse ;
111 : filter-text-data ( data -- filtered )
112 [ printable? ] filter ;
114 : valid-tag? ( id -- ? )
115 [ { [ digit? ] [ LETTER? ] } 1|| ] all? ;
117 : read-frame-data ( frame seq -- frame data )
118 [ 10 over size>> 10 + ] dip <slice> filter-text-data ;
120 : decode-text ( string -- string' )
122 { { 0xff 0xfe } { 0xfe 0xff } } member?
123 utf16 ascii ? decode ;
125 : (read-frame) ( seq -- frame )
128 [ 4 head-slice decode-text >>tag ]
129 [ [ 4 8 ] dip subseq sequence>synchsafe >>size ]
130 [ [ 8 10 ] dip subseq >byte-array >>flags ]
131 [ read-frame-data decode-text >>data ]
134 : read-frame ( seq -- frame/f )
135 dup 4 head-slice valid-tag?
136 [ (read-frame) ] [ drop f ] if ;
138 : remove-frame ( seq frame -- seq )
139 size>> 10 + tail-slice ;
141 : frames>assoc ( seq -- assoc )
142 [ [ tag>> ] keep ] H{ } map>assoc ;
144 : read-frames ( seq -- assoc )
145 [ dup read-frame dup ] [ [ remove-frame ] keep ] produce 2nip ;
147 : read-v2-header ( seq -- header )
150 [ [ 3 5 ] dip <slice> >array >>version ]
151 [ [ 5 ] dip nth >>flags ]
152 [ [ 6 10 ] dip <slice> sequence>synchsafe >>size ]
155 : merge-frames ( id3 assoc -- id3 )
156 [ dup frames>> ] dip assoc-union! drop ;
158 : merge-id3v1 ( id3 -- id3 )
159 dup id3v1>frames frames>assoc merge-frames ;
161 : read-v2-tags ( id3 seq -- id3 )
163 [ read-v2-header >>header ]
164 [ read-frames frames>assoc merge-frames ] bi* ;
166 : extract-v1-tags ( id3 seq -- id3 )
168 [ 30 head-slice decode-text filter-text-data >>title ]
169 [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
170 [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
171 [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
172 [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
173 [ [ 124 ] dip nth number>string >>genre ]
176 : read-v1-tags ( id3 seq -- id3 )
177 id3v1-offset tail-slice* 3 tail-slice
180 : extract-v1+-tags ( id3 seq -- id3 )
182 [ 60 head-slice decode-text filter-text-data [ append ] change-title ]
184 [ 60 120 ] dip subseq decode-text filter-text-data
185 [ append ] change-artist
188 [ 120 180 ] dip subseq decode-text filter-text-data
189 [ append ] change-album
191 [ [ 180 ] dip nth >>speed ]
192 [ [ 181 211 ] dip subseq decode-text >>genre-name ]
193 [ [ 211 217 ] dip subseq decode-text >>start-time ]
194 [ [ 217 223 ] dip subseq decode-text >>end-time ]
197 : read-v1+-tags ( id3 seq -- id3 )
198 id3v1+-offset tail-slice* 4 tail-slice
201 : parse-genre ( string -- n/f )
202 dup "(" ?head-slice drop ")" ?tail-slice drop
203 string>number dup number? [
211 : mp3>id3 ( path -- id3/f )
213 [ <id3> ] dip uchar <mapped-array>
214 [ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
215 [ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
216 [ dup id3v2? [ read-v2-tags ] [ drop ] if ]
218 ] with-mapped-file-reader ;
220 : find-id3-frame ( id3 name -- obj/f )
221 swap frames>> at* [ data>> ] when ;
223 : title ( id3 -- string/f ) "TIT2" find-id3-frame ;
225 : artist ( id3 -- string/f ) "TPE1" find-id3-frame ;
227 : album ( id3 -- string/f ) "TALB" find-id3-frame ;
229 : year ( id3 -- string/f ) "TYER" find-id3-frame ;
231 : comment ( id3 -- string/f ) "COMM" find-id3-frame ;
233 : genre ( id3 -- string/f )
234 "TCON" find-id3-frame parse-genre ;
236 : find-mp3s ( path -- seq ) ".mp3" find-by-extension ;
238 ERROR: id3-parse-error path error ;
240 : (mp3-paths>id3s) ( seq -- seq' )
241 [ dup [ mp3>id3 ] [ \ id3-parse-error boa ] recover ] { } map>assoc ;
243 : mp3-paths>id3s ( seq -- seq' )
245 [ dup second id3-parse-error? [ f over set-second ] when ] map ;
247 : parse-mp3-directory ( path -- seq )
248 find-mp3s mp3-paths>id3s ;