1 ! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs byte-arrays
4 combinators combinators.short-circuit combinators.smart
5 continuations io.directories io.encodings.ascii
6 io.encodings.string io.encodings.utf16 io.mmap kernel math
7 math.functions math.parser sequences splitting unicode ;
8 FROM: alien.c-types => uchar ;
15 "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk"
16 "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies" "Other"
17 "Pop" "R&B" "Rap" "Reggae" "Rock" "Techno" "Industrial"
18 "Alternative" "Ska" "Death Metal" "Pranks" "Soundtrack"
19 "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk"
20 "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
21 "Game" "Sound Clip" "Gospel" "Noise" "AlternRock" "Bass"
22 "Soul" "Punk" "Space" "Meditative" "Instrumental Pop"
23 "Instrumental Rock" "Ethnic" "Gothic" "Darkwave"
24 "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance"
25 "Dream" "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40"
26 "Christian Rap" "Pop/Funk" "Jungle" "Native American"
27 "Cabaret" "New Wave" "Psychedelic" "Rave" "Showtunes"
28 "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka"
29 "Retro" "Musical" "Rock & Roll" "Hard Rock" "Folk"
30 "Folk-Rock" "National Folk" "Swing" "Fast Fusion" "Bebop"
31 "Latin" "Revival" "Celtic" "Bluegrass" "Avantgarde"
32 "Gothic Rock" "Progressive Rock" "Psychedelic Rock"
33 "Symphonic Rock" "Slow Rock" "Big Band" "Chorus"
34 "Easy Listening" "Acoustic" "Humour" "Speech" "Chanson"
35 "Opera" "Chamber Music" "Sonata" "Symphony" "Booty Bass"
36 "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
37 "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul"
38 "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella"
39 "Euro-House" "Dance Hall" "Goa" "Drum & Bass" "Club-House"
40 "Hardcore" "Terror" "Indie" "BritPop" "Negerpunk"
41 "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
42 "Black Metal" "Crossover" "Contemporary Christian"
46 TUPLE: header version flags size ;
48 TUPLE: frame tag flags size data ;
50 TUPLE: id3 header frames
51 title artist album year comment genre
52 speed genre-name start-time end-time ;
56 H{ } clone >>frames ; inline
58 : <header> ( -- object ) header new ; inline
60 : <frame> ( -- object ) frame new ; inline
62 : id3v2? ( seq -- ? ) "ID3" head? ; inline
64 CONSTANT: id3v1-length 128
65 CONSTANT: id3v1-offset 128
66 CONSTANT: id3v1+-length 227
67 : id3v1+-offset ( -- n ) id3v1-length id3v1+-length + ; inline
71 [ length id3v1-offset >= ]
72 [ id3v1-length tail-slice* "TAG" head? ]
75 : id3v1+? ( seq -- ? )
77 [ length id3v1+-offset >= ]
78 [ id3v1+-length tail-slice* "TAG+" head? ]
81 : pair>frame ( string key -- frame/f )
90 : id3v1>frames ( id3v1 -- seq )
93 [ title>> "TIT2" pair>frame ]
94 [ artist>> "TPE1" pair>frame ]
95 [ album>> "TALB" pair>frame ]
96 [ year>> "TYER" pair>frame ]
97 [ comment>> "COMM" pair>frame ]
98 [ genre>> "TCON" pair>frame ]
100 ] output>array sift ;
102 : sequence>synchsafe ( seq -- n )
103 0 [ [ 7 shift ] dip bitor ] reduce ;
105 : synchsafe>sequence ( n -- seq )
106 dup 1 + log2 1 + 7 / ceiling
107 [ [ -7 shift ] keep 0x7f bitand ] replicate nip reverse ;
109 : filter-text-data ( data -- filtered )
110 [ printable? ] filter ;
112 : valid-tag? ( id -- ? )
113 [ { [ digit? ] [ LETTER? ] } 1|| ] all? ;
115 : read-frame-data ( frame seq -- frame data )
116 [ 10 over size>> 10 + ] dip <slice> filter-text-data ;
118 : decode-text ( string -- string' )
119 dup 2 index-or-length head
120 { { 0xff 0xfe } { 0xfe 0xff } } member?
121 utf16 ascii ? decode ;
123 : (read-frame) ( seq -- frame )
126 [ 4 head-slice decode-text >>tag ]
127 [ [ 4 8 ] dip subseq sequence>synchsafe >>size ]
128 [ [ 8 10 ] dip subseq >byte-array >>flags ]
129 [ read-frame-data decode-text >>data ]
132 : read-frame ( seq -- frame/f )
133 dup 4 head-slice valid-tag?
134 [ (read-frame) ] [ drop f ] if ;
136 : remove-frame ( seq frame -- seq )
137 size>> 10 + tail-slice ;
139 : frames>assoc ( seq -- assoc )
140 [ [ tag>> ] keep ] H{ } map>assoc ;
142 : read-frames ( seq -- assoc )
143 [ dup read-frame dup ] [ [ remove-frame ] keep ] produce 2nip ;
145 : read-v2-header ( seq -- header )
148 [ [ 3 5 ] dip <slice> >array >>version ]
149 [ [ 5 ] dip nth >>flags ]
150 [ [ 6 10 ] dip <slice> sequence>synchsafe >>size ]
153 : merge-frames ( id3 assoc -- id3 )
154 [ dup frames>> ] dip assoc-union! drop ;
156 : merge-id3v1 ( id3 -- id3 )
157 dup id3v1>frames frames>assoc merge-frames ;
159 : read-v2-tags ( id3 seq -- id3 )
161 [ read-v2-header >>header ]
162 [ read-frames frames>assoc merge-frames ] bi* ;
164 : extract-v1-tags ( id3 seq -- id3 )
166 [ 30 head-slice decode-text filter-text-data >>title ]
167 [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
168 [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
169 [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
170 [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
171 [ [ 124 ] dip nth number>string >>genre ]
174 : read-v1-tags ( id3 seq -- id3 )
175 id3v1-offset tail-slice* 3 tail-slice
178 : extract-v1+-tags ( id3 seq -- id3 )
180 [ 60 head-slice decode-text filter-text-data [ append ] change-title ]
182 [ 60 120 ] dip subseq decode-text filter-text-data
183 [ append ] change-artist
186 [ 120 180 ] dip subseq decode-text filter-text-data
187 [ append ] change-album
189 [ [ 180 ] dip nth >>speed ]
190 [ [ 181 211 ] dip subseq decode-text >>genre-name ]
191 [ [ 211 217 ] dip subseq decode-text >>start-time ]
192 [ [ 217 223 ] dip subseq decode-text >>end-time ]
195 : read-v1+-tags ( id3 seq -- id3 )
196 id3v1+-offset tail-slice* 4 tail-slice
199 : parse-genre ( string -- n/f )
200 dup "(" ?head-slice drop ")" ?tail-slice drop
201 string>number dup number? [
209 : mp3>id3 ( path -- id3/f )
211 [ <id3> ] dip uchar <mapped-array>
212 [ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
213 [ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
214 [ dup id3v2? [ read-v2-tags ] [ drop ] if ]
216 ] with-mapped-file-reader ;
218 : find-id3-frame ( id3 name -- obj/f )
219 swap frames>> at* [ data>> ] when ;
221 : title ( id3 -- string/f ) "TIT2" find-id3-frame ;
223 : artist ( id3 -- string/f ) "TPE1" find-id3-frame ;
225 : album ( id3 -- string/f ) "TALB" find-id3-frame ;
227 : year ( id3 -- string/f ) "TYER" find-id3-frame ;
229 : comment ( id3 -- string/f ) "COMM" find-id3-frame ;
231 : genre ( id3 -- string/f )
232 "TCON" find-id3-frame parse-genre ;
234 : find-mp3s ( path -- seq ) ".mp3" find-files-by-extension ;
236 ERROR: id3-parse-error path error ;
238 : (mp3-paths>id3s) ( seq -- seq' )
239 [ dup [ mp3>id3 ] [ \ id3-parse-error boa ] recover ] { } map>assoc ;
241 : mp3-paths>id3s ( seq -- seq' )
243 [ dup second id3-parse-error? [ f over set-second ] when ] map ;
245 : parse-mp3-directory ( path -- seq )
246 find-mp3s mp3-paths>id3s ;