factor/extra/id3/id3.factor

155 lines
3.7 KiB
Factor
Raw Normal View History

2009-02-09 22:50:04 -05:00
! Copyright (C) 2009 Tim Wawrzynczak
! 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 prettyprint io.encodings.string io.encodings.ascii ;
IN: id3
! tuples
TUPLE: header version flags size ;
TUPLE: frame frame-id flags size data ;
TUPLE: mp3v2-file header frames ;
TUPLE: mp3v1-file title artist album year comment genre ;
: <mp3v1-file> ( -- object ) mp3v1-file new ;
: <mp3v2-file> ( header frames -- object ) mp3v2-file boa ;
: <header> ( -- object ) header new ;
: <frame> ( -- object ) frame new ;
<PRIVATE
! utility words
: id3v2? ( mmap -- ? )
"ID3" head? ;
: id3v1? ( mmap -- ? )
128 tail-slice* "TAG" head? ;
: >28bitword ( seq -- int )
0 [ swap 7 shift bitor ] reduce ;
: filter-text-data ( data -- filtered )
[ printable? ] filter ;
! frame details stuff
: valid-frame-id? ( id -- ? )
[ [ digit? ] [ LETTER? ] bi or ] all? ;
: read-frame-id ( mmap -- id )
4 head-slice ;
: read-frame-size ( mmap -- size )
[ 4 8 ] dip subseq ;
: read-frame-flags ( mmap -- flags )
[ 8 10 ] dip subseq ;
: read-frame-data ( frame mmap -- frame data )
[ 10 over size>> 10 + ] dip <slice> filter-text-data ;
! read whole frames
: (read-frame) ( mmap -- frame )
[ <frame> ] dip
{
[ read-frame-id ascii decode >>frame-id ]
[ read-frame-flags >byte-array >>flags ]
[ read-frame-size >28bitword >>size ]
[ read-frame-data ascii 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 ;
: read-frames ( mmap -- frames )
[ dup read-frame dup ]
[ [ remove-frame ] keep ]
[ drop ] produce nip ;
! header stuff
: read-header-supported-version? ( mmap -- ? )
3 tail-slice [ { 4 } head? ] [ { 3 } head? ] bi or ;
: read-header-flags ( mmap -- flags )
5 swap nth ;
: read-header-size ( mmap -- size )
[ 6 10 ] dip <slice> >28bitword ;
: read-v2-header ( mmap -- id3header )
[ <header> ] dip
{
[ read-header-supported-version? >>version ]
[ read-header-flags >>flags ]
[ read-header-size >>size ]
} cleave ;
: drop-header ( mmap -- seq1 seq2 )
dup 10 tail-slice swap ;
: read-v2-tag-data ( seq -- mp3v2-file )
drop-header read-v2-header swap read-frames <mp3v2-file> ;
! v1 information
: skip-to-v1-data ( seq -- seq )
125 tail-slice* ;
: read-title ( seq -- title )
30 head-slice ;
: read-artist ( seq -- title )
[ 30 60 ] dip subseq ;
: read-album ( seq -- album )
[ 60 90 ] dip subseq ;
: read-year ( seq -- year )
[ 90 94 ] dip subseq ;
: read-comment ( seq -- comment )
[ 94 124 ] dip subseq ;
: read-genre ( seq -- genre )
[ 124 ] dip nth ;
: (read-v1-tag-data) ( seq -- mp3-file )
[ <mp3v1-file> ] dip
{
[ read-title ascii decode >>title ]
[ read-artist ascii decode >>artist ]
[ read-album ascii decode >>album ]
[ read-year ascii decode >>year ]
[ read-comment ascii decode >>comment ]
[ read-genre >fixnum >>genre ]
} cleave ;
: read-v1-tag-data ( seq -- mp3-file )
skip-to-v1-data (read-v1-tag-data) ;
PRIVATE>
! main stuff
: id3-parse-mp3-file ( path -- object )
[
{
{ [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- mp3v2-file )
{ [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- mp3v1-file )
[ drop f ] ! ( mmap -- f )
} cond
] with-mapped-uchar-file ;
! end