note synthesis with harmonics, and added some more virtual sequences
Alex Chapman
parent
e8365a795f
commit
6f08e8606e
|
|
@ -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
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -136,7 +136,7 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
|
|||
: 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <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
|
||||
|
|
@ -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> 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> ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
|||
: <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 ;
|
||||
|
|
@ -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 <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 ;
|
||||
|
|
|
|||
|
|
@ -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 <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 ;
|
||||
|
|
@ -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 <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 ;
|
||||
|
||||
Loading…
Reference in New Issue