! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences io io.encodings.binary io.files io.pathnames
-strings kernel math io.mmap io.mmap.uchar accessors syntax
+strings kernel math io.mmap io.mmap.uchar accessors
combinators math.ranges unicode.categories byte-arrays
io.encodings.string io.encodings.utf16 assocs math.parser
combinators.short-circuit fry namespaces combinators.smart
splitting io.encodings.ascii arrays io.files.info unicode.case
-io.directories.search ;
+io.directories.search literals math.functions continuations ;
IN: id3
<PRIVATE
"Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
"Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul"
"Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella"
- "Euro-House" "Dance Hall"
+ "Euro-House" "Dance Hall" "Goa" "Drum & Bass" "Club-House"
+ "Hardcore" "Terror" "Indie" "BritPop" "Negerpunk"
+ "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
+ "Black Metal" "Crossover" "Contemporary Christian"
+ "Christian Rock"
}
TUPLE: header version flags size ;
-TUPLE: frame frame-id flags size data ;
+TUPLE: frame tag flags size data ;
-TUPLE: id3v2-info header frames ;
+TUPLE: id3 header frames
+title artist album year comment genre
+speed genre-name start-time end-time ;
-TUPLE: id3v1-info title artist album year comment genre ;
-
-: <id3v1-info> ( -- object ) id3v1-info new ; inline
-
-: <id3v2-info> ( header frames -- object )
- [ [ frame-id>> ] keep ] H{ } map>assoc id3v2-info boa ;
+: <id3> ( -- id3 )
+ id3 new
+ H{ } clone >>frames ; inline
: <header> ( -- object ) header new ; inline
: <frame> ( -- object ) frame new ; inline
-: id3v2? ( mmap -- ? ) "ID3" head? ; inline
+: id3v2? ( seq -- ? ) "ID3" head? ; inline
-: id3v1? ( mmap -- ? )
- { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline
+CONSTANT: id3v1-length 128
+CONSTANT: id3v1-offset 128
+CONSTANT: id3v1+-length 227
+CONSTANT: id3v1+-offset $[ 128 227 + ]
-: id3v1-frame ( string key -- frame )
- <frame>
- swap >>frame-id
- swap >>data ; inline
+: id3v1? ( seq -- ? )
+ {
+ [ length id3v1-offset >= ]
+ [ id3v1-length tail-slice* "TAG" head? ]
+ } 1&& ;
+
+: id3v1+? ( seq -- ? )
+ {
+ [ length id3v1+-offset >= ]
+ [ id3v1+-length tail-slice* "TAG+" head? ]
+ } 1&& ;
+
+: pair>frame ( string key -- frame/f )
+ over [
+ <frame>
+ swap >>tag
+ swap >>data
+ ] [
+ 2drop f
+ ] if ;
-: id3v1>id3v2 ( id3v1 -- id3v2 )
+: id3v1>frames ( id3v1 -- seq )
[
{
- [ title>> "TIT2" id3v1-frame ]
- [ artist>> "TPE1" id3v1-frame ]
- [ album>> "TALB" id3v1-frame ]
- [ year>> "TYER" id3v1-frame ]
- [ comment>> "COMM" id3v1-frame ]
- [ genre>> "TCON" id3v1-frame ]
+ [ title>> "TIT2" pair>frame ]
+ [ artist>> "TPE1" pair>frame ]
+ [ album>> "TALB" pair>frame ]
+ [ year>> "TYER" pair>frame ]
+ [ comment>> "COMM" pair>frame ]
+ [ genre>> "TCON" pair>frame ]
} cleave
- ] output>array f swap <id3v2-info> ; inline
+ ] output>array sift ;
+
+: seq>synchsafe ( seq -- n )
+ 0 [ [ 7 shift ] dip bitor ] reduce ;
-: >28bitword ( seq -- int )
- 0 [ [ 7 shift ] dip bitor ] reduce ; inline
+: synchsafe>seq ( n -- seq )
+ dup 1 + log2 1 + 7 / ceiling
+ [ [ -7 shift ] keep HEX: 7f bitand ] replicate nip reverse ;
: filter-text-data ( data -- filtered )
- [ printable? ] filter ; inline
+ [ printable? ] filter ;
-: valid-frame-id? ( id -- ? )
- [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
+: valid-tag? ( id -- ? )
+ [ { [ digit? ] [ LETTER? ] } 1|| ] all? ;
-: read-frame-data ( frame mmap -- frame data )
- [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
+: read-frame-data ( frame seq -- frame data )
+ [ 10 over size>> 10 + ] dip <slice> filter-text-data ;
: decode-text ( string -- string' )
dup 2 short head
{ { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
- utf16 ascii ? decode ; inline
+ utf16 ascii ? decode ;
-: (read-frame) ( mmap -- frame )
+: (read-frame) ( seq -- frame )
[ <frame> ] dip
{
- [ 4 head-slice decode-text >>frame-id ]
- [ [ 4 8 ] dip subseq >28bitword >>size ]
+ [ 4 head-slice decode-text >>tag ]
+ [ [ 4 8 ] dip subseq seq>synchsafe >>size ]
[ [ 8 10 ] dip subseq >byte-array >>flags ]
[ read-frame-data decode-text >>data ]
- } cleave ; inline
+ } cleave ;
+
+: read-frame ( seq -- frame/f )
+ dup 4 head-slice valid-tag?
+ [ (read-frame) ] [ drop f ] if ;
-: read-frame ( mmap -- frame/f )
- dup 4 head-slice valid-frame-id?
- [ (read-frame) ] [ drop f ] if ; inline
+: remove-frame ( seq frame -- seq )
+ size>> 10 + tail-slice ;
-: remove-frame ( mmap frame -- mmap )
- size>> 10 + tail-slice ; inline
+: frames>assoc ( seq -- assoc )
+ [ [ tag>> ] keep ] H{ } map>assoc ;
-: read-frames ( mmap -- frames )
- [ dup read-frame dup ]
- [ [ remove-frame ] keep ]
- produce 2nip ; inline
+: read-frames ( seq -- assoc )
+ [ dup read-frame dup ] [ [ remove-frame ] keep ] produce 2nip ;
-: read-v2-header ( seq -- id3header )
+: read-v2-header ( seq -- header )
[ <header> ] dip
{
[ [ 3 5 ] dip <slice> >array >>version ]
[ [ 5 ] dip nth >>flags ]
- [ [ 6 10 ] dip <slice> >28bitword >>size ]
- } cleave ; inline
+ [ [ 6 10 ] dip <slice> seq>synchsafe >>size ]
+ } cleave ;
+
+: merge-frames ( id3 assoc -- id3 )
+ [ dup frames>> ] dip update ;
+
+: merge-id3v1 ( id3 -- id3 )
+ dup id3v1>frames frames>assoc merge-frames ;
-: read-v2-tag-data ( seq -- id3v2-info )
+: read-v2-tags ( id3 seq -- id3 )
10 cut-slice
- [ read-v2-header ]
- [ read-frames ] bi* <id3v2-info> ; inline
+ [ read-v2-header >>header ]
+ [ read-frames frames>assoc merge-frames ] bi* ;
-: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
-
-: (read-v1-tag-data) ( seq -- mp3-file )
- [ <id3v1-info> ] dip
+: extract-v1-tags ( id3 seq -- id3 )
{
[ 30 head-slice decode-text filter-text-data >>title ]
[ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
[ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
[ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
[ [ 124 ] dip nth number>string >>genre ]
- } cleave ; inline
+ } cleave ;
+
+: read-v1-tags ( id3 seq -- id3 )
+ id3v1-offset tail-slice* 3 tail-slice
+ extract-v1-tags ;
-: read-v1-tag-data ( seq -- mp3-file )
- skip-to-v1-data (read-v1-tag-data) ; inline
+: extract-v1+-tags ( id3 seq -- id3 )
+ {
+ [ 60 head-slice decode-text filter-text-data [ append ] change-title ]
+ [
+ [ 60 120 ] dip subseq decode-text filter-text-data
+ [ append ] change-artist
+ ]
+ [
+ [ 120 180 ] dip subseq decode-text filter-text-data
+ [ append ] change-album
+ ]
+ [ [ 180 ] dip nth >>speed ]
+ [ [ 181 211 ] dip subseq decode-text >>genre-name ]
+ [ [ 211 217 ] dip subseq decode-text >>start-time ]
+ [ [ 217 223 ] dip subseq decode-text >>end-time ]
+ } cleave ;
+
+: read-v1+-tags ( id3 seq -- id3 )
+ id3v1+-offset tail-slice* 4 tail-slice
+ extract-v1+-tags ;
: parse-genre ( string -- n/f )
dup "(" ?head-slice drop ")" ?tail-slice drop
genres ?nth swap or
] [
drop
- ] if ; inline
+ ] if ;
+
+PRIVATE>
-: (mp3>id3) ( path -- id3v2-info/f )
+: mp3>id3 ( path -- id3/f )
[
+ [ <id3> ] dip
{
- { [ dup id3v2? ] [ read-v2-tag-data ] }
- { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
- [ drop f ]
- } cond
- ] with-mapped-uchar-file ;
+ [ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
+ [ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
+ [ dup id3v2? [ read-v2-tags ] [ drop ] if ]
+ } cleave
+ ] with-mapped-uchar-file-reader ;
-PRIVATE>
+: find-id3-frame ( id3 name -- obj/f )
+ swap frames>> at* [ data>> ] when ;
-: mp3>id3 ( path -- id3v2-info/f )
- dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline
+: title ( id3 -- string/f ) "TIT2" find-id3-frame ;
-: find-id3-frame ( id3 name -- obj/f )
- swap frames>> at* [ data>> ] when ; inline
+: artist ( id3 -- string/f ) "TPE1" find-id3-frame ;
-: title ( id3 -- title/f ) "TIT2" find-id3-frame ; inline
+: album ( id3 -- string/f ) "TALB" find-id3-frame ;
-: artist ( id3 -- artist/f ) "TPE1" find-id3-frame ; inline
+: year ( id3 -- string/f ) "TYER" find-id3-frame ;
-: album ( id3 -- album/f ) "TALB" find-id3-frame ; inline
+: comment ( id3 -- string/f ) "COMM" find-id3-frame ;
-: year ( id3 -- year/f ) "TYER" find-id3-frame ; inline
+: genre ( id3 -- string/f )
+ "TCON" find-id3-frame parse-genre ;
-: comment ( id3 -- comment/f ) "COMM" find-id3-frame ; inline
+: find-mp3s ( path -- seq ) ".mp3" find-by-extension ;
-: genre ( id3 -- genre/f )
- "TCON" find-id3-frame parse-genre ; inline
+ERROR: id3-parse-error path error ;
-: find-mp3s ( path -- seq )
- [ >lower ".mp3" tail? ] find-all-files ; inline
+: (mp3-paths>id3s) ( seq -- seq' )
+ [ dup [ mp3>id3 ] [ \ id3-parse-error boa ] recover ] { } map>assoc ;
: mp3-paths>id3s ( seq -- seq' )
- [ dup mp3>id3 ] { } map>assoc ; inline
+ (mp3-paths>id3s)
+ [ dup second id3-parse-error? [ f over set-second ] when ] map ;
: parse-mp3-directory ( path -- seq )
find-mp3s mp3-paths>id3s ;
projects / factor.git / blobdiff