diff --git a/extra/morse/morse-tests.factor b/extra/morse/morse-tests.factor index 9bfdc6b50c..144448917f 100644 --- a/extra/morse/morse-tests.factor +++ b/extra/morse/morse-tests.factor @@ -9,5 +9,5 @@ USING: arrays morse strings tools.test ; [ "-- --- .-. ... . / -.-. --- -.. ." ] [ "morse code" >morse ] unit-test [ "morse code" ] [ "-- --- .-. ... . / -.-. --- -.. ." morse> ] unit-test [ "hello, world!" ] [ "Hello, World!" >morse morse> ] unit-test -[ ] [ "sos" 0.075 play-as-morse* ] unit-test -[ ] [ "Factor rocks!" play-as-morse ] unit-test +! [ ] [ "sos" 0.075 play-as-morse* ] unit-test +! [ ] [ "Factor rocks!" play-as-morse ] unit-test diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor index ecade14cdb..a7a7fb8d9f 100644 --- a/extra/morse/morse.factor +++ b/extra/morse/morse.factor @@ -1,8 +1,6 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: assocs combinators hashtables kernel lazy-lists math namespaces -openal openal.waves parser-combinators promises sequences strings symbols -unicode.case ; +USING: accessors assocs combinators hashtables kernel lazy-lists math namespaces openal parser-combinators promises sequences strings symbols synth.buffers unicode.case ; IN: morse ( -- buffer ) + half-sample-freq t ; + : sine-buffer ( seconds -- id ) - >r 8 22000 880 r> send-buffer* ; + beep-freq swap >sine-wave-buffer + send-buffer id>> ; : silent-buffer ( seconds -- id ) - 8 22000 rot send-buffer* ; + >silent-buffer send-buffer id>> ; : make-buffers ( unit-length -- ) { diff --git a/extra/openal/waves/waves-tests.factor b/extra/openal/waves/waves-tests.factor deleted file mode 100644 index b295283aac..0000000000 --- a/extra/openal/waves/waves-tests.factor +++ /dev/null @@ -1,5 +0,0 @@ -USING: kernel openal openal.waves sequences tools.test ; -IN: openal.waves.tests - - -[ ] [ 8 22000 440 1 play-sine-wave ] unit-test diff --git a/extra/openal/waves/waves.factor b/extra/openal/waves/waves.factor deleted file mode 100644 index abe9f8fb69..0000000000 --- a/extra/openal/waves/waves.factor +++ /dev/null @@ -1,53 +0,0 @@ -USING: accessors alien.c-types combinators kernel locals math -math.constants math.functions math.ranges openal sequences ; -IN: openal.waves - -TUPLE: buffer bits channels sample-freq seq id ; - -: ( bits sample-freq seq -- buffer ) - ! defaults to 1 channel - 1 -rot gen-buffer buffer boa ; - -: buffer-format ( buffer -- format ) - dup buffer-channels 1 = swap buffer-bits 8 = [ - AL_FORMAT_MONO8 AL_FORMAT_STEREO8 - ] [ - AL_FORMAT_MONO16 AL_FORMAT_STEREO16 - ] if ? ; - -: buffer-data ( buffer -- data size ) - #! 8 bit data is integers between 0 and 255, - #! 16 bit data is integers between -32768 and 32768 - #! size is in bytes - [ seq>> ] [ bits>> ] bi 8 = [ - [ 128 * >integer 128 + ] map [ >c-uchar-array ] [ length ] bi - ] [ - [ 32768 * >integer ] map [ >c-short-array ] [ length 2 * ] bi - ] if ; - -: send-buffer ( buffer -- ) - { [ id>> ] [ buffer-format ] [ buffer-data ] [ sample-freq>> ] } cleave - alBufferData ; - -: send-buffer* ( buffer -- id ) - [ send-buffer ] [ id>> ] bi ; - -: (sine-wave-seq) ( samples/wave n-samples -- seq ) - pi 2 * rot / [ * sin ] curry map ; - -: sine-wave-seq ( sample-freq freq seconds -- seq ) - pick * >integer [ / ] dip (sine-wave-seq) ; - -: ( bits sample-freq freq seconds -- buffer ) - >r dupd r> sine-wave-seq ; - -: ( bits sample-freq seconds -- buffer ) - dupd * >integer [ drop 0 ] map ; - -: play-sine-wave ( bits sample-freq freq seconds -- ) - init-openal - send-buffer* - 1 gen-sources first - [ AL_BUFFER rot set-source-param ] [ source-play ] bi - check-error ; - diff --git a/extra/sequences/merged/merged.factor b/extra/sequences/merged/merged.factor index 2fdf65ec9e..dc125d7c59 100644 --- a/extra/sequences/merged/merged.factor +++ b/extra/sequences/merged/merged.factor @@ -13,7 +13,7 @@ C: merged dup swap first like ; : 2merge ( seq1 seq2 -- seq ) - dupd <2merged> rot like ; + dupd <2merged> swap like ; : 3merge ( seq1 seq2 seq3 -- seq ) pick >r <3merged> r> like ; diff --git a/extra/sequences/repeating/authors.txt b/extra/sequences/repeating/authors.txt new file mode 100644 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/sequences/repeating/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/sequences/repeating/repeating-tests.factor b/extra/sequences/repeating/repeating-tests.factor new file mode 100644 index 0000000000..15b7ef444b --- /dev/null +++ b/extra/sequences/repeating/repeating-tests.factor @@ -0,0 +1,5 @@ +USING: sequences.repeating tools.test ; +IN: sequences.repeating.tests + +[ { 1 2 3 1 2 } ] [ { 1 2 3 } 5 repeated ] unit-test +[ { 1 2 3 1 2 3 1 2 3 } ] [ { 1 2 3 } 9 repeated ] unit-test diff --git a/extra/sequences/repeating/repeating.factor b/extra/sequences/repeating/repeating.factor new file mode 100644 index 0000000000..92b0925907 --- /dev/null +++ b/extra/sequences/repeating/repeating.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2008 Alex Chapman +! See http;//factorcode.org/license.txt for BSD license +USING: accessors circular kernel sequences ; +IN: sequences.repeating + +TUPLE: repeating circular len ; + +: ( seq length -- repeating ) + [ ] dip repeating boa ; + +: repeated ( seq length -- new-seq ) + dupd swap like ; + +M: repeating length repeating-len ; +M: repeating set-length (>>len) ; + +M: repeating virtual@ ( n seq -- n' seq' ) circular>> ; + +M: repeating virtual-seq circular>> ; + +INSTANCE: repeating virtual-sequence diff --git a/extra/synth/buffers/buffers-tests.factor b/extra/synth/buffers/buffers-tests.factor new file mode 100644 index 0000000000..39b3593601 --- /dev/null +++ b/extra/synth/buffers/buffers-tests.factor @@ -0,0 +1,5 @@ +USING: kernel synth.buffers sequences tools.test ; +IN: synth.buffers.tests + + +[ ] [ 440 1 half-sample-freq play-sine-wave ] unit-test diff --git a/extra/synth/buffers/buffers.factor b/extra/synth/buffers/buffers.factor new file mode 100644 index 0000000000..35c35d8b04 --- /dev/null +++ b/extra/synth/buffers/buffers.factor @@ -0,0 +1,89 @@ +! Copyright (C) 2008 Alex Chapman +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types combinators kernel locals math math.constants math.functions math.ranges openal sequences sequences.merged sequences.repeating ; +IN: synth.buffers + +TUPLE: buffer sample-freq 8bit? sent? id ; + +: ( sample-freq 8bit? -- buffer ) + f gen-buffer buffer boa ; + +TUPLE: mono-buffer < buffer data ; + +: ( sample-freq 8bit? -- buffer ) + f gen-buffer f mono-buffer boa ; + +TUPLE: stereo-buffer < buffer left-data right-data ; + +: ( sample-freq 8bit? -- buffer ) + f gen-buffer f f stereo-buffer boa ; + +PREDICATE: 8bit-buffer < buffer 8bit?>> ; +PREDICATE: 16bit-buffer < buffer 8bit?>> not ; +INTERSECTION: 8bit-mono-buffer 8bit-buffer mono-buffer ; +INTERSECTION: 16bit-mono-buffer 16bit-buffer mono-buffer ; +INTERSECTION: 8bit-stereo-buffer 8bit-buffer stereo-buffer ; +INTERSECTION: 16bit-stereo-buffer 16bit-buffer stereo-buffer ; + +GENERIC: buffer-format ( buffer -- format ) +M: 8bit-mono-buffer buffer-format drop AL_FORMAT_MONO8 ; +M: 16bit-mono-buffer buffer-format drop AL_FORMAT_MONO16 ; +M: 8bit-stereo-buffer buffer-format drop AL_FORMAT_STEREO8 ; +M: 16bit-stereo-buffer buffer-format drop AL_FORMAT_STEREO16 ; + +: 8bit-buffer-data ( seq -- data size ) + [ 128 * >integer 128 + ] map [ >c-uchar-array ] [ length ] bi ; + +: 16bit-buffer-data ( seq -- data size ) + [ 32768 * >integer ] map [ >c-short-array ] [ length 2 * ] bi ; + +: stereo-data ( stereo-buffer -- left right ) + [ left-data>> ] [ right-data>> ] bi@ ; + +: interleaved-stereo-data ( stereo-buffer -- data ) + stereo-data <2merged> ; + +GENERIC: buffer-data ( buffer -- data size ) +M: 8bit-mono-buffer buffer-data data>> 8bit-buffer-data ; +M: 16bit-mono-buffer buffer-data data>> 16bit-buffer-data ; +M: 8bit-stereo-buffer buffer-data + interleaved-stereo-data 8bit-buffer-data ; +M: 16bit-stereo-buffer buffer-data + interleaved-stereo-data 16bit-buffer-data ; + +: telephone-sample-freq 8000 ; +: half-sample-freq 22050 ; +: cd-sample-freq 44100 ; +: digital-sample-freq 48000 ; +: professional-sample-freq 88200 ; + +: send-buffer ( buffer -- buffer ) + { + [ id>> ] + [ buffer-format ] + [ buffer-data ] + [ sample-freq>> alBufferData ] + [ t >>sent? ] + } cleave ; + +: ?send-buffer ( buffer -- buffer ) + dup sent?>> [ send-buffer ] unless ; + +: (sine-wave) ( samples/wave n-samples -- seq ) + pi 2 * pick / swapd [ * sin ] curry map swap ; + +: sine-wave ( sample-freq freq seconds -- seq ) + pick * >integer [ /i ] dip (sine-wave) ; + +: >sine-wave-buffer ( freq seconds buffer -- buffer ) + [ sample-freq>> -rot sine-wave ] keep swap >>data ; + +: >silent-buffer ( seconds buffer -- buffer ) + tuck sample-freq>> * >integer 0 >>data ; + +: play-sine-wave ( freq seconds sample-freq -- ) + init-openal + t >sine-wave-buffer send-buffer id>> + 1 gen-sources first + [ AL_BUFFER rot set-source-param ] [ source-play ] bi + check-error ;