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