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

Merge branch 'master' into new_ui

db4
Slava Pestov 2009-02-26 23:31:36 -06:00
parent cf62353e23 452ba3edb3
commit 45dae72f4a
28 changed files with 315 additions and 263 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
basis/stack-checker/errors/errors.factor
View File

@ -80,4 +80,4 @@ TUPLE: inconsistent-recursive-call-error word ;
TUPLE: unknown-primitive-error ; TUPLE: unknown-primitive-error ;
: unknown-primitive-error ( -- * ) : unknown-primitive-error ( -- * )
\ unknown-primitive-error inference-error ; \ unknown-primitive-error inference-warning ;

8
basis/stack-checker/known-words/known-words.factor
View File

@ -141,9 +141,7 @@ M: object infer-call*
apply-word/effect ; apply-word/effect ;
: infer-exit ( -- ) : infer-exit ( -- )
\ exit \ exit (( n -- * )) apply-word/effect ;
{ integer } { } t >>terminated? <effect>
apply-word/effect ;
: infer-load-locals ( -- ) : infer-load-locals ( -- )
pop-literal nip pop-literal nip
@ -189,7 +187,7 @@ M: object infer-call*
{ \ load-locals [ infer-load-locals ] } { \ load-locals [ infer-load-locals ] }
{ \ get-local [ infer-get-local ] } { \ get-local [ infer-get-local ] }
{ \ drop-locals [ infer-drop-locals ] } { \ drop-locals [ infer-drop-locals ] }
{ \ do-primitive [ unknown-primitive-error inference-warning ] } { \ do-primitive [ unknown-primitive-error ] }
{ \ alien-invoke [ infer-alien-invoke ] } { \ alien-invoke [ infer-alien-invoke ] }
{ \ alien-indirect [ infer-alien-indirect ] } { \ alien-indirect [ infer-alien-indirect ] }
{ \ alien-callback [ infer-alien-callback ] } { \ alien-callback [ infer-alien-callback ] }
@ -207,7 +205,7 @@ M: object infer-call*
{ {
declare call (call) slip 2slip 3slip dip 2dip 3dip declare call (call) slip 2slip 3slip dip 2dip 3dip
curry compose execute (execute) if dispatch <tuple-boa> curry compose execute (execute) if dispatch <tuple-boa>
(throw) load-local load-locals get-local drop-locals do-primitive (throw) exit load-local load-locals get-local drop-locals do-primitive
alien-invoke alien-indirect alien-callback alien-invoke alien-indirect alien-callback
} [ t "special" set-word-prop ] each } [ t "special" set-word-prop ] each

5
basis/stack-checker/stack-checker-tests.factor
View File

@ -6,7 +6,8 @@ quotations effects tools.test continuations generic.standard
sorting assocs definitions prettyprint io inspector sorting assocs definitions prettyprint io inspector
classes.tuple classes.union classes.predicate debugger classes.tuple classes.union classes.predicate debugger
threads.private io.streams.string io.timeouts io.thread threads.private io.streams.string io.timeouts io.thread
sequences.private destructors combinators eval locals.backend ; sequences.private destructors combinators eval locals.backend
system ;
IN: stack-checker.tests IN: stack-checker.tests
\ infer. must-infer \ infer. must-infer
@ -582,3 +583,5 @@ DEFER: eee'
[ debugging-curry-folding ] curry call ; inline recursive [ debugging-curry-folding ] curry call ; inline recursive
[ [ ] debugging-curry-folding ] must-infer [ [ ] debugging-curry-folding ] must-infer
[ [ exit ] [ 1 2 3 ] if ] must-infer

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
[ [
T{ id3-info "Anthem of the Trinity"
{ title "Stormy Weather" } "Terry Riley"
{ artist "Frank Sinatra" } "Shri Camel"
{ album "Night and Day Frank Sinatra" } f
{ comment "eng, AG# 08E1C12E" } f
{ genre "Big Band" } "Classical"
} ] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test
] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags ] unit-test
[
"Stormy Weather"
"Frank Sinatra"
"Night and Day Frank Sinatra"
f
"eng, AG# 08E1C12E"
"Big Band"
] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test

426
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,13 +234,12 @@ 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
@ -224,74 +247,79 @@ TUPLE: id3-info title artist album year comment genre ;
[ 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