extra/id3/id3.factor

   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 literals math.functions ;
  10 IN: id3
  11
  12 <PRIVATE
  13
  14 CONSTANT: genres
  15     {
  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" "Goa" "Drum & Bass" "Club-House"
  41         "Hardcore" "Terror" "Indie" "BritPop" "Negerpunk"
  42         "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
  43         "Black Metal" "Crossover" "Contemporary Christian"
  44         "Christian Rock"
  45     }
  46
  47 TUPLE: header version flags size ;
  48
  49 TUPLE: frame tag flags size data ;
  50
  51 TUPLE: id3 header frames
  52 title artist album year comment genre
  53 speed genre-name start-time end-time ;
  54
  55 : <id3> ( -- id3 )
  56     id3 new
  57     H{ } clone >>frames ; inline
  58
  59 : <header> ( -- object ) header new ; inline
  60
  61 : <frame> ( -- object ) frame new ; inline
  62
  63 : id3v2? ( seq -- ? ) "ID3" head? ; inline
  64
  65 CONSTANT: id3v1-length 128
  66 CONSTANT: id3v1-offset 128
  67 CONSTANT: id3v1+-length 227
  68 CONSTANT: id3v1+-offset $[ 128 227 + ]
  69
  70 : id3v1? ( seq -- ? )
  71     {
  72         [ length id3v1-offset >= ]
  73         [ id3v1-length tail-slice* "TAG" head? ]
  74     } 1&& ; inline
  75
  76 : id3v1+? ( seq -- ? )
  77     {
  78         [ length id3v1+-offset >= ]
  79         [ id3v1+-length tail-slice* "TAG+" head? ]
  80     } 1&& ; inline
  81
  82 : pair>frame ( string key -- frame/f )
  83     over [
  84         <frame>
  85             swap >>tag
  86             swap >>data
  87     ] [
  88         2drop f
  89     ] if ; inline
  90
  91 : id3v1>frames ( id3v1 -- seq )
  92     [
  93         {
  94             [ title>> "TIT2" pair>frame ]
  95             [ artist>> "TPE1" pair>frame ]
  96             [ album>> "TALB" pair>frame ]
  97             [ year>> "TYER" pair>frame ]
  98             [ comment>> "COMM" pair>frame ]
  99             [ genre>> "TCON" pair>frame ]
 100         } cleave
 101     ] output>array sift ;
 102
 103 : seq>synchsafe ( seq -- n )
 104     0 [ [ 7 shift ] dip bitor ] reduce ; inline
 105
 106 : synchsafe>seq ( n -- seq )
 107     dup 1+ log2 1+ 7 / ceiling
 108     [ [ -7 shift ] keep HEX: 7f bitand  ] replicate nip reverse ; inline
 109
 110 : filter-text-data ( data -- filtered )
 111     [ printable? ] filter ; inline
 112
 113 : valid-tag? ( id -- ? )
 114     [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
 115
 116 : read-frame-data ( frame seq -- frame data )
 117     [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
 118
 119 : decode-text ( string -- string' )
 120     dup 2 short head
 121     { { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
 122     utf16 ascii ? decode ; inline
 123
 124 : (read-frame) ( seq -- frame )
 125     [ <frame> ] dip
 126     {
 127         [ 4 head-slice decode-text >>tag ]
 128         [ [ 4 8 ] dip subseq seq>synchsafe >>size ]
 129         [ [ 8 10 ] dip subseq >byte-array >>flags ]
 130         [ read-frame-data decode-text >>data ]
 131     } cleave ; inline
 132
 133 : read-frame ( seq -- frame/f )
 134     dup 4 head-slice valid-tag?
 135     [ (read-frame) ] [ drop f ] if ; inline
 136
 137 : remove-frame ( seq frame -- seq )
 138     size>> 10 + tail-slice ; inline
 139
 140 : frames>assoc ( seq -- assoc )
 141     [ [ tag>> ] keep ] H{ } map>assoc ; inline
 142
 143 : read-frames ( seq -- assoc )
 144     [ dup read-frame dup ] [ [ remove-frame ] keep ] produce 2nip ; inline
 145
 146 : read-v2-header ( seq -- header )
 147     [ <header> ] dip
 148     {
 149         [ [ 3 5 ] dip <slice> >array >>version ]
 150         [ [ 5 ] dip nth >>flags ]
 151         [ [ 6 10 ] dip <slice> seq>synchsafe >>size ]
 152     } cleave ; inline
 153
 154 : merge-frames ( id3 assoc -- id3 )
 155     [ dup frames>> ] dip update ; inline
 156
 157 : merge-id3v1 ( id3 -- id3 )
 158     dup id3v1>frames frames>assoc merge-frames ; inline
 159
 160 : read-v2-tags ( id3 seq -- id3 )
 161     10 cut-slice
 162     [ read-v2-header >>header ]
 163     [ read-frames frames>assoc merge-frames ] bi* ; inline
 164
 165 : extract-v1-tags ( id3 seq -- id3 )
 166     {
 167         [ 30 head-slice decode-text filter-text-data >>title ]
 168         [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
 169         [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
 170         [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
 171         [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
 172         [ [ 124 ] dip nth number>string >>genre ]
 173     } cleave ; inline
 174
 175 : read-v1-tags ( id3 seq -- id3 )
 176     id3v1-offset tail-slice* 3 tail-slice
 177     extract-v1-tags ; inline
 178
 179 : extract-v1+-tags ( id3 seq -- id3 )
 180     {
 181         [ 60 head-slice decode-text filter-text-data [ append ] change-title ]
 182         [
 183             [ 60 120 ] dip subseq decode-text filter-text-data
 184             [ append ] change-artist
 185         ]
 186         [
 187             [ 120 180 ] dip subseq decode-text filter-text-data
 188             [ append ] change-album
 189         ]
 190         [ [ 180 ] dip nth >>speed ]
 191         [ [ 181 211 ] dip subseq decode-text >>genre-name ]
 192         [ [ 211 217 ] dip subseq decode-text >>start-time ]
 193         [ [ 217 223 ] dip subseq decode-text >>end-time ]
 194     } cleave ; inline
 195
 196 : read-v1+-tags ( id3 seq -- id3 )
 197     id3v1+-offset tail-slice* 4 tail-slice
 198     extract-v1+-tags ; inline
 199
 200 : parse-genre ( string -- n/f )
 201     dup "(" ?head-slice drop ")" ?tail-slice drop
 202     string>number dup number? [
 203         genres ?nth swap or
 204     ] [
 205         drop
 206     ] if ; inline
 207
 208 : (mp3>id3) ( path -- id3v2/f )
 209     [
 210         [ <id3> ] dip
 211         {
 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 ]
 215         } cleave
 216     ] with-mapped-uchar-file ;
 217
 218 PRIVATE>
 219
 220 : mp3>id3 ( path -- id3/f )
 221     dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline
 222
 223 : find-id3-frame ( id3 name -- obj/f )
 224     swap frames>> at* [ data>> ] when ; inline
 225
 226 : title ( id3 -- string/f ) "TIT2" find-id3-frame ; inline
 227
 228 : artist ( id3 -- string/f ) "TPE1" find-id3-frame ; inline
 229
 230 : album ( id3 -- string/f ) "TALB" find-id3-frame ; inline
 231
 232 : year ( id3 -- string/f ) "TYER" find-id3-frame ; inline
 233
 234 : comment ( id3 -- string/f ) "COMM" find-id3-frame ; inline
 235
 236 : genre ( id3 -- string/f )
 237     "TCON" find-id3-frame parse-genre ; inline
 238
 239 : find-mp3s ( path -- seq )
 240     [ >lower ".mp3" tail? ] find-all-files ; inline
 241
 242 : mp3-paths>id3s ( seq -- seq' )
 243     [ dup mp3>id3 ] { } map>assoc ; inline
 244
 245 : parse-mp3-directory ( path -- seq )
 246     find-mp3s mp3-paths>id3s ;