diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor index a7a7fb8d9f..9c5cb4c72c 100644 --- a/extra/morse/morse.factor +++ b/extra/morse/morse.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs combinators hashtables kernel lazy-lists math namespaces openal parser-combinators promises sequences strings symbols synth.buffers unicode.case ; +USING: accessors assocs combinators hashtables kernel lazy-lists math namespaces openal parser-combinators promises sequences strings symbols synth synth.buffers unicode.case ; IN: morse ( -- buffer ) - half-sample-freq t ; + half-sample-freq <8bit-mono-buffer> ; : sine-buffer ( seconds -- id ) beep-freq swap >sine-wave-buffer diff --git a/extra/sequences/merged/merged.factor b/extra/sequences/merged/merged.factor index dc125d7c59..829555cfb1 100644 --- a/extra/sequences/merged/merged.factor +++ b/extra/sequences/merged/merged.factor @@ -23,4 +23,6 @@ M: merged length seqs>> [ length ] map sum ; M: merged virtual@ ( n seq -- n' seq' ) seqs>> [ length /mod ] [ nth ] bi ; +M: merged virtual-seq ( merged -- seq ) [ ] { } map-as ; + INSTANCE: merged virtual-sequence diff --git a/extra/sequences/modified/modified-tests.factor b/extra/sequences/modified/modified-tests.factor new file mode 100644 index 0000000000..4bcbb29da6 --- /dev/null +++ b/extra/sequences/modified/modified-tests.factor @@ -0,0 +1,15 @@ +USING: accessors arrays kernel sequences sequences.modified tools.test ; +IN: sequences.modified.tests + +[ { 2 4 6 } ] [ { 1 2 3 } 2 scale ] unit-test +[ { 1 4 3 } ] [ { 1 2 3 } 2 8 1 pick set-nth seq>> ] unit-test +[ { 2 8 6 } ] [ { 1 2 3 } 2 8 1 pick set-nth >array ] unit-test + +[ { 2 3 4 } ] [ { 1 2 3 } 1 seq-offset ] unit-test +[ { 1 5 3 } ] [ { 1 2 3 } 1 6 1 pick set-nth seq>> ] unit-test +[ { 2 6 4 } ] [ { 1 2 3 } 1 6 1 pick set-nth >array ] unit-test + +[ 4 ] [ { { 1 2 } { 3 4 } } 0 swap nth ] unit-test +[ 6 ] [ { { 1 2 } { 3 4 } } 1 swap nth ] unit-test +[ 2 ] [ { { 1 2 } { 3 4 } } length ] unit-test +[ { 4 6 } ] [ { { 1 2 } { 3 4 } } >array ] unit-test diff --git a/extra/sequences/modified/modified.factor b/extra/sequences/modified/modified.factor new file mode 100644 index 0000000000..3e4c1b1bdc --- /dev/null +++ b/extra/sequences/modified/modified.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2008 Alex Chapman +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays kernel math sequences sequences.private shuffle ; +IN: sequences.modified + +TUPLE: modified ; + +GENERIC: modified-nth ( n seq -- elt ) +M: modified nth modified-nth ; +M: modified nth-unsafe modified-nth ; + +GENERIC: modified-set-nth ( elt n seq -- ) +M: modified set-nth modified-set-nth ; +M: modified set-nth-unsafe modified-set-nth ; + +INSTANCE: modified virtual-sequence + +TUPLE: 1modified < modified seq ; + +M: modified length seq>> length ; +M: modified set-length seq>> set-length ; + +M: 1modified virtual-seq seq>> ; + +TUPLE: scaled < 1modified c ; +C: scaled + +: scale ( seq c -- new-seq ) + dupd swap like ; + +M: scaled modified-nth ( n seq -- elt ) + [ seq>> nth ] [ c>> * ] bi ; + +M: scaled modified-set-nth ( elt n seq -- elt ) + ! don't set c to 0! + tuck [ c>> / ] 2dip seq>> set-nth ; + +TUPLE: offset < 1modified n ; +C: offset + +: seq-offset ( seq n -- new-seq ) + dupd swap like ; + +M: offset modified-nth ( n seq -- elt ) + [ seq>> nth ] [ n>> + ] bi ; + +M: offset modified-set-nth ( elt n seq -- ) + tuck [ n>> - ] 2dip seq>> set-nth ; + +TUPLE: summed < modified seqs ; +C: summed + +M: summed length seqs>> [ length ] map supremum ; + + + +M: summed modified-nth ( n seq -- ) + seqs>> [ ?nth ?+ ] with 0 swap reduce ; + +M: summed modified-set-nth ( elt n seq -- ) immutable ; + +M: summed set-length ( n seq -- ) + seqs>> [ set-length ] with each ; + +M: summed virtual-seq ( summed -- seq ) [ ] { } map-as ; + +: <2summed> ( seq seq -- summed-seq ) 2array ; +: <3summed> ( seq seq seq -- summed-seq ) 3array ; diff --git a/extra/synth/buffers/buffers-tests.factor b/extra/synth/buffers/buffers-tests.factor deleted file mode 100644 index 39b3593601..0000000000 --- a/extra/synth/buffers/buffers-tests.factor +++ /dev/null @@ -1,5 +0,0 @@ -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 index 5e0ebfdeff..faff19d8fd 100644 --- a/extra/synth/buffers/buffers.factor +++ b/extra/synth/buffers/buffers.factor @@ -1,6 +1,6 @@ ! 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 ; +USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged ; IN: synth.buffers TUPLE: buffer sample-freq 8bit? id ; @@ -13,11 +13,17 @@ TUPLE: mono-buffer < buffer data ; : ( sample-freq 8bit? -- buffer ) f f mono-buffer boa ; +: <8bit-mono-buffer> ( sample-freq -- buffer ) t ; +: <16bit-mono-buffer> ( sample-freq -- buffer ) f ; + TUPLE: stereo-buffer < buffer left-data right-data ; : ( sample-freq 8bit? -- buffer ) f f f stereo-buffer boa ; +: <8bit-stereo-buffer> ( sample-freq -- buffer ) t ; +: <16bit-stereo-buffer> ( sample-freq -- buffer ) f ; + PREDICATE: 8bit-buffer < buffer 8bit?>> ; PREDICATE: 16bit-buffer < buffer 8bit?>> not ; INTERSECTION: 8bit-mono-buffer 8bit-buffer mono-buffer ; @@ -68,21 +74,3 @@ M: 16bit-stereo-buffer buffer-data : ?send-buffer ( buffer -- buffer ) dup id>> [ 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 ; diff --git a/extra/synth/example/example.factor b/extra/synth/example/example.factor new file mode 100644 index 0000000000..dbad867ee6 --- /dev/null +++ b/extra/synth/example/example.factor @@ -0,0 +1,35 @@ +USING: accessors arrays kernel namespaces openal sequences synth synth.buffers ; +IN: synth.example + +: play-sine-wave ( freq seconds sample-freq -- ) + init-openal + <16bit-mono-buffer> >sine-wave-buffer send-buffer id>> + 1 gen-sources first + [ AL_BUFFER rot set-source-param ] [ source-play ] bi + check-error ; + +: test-instrument1 ( -- harmonics ) + [ + 1 0.5 , + 2 0.125 , + 3 0.0625 , + 4 0.03125 , + ] { } make ; + +: test-instrument2 ( -- harmonics ) + [ + 1 0.25 , + 2 0.25 , + 3 0.25 , + 4 0.25 , + ] { } make ; + +: sine-instrument ( -- harmonics ) + 1 1 1array ; + +: test-note-buffer ( note -- ) + init-openal + test-instrument2 swap cd-sample-freq <16bit-mono-buffer> + >note send-buffer id>> + 1 gen-sources first [ swap queue-buffer ] [ source-play ] bi + check-error ; diff --git a/extra/synth/synth.factor b/extra/synth/synth.factor new file mode 100644 index 0000000000..3f79ad5b40 --- /dev/null +++ b/extra/synth/synth.factor @@ -0,0 +1,34 @@ +USING: accessors kernel locals math math.constants math.functions memoize openal synth.buffers sequences sequences.modified sequences.repeating ; +IN: synth + +MEMO: single-sine-wave ( samples/wave -- seq ) + pi 2 * over / [ * sin ] curry map ; + +: (sine-wave) ( samples/wave n-samples -- seq ) + [ single-sine-wave ] dip ; + +: 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 ; + +TUPLE: harmonic n amplitude ; +C: harmonic + +TUPLE: note hz secs ; +C: note + +: harmonic-freq ( note harmonic -- freq ) + n>> swap hz>> * ; + +:: note-harmonic-data ( harmonic note buffer -- data ) + buffer sample-freq>> note harmonic harmonic-freq note secs>> sine-wave + harmonic amplitude>> ; + +: >note ( harmonics note buffer -- buffer ) + dup -roll [ note-harmonic-data ] 2curry map >>data ; +