! 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
<PRIVATE
: beep-freq 880 ;
: <morse-buffer> ( -- buffer )
- half-sample-freq t <mono-buffer> ;
+ half-sample-freq <8bit-mono-buffer> ;
: sine-buffer ( seconds -- id )
beep-freq swap <morse-buffer> >sine-wave-buffer
M: merged virtual@ ( n seq -- n' seq' )
seqs>> [ length /mod ] [ nth ] bi ;
+M: merged virtual-seq ( merged -- seq ) [ ] { } map-as ;
+
INSTANCE: merged virtual-sequence
--- /dev/null
+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 <scaled> 8 1 pick set-nth seq>> ] unit-test
+[ { 2 8 6 } ] [ { 1 2 3 } 2 <scaled> 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 <offset> 6 1 pick set-nth seq>> ] unit-test
+[ { 2 6 4 } ] [ { 1 2 3 } 1 <offset> 6 1 pick set-nth >array ] unit-test
+
+[ 4 ] [ { { 1 2 } { 3 4 } } <summed> 0 swap nth ] unit-test
+[ 6 ] [ { { 1 2 } { 3 4 } } <summed> 1 swap nth ] unit-test
+[ 2 ] [ { { 1 2 } { 3 4 } } <summed> length ] unit-test
+[ { 4 6 } ] [ { { 1 2 } { 3 4 } } <summed> >array ] unit-test
--- /dev/null
+! 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> scaled
+
+: scale ( seq c -- new-seq )
+ dupd <scaled> 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> offset
+
+: seq-offset ( seq n -- new-seq )
+ dupd <offset> 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> summed
+
+M: summed length seqs>> [ length ] map supremum ;
+
+<PRIVATE
+: ?+ ( x/f y/f -- sum )
+ #! addition that treats f as 0
+ [
+ swap [ + ] when*
+ ] [
+ [ ] [ 0 ] if*
+ ] if* ;
+PRIVATE>
+
+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 <summed> ;
+: <3summed> ( seq seq seq -- summed-seq ) 3array <summed> ;
+++ /dev/null
-USING: kernel synth.buffers sequences tools.test ;
-IN: synth.buffers.tests
-
-
-[ ] [ 440 1 half-sample-freq play-sine-wave ] unit-test
! 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 ;
: <mono-buffer> ( sample-freq 8bit? -- buffer )
f f mono-buffer boa ;
+: <8bit-mono-buffer> ( sample-freq -- buffer ) t <mono-buffer> ;
+: <16bit-mono-buffer> ( sample-freq -- buffer ) f <mono-buffer> ;
+
TUPLE: stereo-buffer < buffer left-data right-data ;
: <stereo-buffer> ( sample-freq 8bit? -- buffer )
f f f stereo-buffer boa ;
+: <8bit-stereo-buffer> ( sample-freq -- buffer ) t <stereo-buffer> ;
+: <16bit-stereo-buffer> ( sample-freq -- buffer ) f <stereo-buffer> ;
+
PREDICATE: 8bit-buffer < buffer 8bit?>> ;
PREDICATE: 16bit-buffer < buffer 8bit?>> not ;
INTERSECTION: 8bit-mono-buffer 8bit-buffer mono-buffer ;
: ?send-buffer ( buffer -- buffer )
dup id>> [ send-buffer ] unless ;
-: (sine-wave) ( samples/wave n-samples -- seq )
- pi 2 * pick / swapd [ * sin ] curry map swap <repeating> ;
-
-: 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 <repetition> >>data ;
-
-: play-sine-wave ( freq seconds sample-freq -- )
- init-openal
- t <mono-buffer> >sine-wave-buffer send-buffer id>>
- 1 gen-sources first
- [ AL_BUFFER rot set-source-param ] [ source-play ] bi
- check-error ;
--- /dev/null
+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 <harmonic> ,
+ 2 0.125 <harmonic> ,
+ 3 0.0625 <harmonic> ,
+ 4 0.03125 <harmonic> ,
+ ] { } make ;
+
+: test-instrument2 ( -- harmonics )
+ [
+ 1 0.25 <harmonic> ,
+ 2 0.25 <harmonic> ,
+ 3 0.25 <harmonic> ,
+ 4 0.25 <harmonic> ,
+ ] { } make ;
+
+: sine-instrument ( -- harmonics )
+ 1 1 <harmonic> 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 ;
--- /dev/null
+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 <repeating> ;
+
+: 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 <repetition> >>data ;
+
+TUPLE: harmonic n amplitude ;
+C: <harmonic> harmonic
+
+TUPLE: note hz secs ;
+C: <note> 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>> <scaled> ;
+
+: >note ( harmonics note buffer -- buffer )
+ dup -roll [ note-harmonic-data ] 2curry map <summed> >>data ;
+