Merge branch 'master' of git://factorcode.org/git/wrunt
Slava Pestov
commit
7e4a34ca3e
|
|
@ -1,3 +1,5 @@
|
|||
! Copyright (C) 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors calendar kernel math math.order money sequences ;
|
||||
IN: bank
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
! Copyright (C) 2007 Alex Chapman
|
||||
! Copyright (C) 2007, 2008 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 synth.buffers unicode.case ;
|
||||
IN: morse
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -135,11 +133,17 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
|
|||
: intra-char-gap ( -- ) intra-char-gap-buffer queue ;
|
||||
: letter-gap ( -- ) letter-gap-buffer queue ;
|
||||
|
||||
: beep-freq 880 ;
|
||||
|
||||
: <morse-buffer> ( -- buffer )
|
||||
half-sample-freq <8bit-mono-buffer> ;
|
||||
|
||||
: sine-buffer ( seconds -- id )
|
||||
>r 8 22000 880 r> <sine-wave-buffer> send-buffer* ;
|
||||
beep-freq swap <morse-buffer> >sine-wave-buffer
|
||||
send-buffer id>> ;
|
||||
|
||||
: silent-buffer ( seconds -- id )
|
||||
8 22000 rot <silent-buffer> send-buffer* ;
|
||||
<morse-buffer> >silent-buffer send-buffer id>> ;
|
||||
|
||||
: make-buffers ( unit-length -- )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Converts between text and morse code, and plays morse code.
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
||||
: <buffer> ( 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) ;
|
||||
|
||||
: <sine-wave-buffer> ( bits sample-freq freq seconds -- buffer )
|
||||
>r dupd r> sine-wave-seq <buffer> ;
|
||||
|
||||
: <silent-buffer> ( bits sample-freq seconds -- buffer )
|
||||
dupd * >integer [ drop 0 ] map <buffer> ;
|
||||
|
||||
: play-sine-wave ( bits sample-freq freq seconds -- )
|
||||
init-openal
|
||||
<sine-wave-buffer> send-buffer*
|
||||
1 gen-sources first
|
||||
[ AL_BUFFER rot set-source-param ] [ source-play ] bi
|
||||
check-error ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Alex Chapman
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
USING: help.markup help.syntax sequences ;
|
||||
IN: sequences.merged
|
||||
|
||||
ARTICLE: "sequences-merge" "Merging sequences"
|
||||
"When multiple sequences are merged into one sequence, the new sequence takes an element from each input sequence in turn. For example, if we merge " { $code "{ 1 2 3 }" } "and" { $code "{ \"a\" \"b\" \"c\" }" } "we get:" { $code "{ 1 \"a\" 2 \"b\" 3 \"c\" }" } "."
|
||||
{ $subsection merge }
|
||||
{ $subsection 2merge }
|
||||
{ $subsection 3merge }
|
||||
{ $subsection <merged> }
|
||||
{ $subsection <2merged> }
|
||||
{ $subsection <3merged> } ;
|
||||
|
||||
ABOUT: "sequences-merge"
|
||||
|
||||
HELP: merged
|
||||
{ $class-description "A virtual sequence which presents a merged view of its underlying elements. New instances are created by calling one of " { $link <merged> } ", " { $link <2merged> } ", or " { $link <3merged> } "." }
|
||||
{ $see-also merge } ;
|
||||
|
||||
HELP: <merged> ( seqs -- merged )
|
||||
{ $values { "seqs" "a sequence of sequences to merge" } { "merged" "a virtual sequence" } }
|
||||
{ $description "Creates an instance of the " { $link merged } " virtual sequence." }
|
||||
{ $see-also <2merged> <3merged> merge } ;
|
||||
|
||||
HELP: <2merged> ( seq1 seq2 -- merged )
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "merged" "a virtual sequence" } }
|
||||
{ $description "Creates an instance of the " { $link merged } " virtual sequence which merges the two input sequences." }
|
||||
{ $see-also <merged> <3merged> 2merge } ;
|
||||
|
||||
HELP: <3merged> ( seq1 seq2 seq3 -- merged )
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "merged" "a virtual sequence" } }
|
||||
{ $description "Creates an instance of the " { $link merged } " virtual sequence which merges the three input sequences." }
|
||||
{ $see-also <merged> <2merged> 3merge } ;
|
||||
|
||||
HELP: merge ( seqs -- seq )
|
||||
{ $values { "seqs" "a sequence of sequences to merge" } { "seq" "a new sequence" } }
|
||||
{ $description "Outputs a new sequence which merges the elements of each sequence in " { $snippet "seqs" } "." }
|
||||
{ $examples
|
||||
{ $example "USING: prettyprint sequences.merged ;" "{ { 1 2 } { 3 4 } { 5 6 } } merge ." "{ 1 3 5 2 4 6 }" }
|
||||
{ $example "USING: prettyprint sequences.merged ;" "{ \"abc\" \"def\" } merge ." "\"adbecf\"" }
|
||||
}
|
||||
{ $see-also 2merge 3merge <merged> } ;
|
||||
|
||||
HELP: 2merge ( seq1 seq2 -- seq )
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "seq" "a new sequence" } }
|
||||
{ $description "Creates a new sequence of the same type as " { $snippet "seq1" } " which merges the elements of " { $snippet "seq1" } " and " { $snippet "seq2" } }
|
||||
{ $see-also merge 3merge <2merged> } ;
|
||||
|
||||
HELP: 3merge ( seq1 seq2 seq3 -- seq )
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "seq" "a new sequence" } }
|
||||
{ $description "Creates a new sequence of the same type as " { $snippet "seq1" } " which merges the elements of all three sequences" }
|
||||
{ $see-also merge 2merge <3merged> } ;
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
USING: sequences sequences.merged tools.test ;
|
||||
IN: sequences.merged.tests
|
||||
|
||||
[ 0 { 1 2 } ] [ 0 T{ merged f { { 1 2 } { 3 4 } } } virtual@ ] unit-test
|
||||
[ 0 { 3 4 } ] [ 1 T{ merged f { { 1 2 } { 3 4 } } } virtual@ ] unit-test
|
||||
[ 1 { 1 2 } ] [ 2 T{ merged f { { 1 2 } { 3 4 } } } virtual@ ] unit-test
|
||||
[ 4 ] [ 3 { { 1 2 3 4 } } <merged> nth ] unit-test
|
||||
[ 4 { { 1 2 3 4 } } <merged> nth ] must-fail
|
||||
|
||||
[ 1 ] [ 0 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test
|
||||
[ 4 ] [ 1 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test
|
||||
[ 2 ] [ 2 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test
|
||||
[ 5 ] [ 3 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test
|
||||
[ 3 ] [ 4 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test
|
||||
[ 6 ] [ 5 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test
|
||||
|
||||
[ 4 ] [ 4 { 1 2 } { 3 4 } { 5 6 } 3merge nth ] unit-test
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
! Copyright (C) 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays kernel math sequences ;
|
||||
IN: sequences.merged
|
||||
|
||||
TUPLE: merged seqs ;
|
||||
C: <merged> merged
|
||||
|
||||
: <2merged> ( seq1 seq2 -- merged ) 2array <merged> ;
|
||||
: <3merged> ( seq1 seq2 seq3 -- merged ) 3array <merged> ;
|
||||
|
||||
: merge ( seqs -- seq )
|
||||
dup <merged> swap first like ;
|
||||
|
||||
: 2merge ( seq1 seq2 -- seq )
|
||||
dupd <2merged> swap like ;
|
||||
|
||||
: 3merge ( seq1 seq2 seq3 -- seq )
|
||||
pick >r <3merged> r> like ;
|
||||
|
||||
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 @@
|
|||
A virtual sequence which merges (interleaves) other sequences.
|
||||
|
|
@ -0,0 +1 @@
|
|||
collections
|
||||
|
|
@ -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> ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Alex Chapman
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
||||
: <repeating> ( seq length -- repeating )
|
||||
[ <circular> ] dip repeating boa ;
|
||||
|
||||
: repeated ( seq length -- new-seq )
|
||||
dupd <repeating> 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
|
||||
|
|
@ -0,0 +1 @@
|
|||
Alex Chapman
|
||||
|
|
@ -0,0 +1 @@
|
|||
Alex Chapman
|
||||
|
|
@ -0,0 +1,76 @@
|
|||
! Copyright (C) 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged ;
|
||||
IN: synth.buffers
|
||||
|
||||
TUPLE: buffer sample-freq 8bit? id ;
|
||||
|
||||
: <buffer> ( sample-freq 8bit? -- buffer )
|
||||
f buffer boa ;
|
||||
|
||||
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 ;
|
||||
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 )
|
||||
{
|
||||
[ gen-buffer dup [ >>id ] dip ]
|
||||
[ buffer-format ]
|
||||
[ buffer-data ]
|
||||
[ sample-freq>> alBufferData ]
|
||||
} cleave ;
|
||||
|
||||
: ?send-buffer ( buffer -- buffer )
|
||||
dup id>> [ send-buffer ] unless ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Alex Chapman
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
! Copyright (C) 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
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 @@
|
|||
Simple sound synthesis using OpenAL.
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
! Copyright (C) 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
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