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 ; inline
53 : <id3v2-info> ( header frames -- object )
54 [ [ frame-id>> ] keep ] H{ } map>assoc id3v2-info boa ;
56 : <header> ( -- object ) header new ; inline
58 : <frame> ( -- object ) frame new ; inline
60 : id3v2? ( mmap -- ? ) "ID3" head? ; inline
62 : id3v1? ( mmap -- ? )
63 { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline
65 : id3v1-frame ( string key -- frame )
70 : id3v1>id3v2 ( id3v1 -- id3v2 )
73 [ title>> "TIT2" id3v1-frame ]
74 [ artist>> "TPE1" id3v1-frame ]
75 [ album>> "TALB" id3v1-frame ]
76 [ year>> "TYER" id3v1-frame ]
77 [ comment>> "COMM" id3v1-frame ]
78 [ genre>> "TCON" id3v1-frame ]
80 ] output>array f swap <id3v2-info> ; inline
82 : >28bitword ( seq -- int )
83 0 [ [ 7 shift ] dip bitor ] reduce ; inline
85 : filter-text-data ( data -- filtered )
86 [ printable? ] filter ; inline
88 : valid-frame-id? ( id -- ? )
89 [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
91 : read-frame-data ( frame mmap -- frame data )
92 [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
94 : decode-text ( string -- string' )
96 { { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
97 utf16 ascii ? decode ; inline
99 : (read-frame) ( mmap -- frame )
102 [ 4 head-slice decode-text >>frame-id ]
103 [ [ 4 8 ] dip subseq >28bitword >>size ]
104 [ [ 8 10 ] dip subseq >byte-array >>flags ]
105 [ read-frame-data decode-text >>data ]
108 : read-frame ( mmap -- frame/f )
109 dup 4 head-slice valid-frame-id?
110 [ (read-frame) ] [ drop f ] if ; inline
112 : remove-frame ( mmap frame -- mmap )
113 size>> 10 + tail-slice ; inline
115 : read-frames ( mmap -- frames )
116 [ dup read-frame dup ]
117 [ [ remove-frame ] keep ]
118 produce 2nip ; inline
120 : read-v2-header ( seq -- id3header )
123 [ [ 3 5 ] dip <slice> >array >>version ]
124 [ [ 5 ] dip nth >>flags ]
125 [ [ 6 10 ] dip <slice> >28bitword >>size ]
128 : read-v2-tag-data ( seq -- id3v2-info )
131 [ read-frames ] bi* <id3v2-info> ; inline
133 : skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
135 : (read-v1-tag-data) ( seq -- mp3-file )
138 [ 30 head-slice decode-text filter-text-data >>title ]
139 [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
140 [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
141 [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
142 [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
143 [ [ 124 ] dip nth number>string >>genre ]
146 : read-v1-tag-data ( seq -- mp3-file )
147 skip-to-v1-data (read-v1-tag-data) ; inline
149 : parse-genre ( string -- n/f )
150 dup "(" ?head-slice drop ")" ?tail-slice drop
151 string>number dup number? [
157 : (mp3>id3) ( path -- id3v2-info/f )
160 { [ dup id3v2? ] [ read-v2-tag-data ] }
161 { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
164 ] with-mapped-uchar-file ;
168 : mp3>id3 ( path -- id3v2-info/f )
169 dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline
171 : find-id3-frame ( id3 name -- obj/f )
172 swap frames>> at* [ data>> ] when ; inline
174 : title ( id3 -- title/f ) "TIT2" find-id3-frame ; inline
176 : artist ( id3 -- artist/f ) "TPE1" find-id3-frame ; inline
178 : album ( id3 -- album/f ) "TALB" find-id3-frame ; inline
180 : year ( id3 -- year/f ) "TYER" find-id3-frame ; inline
182 : comment ( id3 -- comment/f ) "COMM" find-id3-frame ; inline
184 : genre ( id3 -- genre/f )
185 "TCON" find-id3-frame parse-genre ; inline
187 : find-mp3s ( path -- seq )
188 [ >lower ".mp3" tail? ] find-all-files ; inline
190 : mp3-paths>id3s ( seq -- seq' )
191 [ dup mp3>id3 ] { } map>assoc ; inline
193 : parse-mp3-directory ( path -- seq )
194 find-mp3s mp3-paths>id3s ;