diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index f35da24266..63dc951d60 100755 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -6,7 +6,7 @@ vocabs.loader io combinators calendar accessors math.parser io.streams.string ui.tools.operations quotations strings arrays prettyprint words vocabs sorting sets classes math alien urls splitting ascii combinators.short-circuit alarms words.symbol -system ; +system summary ; IN: tools.scaffold SYMBOL: developer-name @@ -16,6 +16,10 @@ ERROR: not-a-vocab-root string ; ERROR: vocab-name-contains-separator path ; ERROR: vocab-name-contains-dot path ; ERROR: no-vocab vocab ; +ERROR: bad-developer-name name ; + +M: bad-developer-name summary + drop "Developer name must be a string." ; path scaffolding? [ - [ developer-name get ] dip utf8 set-file-contents + developer-name get [ + dup string? [ bad-developer-name ] unless + "authors.txt" vocab-root/vocab/file>path scaffolding? [ + utf8 set-file-contents + ] [ + 2drop + ] if ] [ - drop - ] if ; + 2drop + ] if* ; : lookup-type ( string -- object/string ? ) "new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail @@ -298,9 +307,12 @@ SYMBOL: examples-flag "}" print ] with-variable ; +: touch. ( path -- ) + [ touch-file ] + [ "Click to edit: " write . ] bi ; + : scaffold-rc ( path -- ) - [ home ] dip append-path - [ touch-file ] [ "Click to edit: " write . ] bi ; + [ home ] dip append-path touch. ; : scaffold-factor-boot-rc ( -- ) os windows? "factor-boot-rc" ".factor-boot-rc" ? scaffold-rc ; @@ -308,4 +320,7 @@ SYMBOL: examples-flag : scaffold-factor-rc ( -- ) os windows? "factor-rc" ".factor-rc" ? scaffold-rc ; -: scaffold-emacs ( -- ) ".emacs" scaffold-rc ; + +HOOK: scaffold-emacs os ( -- ) + +M: unix scaffold-emacs ( -- ) ".emacs" scaffold-rc ; diff --git a/basis/tools/scaffold/windows/authors.txt b/basis/tools/scaffold/windows/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/tools/scaffold/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/tools/scaffold/windows/windows.factor b/basis/tools/scaffold/windows/windows.factor new file mode 100755 index 0000000000..fef6121717 --- /dev/null +++ b/basis/tools/scaffold/windows/windows.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: io.pathnames system tools.scaffold windows.shell32 ; +IN: tools.scaffold.windows + +M: windows scaffold-emacs ( -- ) + application-data ".emacs" append-path touch. ; diff --git a/extra/audio/wav/wav.factor b/extra/audio/wav/wav.factor index 6f8ee49395..6b76e98f3a 100644 --- a/extra/audio/wav/wav.factor +++ b/extra/audio/wav/wav.factor @@ -1,6 +1,7 @@ USING: alien.c-types alien.syntax audio combinators combinators.short-circuit io io.binary io.encodings.binary -io.files io.streams.memory kernel locals sequences ; +io.files io.streams.byte-array kernel locals math +sequences ; IN: audio.wav CONSTANT: RIFF-MAGIC "RIFF" @@ -16,7 +17,6 @@ C-STRUCT: riff-chunk-header C-STRUCT: riff-chunk { "riff-chunk-header" "header" } { "char[4]" "format" } - { "uchar[0]" "body" } ; C-STRUCT: wav-fmt-chunk @@ -34,29 +34,42 @@ C-STRUCT: wav-data-chunk { "uchar[0]" "body" } ; +ERROR: invalid-wav-file ; + +: ensured-read ( count -- output/f ) + [ read ] keep over length = [ drop f ] unless ; +: ensured-read* ( count -- output ) + ensured-read [ invalid-wav-file ] unless* ; + : read-chunk ( -- byte-array/f ) - 4 read [ 4 read le> [ ] [ read ] bi 3append ] [ f ] if* ; + 4 ensured-read [ 4 ensured-read* dup le> ensured-read* 3append ] [ f ] if* ; +: read-riff-chunk ( -- byte-array/f ) + "riff-chunk" heap-size ensured-read* ; : id= ( chunk id -- ? ) - [ 4 memory>byte-array ] dip sequence= ; + [ 4 head ] dip sequence= ; + +: check-chunk ( chunk id min-size -- ? ) + [ id= ] [ [ length ] dip >= ] bi-curry* bi and ; :: read-wav-chunks ( -- fmt data ) f :> fmt! f :> data! [ { [ fmt data and not ] [ read-chunk ] } 0&& dup ] [ { - { [ dup FMT-MAGIC id= ] [ fmt! ] } - { [ dup DATA-MAGIC id= ] [ data! ] } + { [ dup FMT-MAGIC "wav-fmt-chunk" heap-size check-chunk ] [ fmt! ] } + { [ dup DATA-MAGIC "wav-data-chunk" heap-size check-chunk ] [ data! ] } } cond ] while drop - fmt data ; - -ERROR: invalid-wav-file ; + fmt data 2dup and [ invalid-wav-file ] unless ; : verify-wav ( chunk -- ) - { [ RIFF-MAGIC id= ] [ riff-chunk-format WAVE-MAGIC id= ] } 1&& + { + [ RIFF-MAGIC id= ] + [ riff-chunk-format 4 memory>byte-array WAVE-MAGIC id= ] + } 1&& [ invalid-wav-file ] unless ; : (read-wav) ( -- audio ) - read-wav-chunks + read-wav-chunks [ [ wav-fmt-chunk-num-channels 2 memory>byte-array le> ] [ wav-fmt-chunk-bits-per-sample 2 memory>byte-array le> ] @@ -68,7 +81,5 @@ ERROR: invalid-wav-file ; : read-wav ( filename -- audio ) binary [ - read-chunk - [ verify-wav ] - [ riff-chunk-body [ (read-wav) ] with-input-stream* ] bi + read-riff-chunk verify-wav (read-wav) ] with-file-reader ;