steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-02-26 23:30:58 -06:00
parent 11117648ea 63c9b1a6b8
commit 452ba3edb3
25 changed files with 306 additions and 255 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/editors/editpadlite/editpadlite.factor
View File

@ -5,7 +5,7 @@ IN: editors.editpadlite
: editpadlite-path ( -- path ) : editpadlite-path ( -- path )
\ editpadlite-path get-global [ \ editpadlite-path get-global [
"JGsoft" t [ >lower "editpadlite.exe" tail? ] find-in-program-files "JGsoft" [ >lower "editpadlite.exe" tail? ] find-in-program-files
[ "editpadlite.exe" ] unless* [ "editpadlite.exe" ] unless*
] unless* ; ] unless* ;

2
basis/editors/editpadpro/editpadpro.factor
View File

@ -5,7 +5,7 @@ IN: editors.editpadpro
: editpadpro-path ( -- path ) : editpadpro-path ( -- path )
\ editpadpro-path get-global [ \ editpadpro-path get-global [
"JGsoft" t [ >lower "editpadpro.exe" tail? ] find-in-program-files "JGsoft" [ >lower "editpadpro.exe" tail? ] find-in-program-files
[ "editpadpro.exe" ] unless* [ "editpadpro.exe" ] unless*
] unless* ; ] unless* ;

2
basis/editors/editplus/editplus.factor
View File

@ -5,7 +5,7 @@ IN: editors.editplus
: editplus-path ( -- path ) : editplus-path ( -- path )
\ editplus-path get-global [ \ editplus-path get-global [
"EditPlus 2" t [ "editplus.exe" tail? ] find-in-program-files "EditPlus 2" [ "editplus.exe" tail? ] find-in-program-files
[ "editplus.exe" ] unless* [ "editplus.exe" ] unless*
] unless* ; ] unless* ;

4
basis/editors/emacs/windows/windows.factor
View File

@ -6,7 +6,7 @@ IN: editors.emacs.windows
M: windows default-emacsclient M: windows default-emacsclient
{ {
[ "Emacs" t [ "emacsclientw.exe" tail? ] find-in-program-files ] [ "Emacs" [ "emacsclientw.exe" tail? ] find-in-program-files ]
[ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ] [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ]
[ "emacsclient.exe" ] [ "emacsclient.exe" ]
} 0|| ; } 0|| ;

2
basis/editors/emeditor/emeditor.factor
View File

@ -5,7 +5,7 @@ IN: editors.emeditor
: emeditor-path ( -- path ) : emeditor-path ( -- path )
\ emeditor-path get-global [ \ emeditor-path get-global [
"EmEditor" t [ "EmEditor.exe" tail? ] find-in-program-files "EmEditor" [ "EmEditor.exe" tail? ] find-in-program-files
[ "EmEditor.exe" ] unless* [ "EmEditor.exe" ] unless*
] unless* ; ] unless* ;

2
basis/editors/etexteditor/etexteditor.factor
View File

@ -6,7 +6,7 @@ IN: editors.etexteditor
: etexteditor-path ( -- str ) : etexteditor-path ( -- str )
\ etexteditor-path get-global [ \ etexteditor-path get-global [
"e" t [ "e.exe" tail? ] find-in-program-files "e" [ "e.exe" tail? ] find-in-program-files
[ "e" ] unless* [ "e" ] unless*
] unless* ; ] unless* ;

2
basis/editors/gvim/windows/windows.factor
View File

@ -5,6 +5,6 @@ IN: editors.gvim.windows
M: windows gvim-path M: windows gvim-path
\ gvim-path get-global [ \ gvim-path get-global [
"vim" t [ "gvim.exe" tail? ] find-in-program-files "vim" [ "gvim.exe" tail? ] find-in-program-files
[ "gvim.exe" ] unless* [ "gvim.exe" ] unless*
] unless* ; ] unless* ;

2
basis/editors/notepadpp/notepadpp.factor
View File

@ -4,7 +4,7 @@ IN: editors.notepadpp
: notepadpp-path ( -- path ) : notepadpp-path ( -- path )
\ notepadpp-path get-global [ \ notepadpp-path get-global [
"notepad++" t [ "notepad++.exe" tail? ] find-in-program-files "notepad++" [ "notepad++.exe" tail? ] find-in-program-files
[ "notepad++.exe" ] unless* [ "notepad++.exe" ] unless*
] unless* ; ] unless* ;

4
basis/editors/scite/scite.factor
View File

@ -7,11 +7,11 @@ IN: editors.scite
: scite-path ( -- path ) : scite-path ( -- path )
\ scite-path get-global [ \ scite-path get-global [
"Scintilla Text Editor" t "Scintilla Text Editor"
[ >lower "scite.exe" tail? ] find-in-program-files [ >lower "scite.exe" tail? ] find-in-program-files
[ [
"SciTE Source Code Editor" t "SciTE Source Code Editor"
[ >lower "scite.exe" tail? ] find-in-program-files [ >lower "scite.exe" tail? ] find-in-program-files
] unless* ] unless*
[ "scite.exe" ] unless* [ "scite.exe" ] unless*

2
basis/editors/ted-notepad/ted-notepad.factor
View File

@ -4,7 +4,7 @@ IN: editors.ted-notepad
: ted-notepad-path ( -- path ) : ted-notepad-path ( -- path )
\ ted-notepad-path get-global [ \ ted-notepad-path get-global [
"TED Notepad" t [ "TedNPad.exe" tail? ] find-in-program-files "TED Notepad" [ "TedNPad.exe" tail? ] find-in-program-files
[ "TedNPad.exe" ] unless* [ "TedNPad.exe" ] unless*
] unless* ; ] unless* ;

2
basis/editors/textpad/textpad.factor
View File

@ -5,7 +5,7 @@ IN: editors.textpad
: textpad-path ( -- path ) : textpad-path ( -- path )
\ textpad-path get-global [ \ textpad-path get-global [
"TextPad 5" t [ "TextPad.exe" tail? ] find-in-program-files "TextPad 5" [ "TextPad.exe" tail? ] find-in-program-files
[ "TextPad.exe" ] unless* [ "TextPad.exe" ] unless*
] unless* ; ] unless* ;

2
basis/editors/ultraedit/ultraedit.factor
View File

@ -4,7 +4,7 @@ IN: editors.ultraedit
: ultraedit-path ( -- path ) : ultraedit-path ( -- path )
\ ultraedit-path get-global [ \ ultraedit-path get-global [
"IDM Computer Solutions" t [ "uedit32.exe" tail? ] find-in-program-files "IDM Computer Solutions" [ "uedit32.exe" tail? ] find-in-program-files
[ "uedit32.exe" ] unless* [ "uedit32.exe" ] unless*
] unless* ; ] unless* ;

2
basis/editors/wordpad/wordpad.factor
View File

@ -4,7 +4,7 @@ IN: editors.wordpad
: wordpad-path ( -- path ) : wordpad-path ( -- path )
\ wordpad-path get [ \ wordpad-path get [
"Windows NT\\Accessories" t "Windows NT\\Accessories"
[ "wordpad.exe" tail? ] find-in-program-files [ "wordpad.exe" tail? ] find-in-program-files
] unless* ; ] unless* ;

2
basis/io/directories/search/search-docs.factor
View File

@ -38,7 +38,7 @@ HELP: find-in-directories
HELP: find-all-files HELP: find-all-files
{ $values { $values
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } { "path" "a pathname string" } { "quot" quotation }
{ "paths/f" "a sequence of pathname strings or f" } { "paths/f" "a sequence of pathname strings or f" }
} }
{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; { $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;

2
basis/io/directories/search/search-tests.factor
View File

@ -5,6 +5,6 @@ IN: io.directories.search.tests
[ t ] [ [ t ] [
[ [
10 [ "io.paths.test" "gogogo" make-unique-file ] replicate 10 [ "io.paths.test" "gogogo" make-unique-file ] replicate
current-temporary-directory get t [ ] find-all-files current-temporary-directory get [ ] find-all-files
] with-unique-directory drop [ natural-sort ] bi@ = ] with-unique-directory drop [ natural-sort ] bi@ =
] unit-test ] unit-test

3
basis/io/directories/search/search.factor
View File

@ -51,7 +51,8 @@ PRIVATE>
[ keep and ] curry iterate-directory [ keep and ] curry iterate-directory
] [ drop f ] recover ; inline ] [ drop f ] recover ; inline
: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths/f ) : find-all-files ( path quot: ( obj -- ? ) -- paths/f )
f swap
'[ '[
_ _ _ [ <directory-iterator> ] dip _ _ _ [ <directory-iterator> ] dip
pusher [ [ f ] compose iterate-directory drop ] dip pusher [ [ f ] compose iterate-directory drop ] dip

4
basis/io/directories/search/windows/windows.factor
View File

@ -7,7 +7,7 @@ IN: io.directories.search.windows
: program-files-directories ( -- array ) : program-files-directories ( -- array )
program-files program-files-x86 2array harvest ; inline program-files program-files-x86 2array harvest ; inline
: find-in-program-files ( base-directory bfs? quot -- path ) : find-in-program-files ( base-directory quot -- path )
[ t swap [
[ program-files-directories ] dip '[ _ append-path ] map [ program-files-directories ] dip '[ _ append-path ] map
] 2dip find-in-directories ; inline ] 2dip find-in-directories ; inline

12
basis/io/mmap/mmap-tests.factor
View File

@ -1,6 +1,6 @@
USING: io io.mmap io.mmap.char io.files io.files.temp USING: io io.mmap io.mmap.char io.files io.files.temp
io.directories kernel tools.test continuations sequences io.directories kernel tools.test continuations sequences
io.encodings.ascii accessors ; io.encodings.ascii accessors math ;
IN: io.mmap.tests IN: io.mmap.tests
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
@ -9,3 +9,13 @@ IN: io.mmap.tests
[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test [ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
[ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
[ "mmap-empty-file.txt" temp-file delete-file ] ignore-errors
[ ] [ "mmap-empty-file.txt" temp-file touch-file ] unit-test
[
"mmap-empty-file.txt" temp-file [
drop
] with-mapped-file
] [ bad-mmap-size? ] must-fail-with

9
basis/io/mmap/mmap.factor
View File

@ -2,15 +2,20 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors io.files io.files.info USING: continuations destructors io.files io.files.info
io.backend kernel quotations system alien alien.accessors io.backend kernel quotations system alien alien.accessors
accessors system vocabs.loader combinators alien.c-types ; accessors system vocabs.loader combinators alien.c-types
math ;
IN: io.mmap IN: io.mmap
TUPLE: mapped-file address handle length disposed ; TUPLE: mapped-file address handle length disposed ;
HOOK: (mapped-file) os ( path length -- address handle ) HOOK: (mapped-file) os ( path length -- address handle )
ERROR: bad-mmap-size path size ;
: <mapped-file> ( path -- mmap ) : <mapped-file> ( path -- mmap )
[ normalize-path ] [ file-info size>> ] bi [ (mapped-file) ] keep [ normalize-path ] [ file-info size>> ] bi
dup 0 <= [ bad-mmap-size ] when
[ (mapped-file) ] keep
f mapped-file boa ; f mapped-file boa ;
HOOK: close-mapped-file io-backend ( mmap -- ) HOOK: close-mapped-file io-backend ( mmap -- )

2
basis/io/mmap/unix/unix.factor
View File

@ -9,7 +9,7 @@ IN: io.mmap.unix
:: mmap-open ( path length prot flags -- alien fd ) :: mmap-open ( path length prot flags -- alien fd )
[ [
f length prot flags f length prot flags
path open-r/w |dispose path open-r/w [ <fd> |dispose drop ] keep
[ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
] with-destructors ; ] with-destructors ;

2
core/math/math-docs.factor
View File

@ -308,7 +308,7 @@ HELP: find-last-integer
HELP: byte-array>bignum HELP: byte-array>bignum
{ $values { "byte-array" byte-array } { "n" integer } } { $values { "byte-array" byte-array } { "n" integer } }
{ $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link >le } " or " { $link >be } " instead." } ; { $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link le> } " or " { $link be> } " instead." } ;
ARTICLE: "division-by-zero" "Division by zero" ARTICLE: "division-by-zero" "Division by zero"
"Floating point division never raises an error if the denominator is zero. This means that if at least one of the two inputs to " { $link / } ", " { $link /f } " or " { $link mod } " is a float, the result will be a floating point infinity or not a number value." "Floating point division never raises an error if the denominator is zero. This means that if at least one of the two inputs to " { $link / } ", " { $link /f } " or " { $link mod } " is a float, the result will be a floating point infinity or not a number value."

2
extra/id3/authors.txt
View File

@ -1,2 +1,2 @@
Tim Wawrzynczak Tim Wawrzynczak
Doug Coleman

2
extra/id3/id3-docs.factor
View File

@ -6,7 +6,7 @@ IN: id3
HELP: file-id3-tags HELP: file-id3-tags
{ $values { $values
{ "path" "a path string" } { "path" "a path string" }
{ "object/f" "a tuple storing ID3 metadata or f" } } { "id3v2-info/f" "a tuple storing ID3v2 metadata or f" } }
{ $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present. Currently, the parser supports the following tags: " { $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present. Currently, the parser supports the following tags: "
$nl { $link title>> } $nl { $link title>> }
$nl { $link artist>> } $nl { $link artist>> }

59
extra/id3/id3-tests.factor
View File

@ -1,35 +1,42 @@
! Copyright (C) 2009 Tim Wawrzynczak ! Copyright (C) 2009 Tim Wawrzynczak
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: tools.test id3 id3.private ; USING: tools.test id3 combinators ;
IN: id3.tests IN: id3.tests
[ : id3-params ( id3 -- title artist album year comment genre )
T{ id3-info {
{ title "BLAH" } [ id3-title ]
{ artist "ARTIST" } [ id3-artist ]
{ album "ALBUM" } [ id3-album ]
{ year "2009" } [ id3-year ]
{ comment "COMMENT" } [ id3-comment ]
{ genre "Bluegrass" } [ id3-genre ]
} } cleave ;
] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags ] unit-test
[ [
T{ id3-info "BLAH"
{ title "Anthem of the Trinity" } "ARTIST"
{ artist "Terry Riley" } "ALBUM"
{ album "Shri Camel" } "2009"
{ genre "Classical" } "COMMENT"
} "Bluegrass"
] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags ] unit-test ] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
[
"Anthem of the Trinity"
"Terry Riley"
"Shri Camel"
f
f
"Classical"
] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test
[ [
T{ id3-info "Stormy Weather"
{ title "Stormy Weather" } "Frank Sinatra"
{ artist "Frank Sinatra" } "Night and Day Frank Sinatra"
{ album "Night and Day Frank Sinatra" } f
{ comment "eng, AG# 08E1C12E" } "eng, AG# 08E1C12E"
{ genre "Big Band" } "Big Band"
} ] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags ] unit-test

432
extra/id3/id3.factor
View File

@ -1,142 +1,144 @@
! Copyright (C) 2009 Tim Wawrzynczak ! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 ; 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.utf16 assocs math.parser
combinators.short-circuit fry namespaces multiline
combinators.smart splitting io.encodings.ascii ;
IN: id3 IN: id3
<PRIVATE <PRIVATE
! genres
CONSTANT: genres CONSTANT: genres
H{ {
{ 0 "Blues" } "Blues"
{ 1 "Classic Rock" } "Classic Rock"
{ 2 "Country" } "Country"
{ 3 "Dance" } "Dance"
{ 4 "Disco" } "Disco"
{ 5 "Funk" } "Funk"
{ 6 "Grunge" } "Grunge"
{ 7 "Hip-Hop" } "Hip-Hop"
{ 8 "Jazz" } "Jazz"
{ 9 "Metal" } "Metal"
{ 10 "New Age" } "New Age"
{ 11 "Oldies" } "Oldies"
{ 12 "Other" } "Other"
{ 13 "Pop" } "Pop"
{ 14 "R&B" } "R&B"
{ 15 "Rap" } "Rap"
{ 16 "Reggae" } "Reggae"
{ 17 "Rock" } "Rock"
{ 18 "Techno" } "Techno"
{ 19 "Industrial" } "Industrial"
{ 20 "Alternative" } "Alternative"
{ 21 "Ska" } "Ska"
{ 22 "Death Metal" } "Death Metal"
{ 23 "Pranks" } "Pranks"
{ 24 "Soundtrack" } "Soundtrack"
{ 25 "Euro-Techno" } "Euro-Techno"
{ 26 "Ambient" } "Ambient"
{ 27 "Trip-Hop" } "Trip-Hop"
{ 28 "Vocal" } "Vocal"
{ 29 "Jazz+Funk" } "Jazz+Funk"
{ 30 "Fusion" } "Fusion"
{ 31 "Trance" } "Trance"
{ 32 "Classical" } "Classical"
{ 33 "Instrumental" } "Instrumental"
{ 34 "Acid" } "Acid"
{ 35 "House" } "House"
{ 36 "Game" } "Game"
{ 37 "Sound Clip" } "Sound Clip"
{ 38 "Gospel" } "Gospel"
{ 39 "Noise" } "Noise"
{ 40 "AlternRock" } "AlternRock"
{ 41 "Bass" } "Bass"
{ 42 "Soul" } "Soul"
{ 43 "Punk" } "Punk"
{ 44 "Space" } "Space"
{ 45 "Meditative" } "Meditative"
{ 46 "Instrumental Pop" } "Instrumental Pop"
{ 47 "Instrumental Rock" } "Instrumental Rock"
{ 48 "Ethnic" } "Ethnic"
{ 49 "Gothic" } "Gothic"
{ 50 "Darkwave" } "Darkwave"
{ 51 "Techno-Industrial" } "Techno-Industrial"
{ 52 "Electronic" } "Electronic"
{ 53 "Pop-Folk" } "Pop-Folk"
{ 54 "Eurodance" } "Eurodance"
{ 55 "Dream" } "Dream"
{ 56 "Southern Rock" } "Southern Rock"
{ 57 "Comedy" } "Comedy"
{ 58 "Cult" } "Cult"
{ 59 "Gangsta" } "Gangsta"
{ 60 "Top 40" } "Top 40"
{ 61 "Christian Rap" } "Christian Rap"
{ 62 "Pop/Funk" } "Pop/Funk"
{ 63 "Jungle" } "Jungle"
{ 64 "Native American" } "Native American"
{ 65 "Cabaret" } "Cabaret"
{ 66 "New Wave" } "New Wave"
{ 67 "Psychedelic" } "Psychedelic"
{ 68 "Rave" } "Rave"
{ 69 "Showtunes" } "Showtunes"
{ 70 "Trailer" } "Trailer"
{ 71 "Lo-Fi" } "Lo-Fi"
{ 72 "Tribal" } "Tribal"
{ 73 "Acid Punk" } "Acid Punk"
{ 74 "Acid Jazz" } "Acid Jazz"
{ 75 "Polka" } "Polka"
{ 76 "Retro" } "Retro"
{ 77 "Musical" } "Musical"
{ 78 "Rock & Roll" } "Rock & Roll"
{ 79 "Hard Rock" } "Hard Rock"
{ 80 "Folk" } "Folk"
{ 81 "Folk-Rock" } "Folk-Rock"
{ 82 "National Folk" } "National Folk"
{ 83 "Swing" } "Swing"
{ 84 "Fast Fusion" } "Fast Fusion"
{ 85 "Bebop" } "Bebop"
{ 86 "Latin" } "Latin"
{ 87 "Revival" } "Revival"
{ 88 "Celtic" } "Celtic"
{ 89 "Bluegrass" } "Bluegrass"
{ 90 "Avantgarde" } "Avantgarde"
{ 91 "Gothic Rock" } "Gothic Rock"
{ 92 "Progressive Rock" } "Progressive Rock"
{ 93 "Psychedelic Rock" } "Psychedelic Rock"
{ 94 "Symphonic Rock" } "Symphonic Rock"
{ 95 "Slow Rock" } "Slow Rock"
{ 96 "Big Band" } "Big Band"
{ 97 "Chorus" } "Chorus"
{ 98 "Easy Listening" } "Easy Listening"
{ 99 "Acoustic" } "Acoustic"
{ 100 "Humour" } "Humour"
{ 101 "Speech" } "Speech"
{ 102 "Chanson" } "Chanson"
{ 103 "Opera" } "Opera"
{ 104 "Chamber Music" } "Chamber Music"
{ 105 "Sonata" } "Sonata"
{ 106 "Symphony" } "Symphony"
{ 107 "Booty Bass" } "Booty Bass"
{ 108 "Primus" } "Primus"
{ 109 "Porn Groove" } "Porn Groove"
{ 110 "Satire" } "Satire"
{ 111 "Slow Jam" } "Slow Jam"
{ 112 "Club" } "Club"
{ 113 "Tango" } "Tango"
{ 114 "Samba" } "Samba"
{ 115 "Folklore" } "Folklore"
{ 116 "Ballad" } "Ballad"
{ 117 "Power Ballad" } "Power Ballad"
{ 118 "Rhythmic Soul" } "Rhythmic Soul"
{ 119 "Freestyle" } "Freestyle"
{ 120 "Duet" } "Duet"
{ 121 "Punk Rock" } "Punk Rock"
{ 122 "Drum Solo" } "Drum Solo"
{ 123 "A capella" } "A capella"
{ 124 "Euro-House" } "Euro-House"
{ 125 "Dance Hall" } "Dance Hall"
} ! end genre hashtable }
! tuples
TUPLE: header version flags size ; TUPLE: header version flags size ;
@ -148,59 +150,81 @@ TUPLE: id3-info title artist album year comment genre ;
: <id3-info> ( -- object ) id3-info new ; : <id3-info> ( -- object ) id3-info new ;
: <id3v2-info> ( header frames -- object ) id3v2-info boa ; : <id3v2-info> ( header frames -- object )
[ [ frame-id>> ] keep ] H{ } map>assoc
id3v2-info boa ;
: <header> ( -- object ) header new ; : <header> ( -- object ) header new ;
: <frame> ( -- object ) frame new ; : <frame> ( -- object ) frame new ;
! utility words : id3v2? ( mmap -- ? ) "ID3" head? ; inline
: id3v2? ( mmap -- ? )
"ID3" head? ;
: id3v1? ( mmap -- ? ) : id3v1? ( mmap -- ? )
128 tail-slice* "TAG" head? ; { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline
: id3v1-frame ( string key -- frame )
<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 <id3v2-info> ;
: >28bitword ( seq -- int ) : >28bitword ( seq -- int )
0 [ swap 7 shift bitor ] reduce ; 0 [ [ 7 shift ] dip bitor ] reduce ; inline
: filter-text-data ( data -- filtered ) : filter-text-data ( data -- filtered )
[ printable? ] filter ; [ printable? ] filter ; inline
! frame details stuff ! frame details stuff
: valid-frame-id? ( id -- ? ) : valid-frame-id? ( id -- ? )
[ [ digit? ] [ LETTER? ] bi or ] all? ; [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
: read-frame-id ( mmap -- id ) : read-frame-id ( mmap -- id )
4 head-slice ; 4 head-slice ; inline
: read-frame-size ( mmap -- size ) : read-frame-size ( mmap -- size )
[ 4 8 ] dip subseq ; [ 4 8 ] dip subseq ; inline
: read-frame-flags ( mmap -- flags ) : read-frame-flags ( mmap -- flags )
[ 8 10 ] dip subseq ; [ 8 10 ] dip subseq ; inline
: read-frame-data ( frame mmap -- frame data ) : read-frame-data ( frame mmap -- frame data )
[ 10 over size>> 10 + ] dip <slice> filter-text-data ; [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
! read whole frames ! read whole frames
: decode-text ( string -- string' )
dup 2 short head
{ { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
utf16 ascii ? decode ; inline
: (read-frame) ( mmap -- frame ) : (read-frame) ( mmap -- frame )
[ <frame> ] dip [ <frame> ] dip
{ {
[ read-frame-id utf8 decode >>frame-id ] [ read-frame-id decode-text >>frame-id ]
[ read-frame-flags >byte-array >>flags ] [ read-frame-flags >byte-array >>flags ]
[ read-frame-size >28bitword >>size ] [ read-frame-size >28bitword >>size ]
[ read-frame-data utf8 decode >>data ] [ read-frame-data decode-text >>data ]
} cleave ; } cleave ;
: read-frame ( mmap -- frame/f ) : read-frame ( mmap -- frame/f )
dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ; dup read-frame-id valid-frame-id?
[ (read-frame) ] [ drop f ] if ;
: remove-frame ( mmap frame -- mmap ) : remove-frame ( mmap frame -- mmap )
size>> 10 + tail-slice ; size>> 10 + tail-slice ; inline
: read-frames ( mmap -- frames ) : read-frames ( mmap -- frames )
[ dup read-frame dup ] [ dup read-frame dup ]
@ -210,88 +234,92 @@ TUPLE: id3-info title artist album year comment genre ;
! header stuff ! header stuff
: read-header-supported-version? ( mmap -- ? ) : read-header-supported-version? ( mmap -- ? )
3 tail-slice [ { 4 } head? ] [ { 3 } head? ] bi or ; 3 tail-slice first { 3 4 } member? ; inline
: read-header-flags ( mmap -- flags ) : read-header-flags ( mmap -- flags ) 5 swap nth ; inline
5 swap nth ;
: read-header-size ( mmap -- size ) : read-header-size ( mmap -- size )
[ 6 10 ] dip <slice> >28bitword ; [ 6 10 ] dip <slice> >28bitword ; inline
: read-v2-header ( mmap -- id3header ) : read-v2-header ( mmap -- id3header )
[ <header> ] dip [ <header> ] dip
{ {
[ read-header-supported-version? >>version ] [ read-header-supported-version? >>version ]
[ read-header-flags >>flags ] [ read-header-flags >>flags ]
[ read-header-size >>size ] [ read-header-size >>size ]
} cleave ; } cleave ; inline
: drop-header ( mmap -- seq1 seq2 ) : drop-header ( mmap -- seq1 seq2 )
dup 10 tail-slice swap ; [ 10 tail-slice ] [ ] bi ; inline
: parse-frames ( id3v2-info -- id3-info ) : read-v2-tag-data ( seq -- id3v2-info )
[ <id3-info> ] dip frames>> drop-header read-v2-header
{ swap read-frames <id3v2-info> ; inline
[ [ frame-id>> "TIT2" = ] find nip [ data>> >>title ] when* ]
[ [ frame-id>> "TALB" = ] find nip [ data>> >>album ] when* ]
[ [ frame-id>> "TPE1" = ] find nip [ data>> >>artist ] when* ]
[ [ frame-id>> "TCON" = ] find nip [ data>> [ [ digit? ] filter string>number ] keep swap [ genres at nip ] when*
>>genre ] when* ]
[ [ frame-id>> "COMM" = ] find nip [ data>> >>comment ] when* ]
[ [ frame-id>> "TYER" = ] find nip [ data>> >>year ] when* ]
} cleave ;
: read-v2-tag-data ( seq -- id3-info )
drop-header read-v2-header swap read-frames <id3v2-info> parse-frames ;
! v1 information ! v1 information
: skip-to-v1-data ( seq -- seq ) : skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
125 tail-slice* ;
: read-title ( seq -- title ) : read-title ( seq -- title ) 30 head-slice ; inline
30 head-slice ;
: read-artist ( seq -- title ) : read-artist ( seq -- title ) [ 30 60 ] dip subseq ; inline
[ 30 60 ] dip subseq ;
: read-album ( seq -- album ) : read-album ( seq -- album ) [ 60 90 ] dip subseq ; inline
[ 60 90 ] dip subseq ;
: read-year ( seq -- year ) : read-year ( seq -- year ) [ 90 94 ] dip subseq ; inline
[ 90 94 ] dip subseq ;
: read-comment ( seq -- comment ) : read-comment ( seq -- comment ) [ 94 124 ] dip subseq ; inline
[ 94 124 ] dip subseq ;
: read-genre ( seq -- genre ) : read-genre ( seq -- genre ) [ 124 ] dip nth ; inline
[ 124 ] dip nth ;
: (read-v1-tag-data) ( seq -- mp3-file ) : (read-v1-tag-data) ( seq -- mp3-file )
[ <id3-info> ] dip [ <id3-info> ] dip
{ {
[ read-title utf8 decode filter-text-data >>title ] [ read-title decode-text filter-text-data >>title ]
[ read-artist utf8 decode filter-text-data >>artist ] [ read-artist decode-text filter-text-data >>artist ]
[ read-album utf8 decode filter-text-data >>album ] [ read-album decode-text filter-text-data >>album ]
[ read-year utf8 decode filter-text-data >>year ] [ read-year decode-text filter-text-data >>year ]
[ read-comment utf8 decode filter-text-data >>comment ] [ read-comment decode-text filter-text-data >>comment ]
[ read-genre >fixnum genres at >>genre ] [ read-genre number>string >>genre ]
} cleave ; } cleave ; inline
: read-v1-tag-data ( seq -- mp3-file ) : read-v1-tag-data ( seq -- mp3-file )
skip-to-v1-data (read-v1-tag-data) ; 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> PRIVATE>
! public interface : frame-named ( id3 name quot -- obj )
[ swap frames>> at* ] dip
[ data>> ] prepose [ drop f ] if ; inline
: file-id3-tags ( path -- object/f ) : 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 ] } ! ( ? -- id3v2 ) { [ dup id3v2? ] [ read-v2-tag-data ] }
{ [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- id3-info ) { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
[ drop f ] ! ( mmap -- f ) [ drop f ]
} cond } cond
] with-mapped-uchar-file ; ] with-mapped-uchar-file ;
! end