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 ;
   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"
  40     }
  41
  42 TUPLE: header version flags size ;
  43
  44 TUPLE: frame frame-id flags size data ;
  45
  46 TUPLE: id3v2-info header frames ;
  47
  48 TUPLE: id3v1-info title artist album year comment genre ;
  49
  50 : <id3v1-info> ( -- object ) id3v1-info new ;
  51
  52 : <id3v2-info> ( header frames -- object )
  53     [ [ frame-id>> ] keep ] H{ } map>assoc
  54     id3v2-info boa ;
  55
  56 : <header> ( -- object ) header new ;
  57
  58 : <frame> ( -- object ) frame new ;
  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 ;
  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> ;
  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 ;
 107
 108 : read-frame ( mmap -- frame/f )
 109     dup 4 head-slice valid-frame-id?
 110     [ (read-frame) ] [ drop f ] if ;
 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 ;
 119
 120 ! header stuff
 121
 122 : read-v2-header ( seq -- id3header )
 123     [ <header> ] dip
 124     {
 125         [ [ 3 5 ] dip <slice> >array >>version ]
 126         [ [ 5 ] dip nth >>flags ]
 127         [ [ 6 10 ] dip <slice> >28bitword >>size ]
 128     } cleave ; inline
 129
 130 : read-v2-tag-data ( seq -- id3v2-info )
 131     10 cut-slice
 132     [ read-v2-header ]
 133     [ read-frames ] bi* <id3v2-info> ; inline
 134
 135 ! v1 information
 136
 137 : skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
 138
 139 : (read-v1-tag-data) ( seq -- mp3-file )
 140     [ <id3v1-info> ] dip
 141     {
 142         [ 30 head-slice decode-text filter-text-data >>title ]
 143         [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
 144         [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
 145         [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
 146         [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
 147         [ [ 124 ] dip nth number>string >>genre ]
 148     } cleave ; inline
 149
 150 : read-v1-tag-data ( seq -- mp3-file )
 151     skip-to-v1-data (read-v1-tag-data) ; inline
 152
 153 : parse-genre ( string -- n/f )
 154     dup "(" ?head-slice drop ")" ?tail-slice drop
 155     string>number dup number? [
 156         genres ?nth swap or
 157     ] [
 158         drop
 159     ] if ; inline
 160
 161 PRIVATE>
 162
 163 : frame-named ( id3 name quot -- obj )
 164     [ swap frames>> at* ] dip
 165     [ data>> ] prepose [ drop f ] if ; inline
 166
 167 : id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline
 168
 169 : id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline
 170
 171 : id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline
 172
 173 : id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline
 174
 175 : id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline
 176
 177 : id3-genre ( id3 -- genre/f )
 178     "TCON" [ parse-genre ] frame-named ; inline
 179
 180 : id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline
 181
 182 : (file-id3-tags) ( path -- id3v2-info/f )
 183     [
 184         {
 185             { [ dup id3v2? ] [ read-v2-tag-data ] }
 186             { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
 187             [ drop f ]
 188         } cond
 189     ] with-mapped-uchar-file ;
 190
 191 : file-id3-tags ( path -- id3v2-info/f )
 192     dup file-info size>> 0 <= [ drop f ] [ (file-id3-tags) ] if ;