Merge branch 'master' of git://factorcode.org/git/factor
commit
c3e07a1423
|
@ -510,3 +510,8 @@ cell-bits 32 = [
|
|||
[ { array } declare 2 <groups> [ . . ] assoc-each ]
|
||||
\ nth-unsafe inlined?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ { fixnum fixnum } declare = ]
|
||||
\ both-fixnums? inlined?
|
||||
] unit-test
|
|
@ -199,8 +199,11 @@ generic-comparison-ops [
|
|||
] "outputs" set-word-prop
|
||||
|
||||
\ both-fixnums? [
|
||||
[ class>> fixnum classes-intersect? not ] either?
|
||||
f <literal-info> object-info ?
|
||||
[ class>> ] bi@ {
|
||||
{ [ 2dup [ fixnum classes-intersect? not ] either? ] [ f <literal-info> ] }
|
||||
{ [ 2dup [ fixnum class<= ] both? ] [ t <literal-info> ] }
|
||||
[ object-info ]
|
||||
} cond 2nip
|
||||
] "outputs" set-word-prop
|
||||
|
||||
{
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -11,7 +11,7 @@ M: object default-emacsclient ( -- path ) "emacsclient" ;
|
|||
|
||||
: emacsclient ( file line -- )
|
||||
[
|
||||
{ [ \ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
|
||||
{ [ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
|
||||
"--no-wait" ,
|
||||
number>string "+" prepend ,
|
||||
,
|
||||
|
|
|
@ -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|| ;
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -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*
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
||||
|
|
|
@ -96,8 +96,6 @@ M: object specializer-declaration class ;
|
|||
{ string string }
|
||||
"specializer" set-word-prop
|
||||
|
||||
\ find-last-sep { string sbuf } "specializer" set-word-prop
|
||||
|
||||
\ >string { sbuf } "specializer" set-word-prop
|
||||
|
||||
\ >array { { vector } } "specializer" set-word-prop
|
||||
|
|
|
@ -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." } ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -1,5 +1,8 @@
|
|||
! Copyright (C) 2008, 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: byte-arrays byte-vectors kernel io.encodings io.streams.string
|
||||
sequences io namespaces io.encodings.private accessors ;
|
||||
sequences io namespaces io.encodings.private accessors sequences.private
|
||||
io.streams.sequence destructors ;
|
||||
IN: io.streams.byte-array
|
||||
|
||||
: <byte-writer> ( encoding -- stream )
|
||||
|
@ -9,8 +12,16 @@ IN: io.streams.byte-array
|
|||
[ <byte-writer> ] dip [ output-stream get ] compose with-output-stream*
|
||||
dup encoder? [ stream>> ] when >byte-array ; inline
|
||||
|
||||
TUPLE: byte-reader { underlying byte-array read-only } { i array-capacity } ;
|
||||
|
||||
M: byte-reader stream-read-partial stream-read ;
|
||||
M: byte-reader stream-read sequence-read ;
|
||||
M: byte-reader stream-read1 sequence-read1 ;
|
||||
M: byte-reader stream-read-until sequence-read-until ;
|
||||
M: byte-reader dispose drop ;
|
||||
|
||||
: <byte-reader> ( byte-array encoding -- stream )
|
||||
[ >byte-vector dup reverse-here ] dip <decoder> ;
|
||||
[ B{ } like 0 byte-reader boa ] dip <decoder> ;
|
||||
|
||||
: with-byte-reader ( byte-array encoding quot -- )
|
||||
[ <byte-reader> ] dip with-input-stream* ; inline
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -21,7 +21,7 @@ $nl
|
|||
|
||||
ARTICLE: "inference-combinators" "Combinator stack effects"
|
||||
"Without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the inferencer encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised."
|
||||
{ $example "[ dup call ] infer." "Literal value expected\n\nType :help for debugging help." }
|
||||
{ $example "[ dup call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." }
|
||||
"On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point:"
|
||||
{ $example "[ [ 2 + ] call ] infer." "( object -- object )" }
|
||||
"Consider a combinator such as " { $link keep } ". The combinator itself does not have a stack effect, because it applies " { $link call } " to a potentially arbitrary quotation. However, since the combinator is declared " { $link POSTPONE: inline } ", a given usage of it can have a stack effect:"
|
||||
|
@ -38,7 +38,7 @@ $nl
|
|||
{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" }
|
||||
"Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:"
|
||||
{ $example
|
||||
"[ [ reverse ] swap [ reverse ] map swap call ] infer." "Literal value expected\n\nType :help for debugging help."
|
||||
"[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help."
|
||||
}
|
||||
"To make this work, pass the quotation on the retain stack instead:"
|
||||
{ $example
|
||||
|
@ -67,11 +67,11 @@ $nl
|
|||
"If a recursive word takes quotation parameters from the stack and calls them, it must be declared " { $link POSTPONE: inline } " (as documented in " { $link "inference-combinators" } ") as well as " { $link POSTPONE: recursive } "."
|
||||
$nl
|
||||
"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example, the following will not infer:"
|
||||
{ $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Literal value expected\n\nType :help for debugging help." }
|
||||
{ $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." }
|
||||
"The following is correct:"
|
||||
{ $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" }
|
||||
"An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:"
|
||||
{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Literal value expected\n\nType :help for debugging help." }
|
||||
{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." }
|
||||
"However a small change can be made:"
|
||||
{ $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" }
|
||||
"An inline recursive word must have a fixed stack effect in its base case. The following will not infer:"
|
||||
|
|
|
@ -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
|
|
@ -0,0 +1,8 @@
|
|||
vm
|
||||
temp
|
||||
logs
|
||||
.git
|
||||
.gitignore
|
||||
Makefile
|
||||
unmaintained
|
||||
build-support
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006 Doug Coleman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math sequences sequences.private namespaces
|
||||
words io io.binary io.files io.streams.string quotations
|
||||
words io io.binary io.files quotations
|
||||
definitions checksums ;
|
||||
IN: checksums.crc32
|
||||
|
||||
|
|
|
@ -0,0 +1,38 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences io kernel accessors math math.order ;
|
||||
IN: io.streams.sequence
|
||||
|
||||
SLOT: underlying
|
||||
SLOT: i
|
||||
|
||||
: >sequence-stream< ( stream -- i underlying )
|
||||
[ i>> ] [ underlying>> ] bi ; inline
|
||||
|
||||
: next ( stream -- )
|
||||
[ 1+ ] change-i drop ;
|
||||
|
||||
: sequence-read1 ( stream -- elt/f )
|
||||
[ >sequence-stream< ?nth ]
|
||||
[ next ] bi ; inline
|
||||
|
||||
: add-length ( n stream -- i+n )
|
||||
[ i>> + ] [ underlying>> length ] bi min ;
|
||||
|
||||
: (sequence-read) ( n stream -- seq/f )
|
||||
[ add-length ] keep
|
||||
[ [ swap dup ] change-i drop ]
|
||||
[ underlying>> ] bi
|
||||
subseq ; inline
|
||||
|
||||
: sequence-read ( n stream -- seq/f )
|
||||
dup >sequence-stream< bounds-check?
|
||||
[ (sequence-read) ] [ 2drop f ] if ; inline
|
||||
|
||||
: find-sep ( seps stream -- sep/f n )
|
||||
swap [ >sequence-stream< ] dip
|
||||
[ memq? ] curry find-from swap ; inline
|
||||
|
||||
: sequence-read-until ( separators stream -- seq sep/f )
|
||||
[ find-sep ] keep
|
||||
[ sequence-read ] [ next ] bi swap ; inline
|
|
@ -15,12 +15,12 @@ unit-test
|
|||
|
||||
[ "xyzzy" ] [ [ "xyzzy" write ] with-string-writer ] unit-test
|
||||
|
||||
[ "a" ] [ 1 SBUF" cba" stream-read ] unit-test
|
||||
[ "ab" ] [ 2 SBUF" cba" stream-read ] unit-test
|
||||
[ "abc" ] [ 3 SBUF" cba" stream-read ] unit-test
|
||||
[ "abc" ] [ 4 SBUF" cba" stream-read ] unit-test
|
||||
[ "a" ] [ 1 "abc" <string-reader> stream-read ] unit-test
|
||||
[ "ab" ] [ 2 "abc" <string-reader> stream-read ] unit-test
|
||||
[ "abc" ] [ 3 "abc" <string-reader> stream-read ] unit-test
|
||||
[ "abc" ] [ 4 "abc" <string-reader> stream-read ] unit-test
|
||||
[ "abc" f ] [
|
||||
3 SBUF" cba" [ stream-read ] keep stream-read1
|
||||
3 "abc" <string-reader> [ stream-read ] keep stream-read1
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
|
@ -1,18 +1,12 @@
|
|||
! Copyright (C) 2003, 2009 Slava Pestov.
|
||||
! Copyright (C) 2003, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors io kernel math namespaces sequences sbufs
|
||||
strings generic splitting continuations destructors
|
||||
io.streams.plain io.encodings math.order growable ;
|
||||
strings generic splitting continuations destructors sequences.private
|
||||
io.streams.plain io.encodings math.order growable io.streams.sequence ;
|
||||
IN: io.streams.string
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: harden-as ( seq growble-exemplar -- newseq )
|
||||
underlying>> like ;
|
||||
|
||||
: growable-read-until ( growable n -- str )
|
||||
>fixnum dupd tail-slice swap harden-as dup reverse-here ;
|
||||
|
||||
SINGLETON: null-encoding
|
||||
|
||||
M: null-encoding decode-char drop stream-read1 ;
|
||||
|
@ -32,34 +26,18 @@ M: growable stream-flush drop ;
|
|||
<string-writer> swap [ output-stream get ] compose with-output-stream*
|
||||
>string ; inline
|
||||
|
||||
M: growable stream-read1 [ f ] [ pop ] if-empty ;
|
||||
! New implementation
|
||||
|
||||
: find-last-sep ( seq seps -- n )
|
||||
swap [ memq? ] curry find-last drop ;
|
||||
TUPLE: string-reader { underlying string read-only } { i array-capacity } ;
|
||||
|
||||
M: growable stream-read-until
|
||||
[ find-last-sep ] keep over [
|
||||
[ swap 1+ growable-read-until ] 2keep [ nth ] 2keep
|
||||
set-length
|
||||
] [
|
||||
[ swap drop 0 growable-read-until f like f ] keep
|
||||
delete-all
|
||||
] if ;
|
||||
|
||||
M: growable stream-read
|
||||
[
|
||||
drop f
|
||||
] [
|
||||
[ length swap - 0 max ] keep
|
||||
[ swap growable-read-until ] 2keep
|
||||
set-length
|
||||
] if-empty ;
|
||||
|
||||
M: growable stream-read-partial
|
||||
stream-read ;
|
||||
M: string-reader stream-read-partial stream-read ;
|
||||
M: string-reader stream-read sequence-read ;
|
||||
M: string-reader stream-read1 sequence-read1 ;
|
||||
M: string-reader stream-read-until sequence-read-until ;
|
||||
M: string-reader dispose drop ;
|
||||
|
||||
: <string-reader> ( str -- stream )
|
||||
>sbuf dup reverse-here null-encoding <decoder> ;
|
||||
0 string-reader boa null-encoding <decoder> ;
|
||||
|
||||
: with-string-reader ( str quot -- )
|
||||
[ <string-reader> ] dip with-input-stream ; inline
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -1,2 +1,2 @@
|
|||
Tim Wawrzynczak
|
||||
|
||||
Doug Coleman
|
||||
|
|
|
@ -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>> }
|
||||
|
|
|
@ -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"
|
||||
] [ "vocab:id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
|
||||
|
||||
[
|
||||
"Anthem of the Trinity"
|
||||
"Terry Riley"
|
||||
"Shri Camel"
|
||||
f
|
||||
f
|
||||
"Classical"
|
||||
] [ "vocab: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"
|
||||
] [ "vocab:id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
|
||||
|
||||
|
|
|
@ -1,142 +1,43 @@
|
|||
! 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 combinators.smart
|
||||
splitting io.encodings.ascii arrays ;
|
||||
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 ;
|
||||
|
||||
|
@ -144,63 +45,72 @@ TUPLE: frame frame-id flags size data ;
|
|||
|
||||
TUPLE: id3v2-info header frames ;
|
||||
|
||||
TUPLE: id3-info title artist album year comment genre ;
|
||||
TUPLE: id3v1-info title artist album year comment genre ;
|
||||
|
||||
: <id3-info> ( -- object ) id3-info new ;
|
||||
: <id3v1-info> ( -- object ) id3v1-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 ;
|
||||
|
||||
! frame details stuff
|
||||
[ printable? ] filter ; inline
|
||||
|
||||
: 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 ;
|
||||
[ { [ digit? ] [ LETTER? ] } 1|| ] all? ; 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 ]
|
||||
[ 4 head-slice decode-text >>frame-id ]
|
||||
[ [ 4 8 ] dip subseq >28bitword >>size ]
|
||||
[ [ 8 10 ] dip subseq >byte-array >>flags ]
|
||||
[ 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 4 head-slice 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 ]
|
||||
|
@ -209,89 +119,71 @@ 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 ;
|
||||
|
||||
: read-header-flags ( mmap -- flags )
|
||||
5 swap nth ;
|
||||
|
||||
: read-header-size ( mmap -- size )
|
||||
[ 6 10 ] dip <slice> >28bitword ;
|
||||
|
||||
: read-v2-header ( mmap -- id3header )
|
||||
: read-v2-header ( seq -- id3header )
|
||||
[ <header> ] dip
|
||||
{
|
||||
[ read-header-supported-version? >>version ]
|
||||
[ read-header-flags >>flags ]
|
||||
[ read-header-size >>size ]
|
||||
} cleave ;
|
||||
[ [ 3 5 ] dip <slice> >array >>version ]
|
||||
[ [ 5 ] dip nth >>flags ]
|
||||
[ [ 6 10 ] dip <slice> >28bitword >>size ]
|
||||
} cleave ; inline
|
||||
|
||||
: drop-header ( mmap -- seq1 seq2 )
|
||||
dup 10 tail-slice swap ;
|
||||
|
||||
: 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 )
|
||||
10 cut-slice
|
||||
[ read-v2-header ]
|
||||
[ read-frames ] bi* <id3v2-info> ; inline
|
||||
|
||||
! 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 ;
|
||||
: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
|
||||
|
||||
: (read-v1-tag-data) ( seq -- mp3-file )
|
||||
[ <id3-info> ] dip
|
||||
[ <id3v1-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 ;
|
||||
[ 30 head-slice decode-text filter-text-data >>title ]
|
||||
[ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
|
||||
[ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
|
||||
[ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
|
||||
[ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
|
||||
[ [ 124 ] dip nth 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
|
||||
|
|
Loading…
Reference in New Issue