move openal.waves to synth.buffers, and add merged and repeating sequences

extra/morse/morse-tests.factor

@@ -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
+! [ ] [ "sos" 0.075 play-as-morse* ] unit-test
-[ ] [ "Factor rocks!" play-as-morse ] unit-test
+! [ ] [ "Factor rocks!" play-as-morse ] unit-test

extra/morse/morse.factor

@@ -1,8 +1,6 @@
 ! Copyright (C) 2007 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs combinators hashtables kernel lazy-lists math namespaces
+USING: accessors assocs combinators hashtables kernel lazy-lists math namespaces openal parser-combinators promises sequences strings symbols synth.buffers unicode.case ;
-openal openal.waves parser-combinators promises sequences strings symbols
-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 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 -- )
     {

extra/openal/waves/waves-tests.factor

@@ -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

extra/openal/waves/waves.factor

@@ -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 ;
-

extra/sequences/merged/merged.factor

@@ -13,7 +13,7 @@ C: <merged> merged
     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 ;

extra/sequences/repeating/authors.txt

@@ -0,0 +1 @@
+Alex Chapman

extra/sequences/repeating/repeating-tests.factor

@@ -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

extra/sequences/repeating/repeating.factor

@@ -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

extra/synth/buffers/buffers-tests.factor

@@ -0,0 +1,5 @@
+USING: kernel synth.buffers sequences tools.test ;
+IN: synth.buffers.tests
+
+
+[ ] [ 440 1 half-sample-freq play-sine-wave ] unit-test

extra/synth/buffers/buffers.factor

@@ -0,0 +1,89 @@
+! 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 ;