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 ;
  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"
  41     }
  42
  43 TUPLE: header version flags size ;
  44
  45 TUPLE: frame frame-id flags size data ;
  46
  47 TUPLE: id3v2-info header frames ;
  48
  49 TUPLE: id3v1-info title artist album year comment genre ;
  50
  51 : <id3v1-info> ( -- object ) id3v1-info new ;
  52
  53 : <id3v2-info> ( header frames -- object )
  54     [ [ frame-id>> ] keep ] H{ } map>assoc
  55     id3v2-info boa ;
  56
  57 : <header> ( -- object ) header new ;
  58
  59 : <frame> ( -- object ) frame new ;
  60
  61 : id3v2? ( mmap -- ? ) "ID3" head? ; inline
  62
  63 : id3v1? ( mmap -- ? )
  64     { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline
  65
  66 : id3v1-frame ( string key -- frame )
  67     <frame>
  68         swap >>frame-id
  69         swap >>data ;
  70
  71 : id3v1>id3v2 ( id3v1 -- id3v2 )
  72     [
  73         {
  74             [ title>> "TIT2" id3v1-frame ]
  75             [ artist>> "TPE1" id3v1-frame ]
  76             [ album>> "TALB" id3v1-frame ]
  77             [ year>> "TYER" id3v1-frame ]
  78             [ comment>> "COMM" id3v1-frame ]
  79             [ genre>> "TCON" id3v1-frame ]
  80         } cleave
  81     ] output>array f swap <id3v2-info> ;
  82
  83 : >28bitword ( seq -- int )
  84     0 [ [ 7 shift ] dip bitor ] reduce ; inline
  85
  86 : filter-text-data ( data -- filtered )
  87     [ printable? ] filter ; inline
  88
  89 : valid-frame-id? ( id -- ? )
  90     [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
  91
  92 : read-frame-data ( frame mmap -- frame data )
  93     [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
  94
  95 : decode-text ( string -- string' )
  96     dup 2 short head
  97     { { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
  98     utf16 ascii ? decode ; inline
  99
 100 : (read-frame) ( mmap -- frame )
 101     [ <frame> ] dip
 102     {
 103         [ 4 head-slice decode-text >>frame-id ]
 104         [ [ 4 8 ] dip subseq >28bitword >>size ]
 105         [ [ 8 10 ] dip subseq >byte-array >>flags ]
 106         [ read-frame-data decode-text >>data ]
 107     } cleave ;
 108
 109 : read-frame ( mmap -- frame/f )
 110     dup 4 head-slice valid-frame-id?
 111     [ (read-frame) ] [ drop f ] if ;
 112
 113 : remove-frame ( mmap frame -- mmap )
 114     size>> 10 + tail-slice ; inline
 115
 116 : read-frames ( mmap -- frames )
 117     [ dup read-frame dup ]
 118     [ [ remove-frame ] keep ]
 119     produce 2nip ;
 120
 121 ! header stuff
 122
 123 : read-v2-header ( seq -- id3header )
 124     [ <header> ] dip
 125     {
 126         [ [ 3 5 ] dip <slice> >array >>version ]
 127         [ [ 5 ] dip nth >>flags ]
 128         [ [ 6 10 ] dip <slice> >28bitword >>size ]
 129     } cleave ; inline
 130
 131 : read-v2-tag-data ( seq -- id3v2-info )
 132     10 cut-slice
 133     [ read-v2-header ]
 134     [ read-frames ] bi* <id3v2-info> ; inline
 135
 136 ! v1 information
 137
 138 : skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
 139
 140 : (read-v1-tag-data) ( seq -- mp3-file )
 141     [ <id3v1-info> ] dip
 142     {
 143         [ 30 head-slice decode-text filter-text-data >>title ]
 144         [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
 145         [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
 146         [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
 147         [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
 148         [ [ 124 ] dip nth number>string >>genre ]
 149     } cleave ; inline
 150
 151 : read-v1-tag-data ( seq -- mp3-file )
 152     skip-to-v1-data (read-v1-tag-data) ; inline
 153
 154 : parse-genre ( string -- n/f )
 155     dup "(" ?head-slice drop ")" ?tail-slice drop
 156     string>number dup number? [
 157         genres ?nth swap or
 158     ] [
 159         drop
 160     ] if ; inline
 161
 162 PRIVATE>
 163
 164 : frame-named ( id3 name quot -- obj )
 165     [ swap frames>> at* ] dip
 166     [ data>> ] prepose [ drop f ] if ; inline
 167
 168 : id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline
 169
 170 : id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline
 171
 172 : id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline
 173
 174 : id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline
 175
 176 : id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline
 177
 178 : id3-genre ( id3 -- genre/f )
 179     "TCON" [ parse-genre ] frame-named ; inline
 180
 181 : id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline
 182
 183 : (file-id3-tags) ( path -- id3v2-info/f )
 184     [
 185         {
 186             { [ dup id3v2? ] [ read-v2-tag-data ] }
 187             { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
 188             [ drop f ]
 189         } cond
 190     ] with-mapped-uchar-file ;
 191
 192 : file-id3-tags ( path -- id3v2-info/f )
 193     dup file-info size>> 0 <= [ drop f ] [ (file-id3-tags) ] if ;
 194
 195 : parse-id3s ( path -- seq )
 196     [ >lower ".mp3" tail? ] find-all-files
 197     [ dup file-id3-tags ] { } map>assoc ;