[ "-- --- .-. ... . / -.-. --- -.. ." ] [ "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
! 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
<PRIVATE
: intra-char-gap ( -- ) intra-char-gap-buffer queue ;
: letter-gap ( -- ) letter-gap-buffer queue ;
+: beep-freq 880 ;
+
+: <morse-buffer> ( -- buffer )
+ half-sample-freq t <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 -- )
{
+++ /dev/null
-USING: kernel openal openal.waves sequences tools.test ;
-IN: openal.waves.tests
-
-
-[ ] [ 8 22000 440 1 play-sine-wave ] unit-test
+++ /dev/null
-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 ;
-
dup <merged> 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 ;
--- /dev/null
+Alex Chapman
--- /dev/null
+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
--- /dev/null
+! 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
--- /dev/null
+USING: kernel synth.buffers sequences tools.test ;
+IN: synth.buffers.tests
+
+
+[ ] [ 440 1 half-sample-freq play-sine-wave ] unit-test
--- /dev/null
+! 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 ;
+
+: <buffer> ( sample-freq 8bit? -- buffer )
+ f gen-buffer buffer boa ;
+
+TUPLE: mono-buffer < buffer data ;
+
+: <mono-buffer> ( sample-freq 8bit? -- buffer )
+ f gen-buffer f mono-buffer boa ;
+
+TUPLE: stereo-buffer < buffer left-data right-data ;
+
+: <stereo-buffer> ( 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 <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 ;