! 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 combinators math.ranges unicode.categories byte-arrays io.encodings.string io.encodings.utf8 assocs math.parser combinators.short-circuit fry namespaces multiline combinators.smart splitting ; IN: id3 ( -- object ) id3-info new ; : ( header frames -- object ) [ [ frame-id>> ] keep ] H{ } map>assoc id3v2-info boa ; :
( -- object ) header new ; : ( -- object ) frame new ; : id3v2? ( mmap -- ? ) "ID3" head? ; inline : id3v1? ( mmap -- ? ) { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline : id3v1-frame ( string key -- frame ) swap >>frame-id swap >>data ; : id3v1>id3v2 ( id3v1 -- id3v2 ) [ { [ title>> "TIT2" id3v1-frame ] [ artist>> "TPE1" id3v1-frame ] [ album>> "TALB" id3v1-frame ] [ year>> "TYER" id3v1-frame ] [ comment>> "COMM" id3v1-frame ] [ genre>> "TCON" id3v1-frame ] } cleave ] output>array f swap ; : >28bitword ( seq -- int ) 0 [ [ 7 shift ] dip bitor ] reduce ; inline : filter-text-data ( data -- filtered ) [ printable? ] filter ; inline ! frame details stuff : valid-frame-id? ( id -- ? ) [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline : read-frame-id ( mmap -- id ) 4 head-slice ; inline : read-frame-size ( mmap -- size ) [ 4 8 ] dip subseq ; inline : read-frame-flags ( mmap -- flags ) [ 8 10 ] dip subseq ; inline : read-frame-data ( frame mmap -- frame data ) [ 10 over size>> 10 + ] dip filter-text-data ; inline ! read whole frames : (read-frame) ( mmap -- frame ) [ ] dip { [ read-frame-id utf8 decode >>frame-id ] [ read-frame-flags >byte-array >>flags ] [ read-frame-size >28bitword >>size ] [ read-frame-data utf8 decode >>data ] } cleave ; : read-frame ( mmap -- frame/f ) dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ; : remove-frame ( mmap frame -- mmap ) size>> 10 + tail-slice ; inline : read-frames ( mmap -- frames ) [ dup read-frame dup ] [ [ remove-frame ] keep ] [ drop ] produce nip ; ! header stuff : read-header-supported-version? ( mmap -- ? ) 3 tail-slice first { 3 4 } member? ; inline : read-header-flags ( mmap -- flags ) 5 swap nth ; inline : read-header-size ( mmap -- size ) [ 6 10 ] dip >28bitword ; inline : read-v2-header ( mmap -- id3header ) [
] dip { [ read-header-supported-version? >>version ] [ read-header-flags >>flags ] [ read-header-size >>size ] } cleave ; inline : drop-header ( mmap -- seq1 seq2 ) [ 10 tail-slice ] [ ] bi ; inline : read-v2-tag-data ( seq -- id3v2-info ) drop-header read-v2-header swap read-frames ; inline ! v1 information : skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline : read-title ( seq -- title ) 30 head-slice ; inline : read-artist ( seq -- title ) [ 30 60 ] dip subseq ; inline : read-album ( seq -- album ) [ 60 90 ] dip subseq ; inline : read-year ( seq -- year ) [ 90 94 ] dip subseq ; inline : read-comment ( seq -- comment ) [ 94 124 ] dip subseq ; inline : read-genre ( seq -- genre ) [ 124 ] dip nth ; inline : (read-v1-tag-data) ( seq -- mp3-file ) [ ] dip { [ read-title utf8 decode filter-text-data >>title ] [ read-artist utf8 decode filter-text-data >>artist ] [ read-album utf8 decode filter-text-data >>album ] [ read-year utf8 decode filter-text-data >>year ] [ read-comment utf8 decode filter-text-data >>comment ] [ read-genre number>string >>genre ] } cleave ; inline : read-v1-tag-data ( seq -- mp3-file ) skip-to-v1-data (read-v1-tag-data) ; inline : parse-genre ( string -- n/f ) dup "(" ?head-slice drop ")" ?tail-slice drop string>number dup number? [ genres ?nth swap or ] [ drop ] if ; inline PRIVATE> : frame-named ( id3 name quot -- obj ) [ swap frames>> at* ] dip [ data>> ] prepose [ drop f ] if ; inline : id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline : id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline : id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline : id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline : id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline : id3-genre ( id3 -- genre/f ) "TCON" [ parse-genre ] frame-named ; inline : id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline : file-id3-tags ( path -- id3v2-info/f ) [ { { [ dup id3v2? ] [ read-v2-tag-data ] } { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] } [ drop f ] } cond ] with-mapped-uchar-file ;