extra/id3/id3.factor

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