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 get-global [
"JGsoft" t [ >lower "editpadlite.exe" tail? ] find-in-program-files
"JGsoft" [ >lower "editpadlite.exe" tail? ] find-in-program-files
[ "editpadlite.exe" ] unless*
] unless* ;

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

@ -5,7 +5,7 @@ IN: editors.editpadpro
: editpadpro-path ( -- path )
\ 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*
] unless* ;

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

@ -5,7 +5,7 @@ IN: editors.editplus
: editplus-path ( -- path )
\ 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*
] unless* ;

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

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

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

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

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

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

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

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

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

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

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

@ -7,11 +7,11 @@ IN: editors.scite
: scite-path ( -- path )
\ scite-path get-global [
"Scintilla Text Editor" t
"Scintilla Text Editor"
[ >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
] 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 get-global [
"TED Notepad" t [ "TedNPad.exe" tail? ] find-in-program-files
"TED Notepad" [ "TedNPad.exe" tail? ] find-in-program-files
[ "TedNPad.exe" ] unless*
] unless* ;

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

@ -5,7 +5,7 @@ IN: editors.textpad
: textpad-path ( -- path )
\ 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*
] unless* ;

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

@ -4,7 +4,7 @@ IN: editors.ultraedit
: ultraedit-path ( -- path )
\ 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*
] unless* ;

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

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

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

@ -38,7 +38,7 @@ HELP: find-in-directories
HELP: find-all-files
{ $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" }
}
{ $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 ] [
[
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@ =
] unit-test

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

@ -51,7 +51,8 @@ PRIVATE>
[ keep and ] curry iterate-directory
] [ 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
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 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
] 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
io.directories kernel tools.test continuations sequences
io.encodings.ascii accessors ;
io.encodings.ascii accessors math ;
IN: io.mmap.tests
[ "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
[ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
[ "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.
USING: continuations destructors io.files io.files.info
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
TUPLE: mapped-file address handle length disposed ;
HOOK: (mapped-file) os ( path length -- address handle )
ERROR: bad-mmap-size path size ;
: <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 ;
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 )
[
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
] 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 ;
: 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 ;
: infer-exit ( -- )
\ exit
{ integer } { } t >>terminated? <effect>
apply-word/effect ;
\ exit (( n -- * )) apply-word/effect ;
: infer-load-locals ( -- )
pop-literal nip
@ -189,7 +187,7 @@ M: object infer-call*
{ \ load-locals [ infer-load-locals ] }
{ \ get-local [ infer-get-local ] }
{ \ drop-locals [ infer-drop-locals ] }
{ \ do-primitive [ unknown-primitive-error inference-warning ] }
{ \ do-primitive [ unknown-primitive-error ] }
{ \ alien-invoke [ infer-alien-invoke ] }
{ \ alien-indirect [ infer-alien-indirect ] }
{ \ alien-callback [ infer-alien-callback ] }
@ -207,7 +205,7 @@ M: object infer-call*
{
declare call (call) slip 2slip 3slip dip 2dip 3dip
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
} [ t "special" set-word-prop ] each

7
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
classes.tuple classes.union classes.predicate debugger
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
\ infer. must-infer
@ -581,4 +582,6 @@ DEFER: eee'
: debugging-curry-folding ( quot -- )
[ 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
{ $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"
"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
Doug Coleman

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

@ -6,7 +6,7 @@ IN: id3
HELP: file-id3-tags
{ $values
{ "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: "
$nl { $link title>> }
$nl { $link artist>> }

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

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

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