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