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
   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 continuations ;
  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&& ;
  75
  76 : id3v1+? ( seq -- ? )
  77     {
  78         [ length id3v1+-offset >= ]
  79         [ id3v1+-length tail-slice* "TAG+" head? ]
  80     } 1&& ;
  81
  82 : pair>frame ( string key -- frame/f )
  83     over [
  84         <frame>
  85             swap >>tag
  86             swap >>data
  87     ] [
  88         2drop f
  89     ] if ;
  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 ;
 105
 106 : synchsafe>seq ( n -- seq )
 107     dup 1 + log2 1 + 7 / ceiling
 108     [ [ -7 shift ] keep HEX: 7f bitand  ] replicate nip reverse ;
 109
 110 : filter-text-data ( data -- filtered )
 111     [ printable? ] filter ;
 112
 113 : valid-tag? ( id -- ? )
 114     [ { [ digit? ] [ LETTER? ] } 1|| ] all? ;
 115
 116 : read-frame-data ( frame seq -- frame data )
 117     [ 10 over size>> 10 + ] dip <slice> filter-text-data ;
 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 ;
 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 ;
 132
 133 : read-frame ( seq -- frame/f )
 134     dup 4 head-slice valid-tag?
 135     [ (read-frame) ] [ drop f ] if ;
 136
 137 : remove-frame ( seq frame -- seq )
 138     size>> 10 + tail-slice ;
 139
 140 : frames>assoc ( seq -- assoc )
 141     [ [ tag>> ] keep ] H{ } map>assoc ;
 142
 143 : read-frames ( seq -- assoc )
 144     [ dup read-frame dup ] [ [ remove-frame ] keep ] produce 2nip ;
 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 ;
 153
 154 : merge-frames ( id3 assoc -- id3 )
 155     [ dup frames>> ] dip update ;
 156
 157 : merge-id3v1 ( id3 -- id3 )
 158     dup id3v1>frames frames>assoc merge-frames ;
 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* ;
 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 ;
 174
 175 : read-v1-tags ( id3 seq -- id3 )
 176     id3v1-offset tail-slice* 3 tail-slice
 177     extract-v1-tags ;
 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 ;
 195
 196 : read-v1+-tags ( id3 seq -- id3 )
 197     id3v1+-offset tail-slice* 4 tail-slice
 198     extract-v1+-tags ;
 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 ;
 207
 208 PRIVATE>
 209
 210 : mp3>id3 ( path -- id3/f )
 211     [
 212         [ <id3> ] dip
 213         {
 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         } cleave
 218     ] with-mapped-uchar-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 ;