--- /dev/null
+Alex Chapman
--- /dev/null
+! Copyright (C) 2007 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: morse
+
+HELP: ch>morse
+{ $values
+ { "ch" "A character that has a morse code translation" } { "str" "A string consisting of zero or more dots and dashes" } }
+{ $description "If the given character has a morse code translation, then return that translation, otherwise return an empty string." } ;
+
+HELP: morse>ch
+{ $values
+ { "str" "A string of dots and dashes that represents a single character in morse code" } { "ch" "The translated character" } }
+{ $description "If the given string represents a morse code character, then return that character, otherwise return f" } ;
+
+HELP: >morse
+{ $values
+ { "str" "A string of ASCII characters which can be translated into morse code" } { "str" "A string in morse code" } }
+{ $description "Translates ASCII text into morse code, represented by a series of dots, dashes, and slashes." }
+{ $see-also morse> ch>morse } ;
+
+HELP: morse>
+{ $values { "str" "A string of morse code, in which the character '.' represents dots, '-' dashes, ' ' spaces between letters, and ' / ' spaces between words." } { "str" "The ASCII translation of the given string" } }
+{ $description "Translates morse code into ASCII text" }
+{ $see-also >morse morse>ch } ;
+
+HELP: play-as-morse*
+{ $values { "str" "A string of ascii characters which can be translated into morse code" } { "unit-length" "The length of a dot" } }
+{ $description "Plays a string as morse code" } ;
+
+HELP: play-as-morse
+{ $values { "str" "A string of ascii characters which can be translated into morse code" } }
+{ $description "Plays a string as morse code" } ;
--- /dev/null
+! Copyright (C) 2007 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays morse strings tools.test ;
+
+[ "" ] [ CHAR: \\ ch>morse ] unit-test
+[ "..." ] [ CHAR: s ch>morse ] unit-test
+[ CHAR: s ] [ "..." morse>ch ] unit-test
+[ f ] [ "..--..--.." morse>ch ] unit-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
--- /dev/null
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs combinators hashtables kernel lists math
+namespaces make openal parser-combinators promises sequences
+strings symbols synth synth.buffers unicode.case ;
+IN: morse
+
+<PRIVATE
+: morse-codes ( -- array )
+ {
+ { CHAR: a ".-" }
+ { CHAR: b "-..." }
+ { CHAR: c "-.-." }
+ { CHAR: d "-.." }
+ { CHAR: e "." }
+ { CHAR: f "..-." }
+ { CHAR: g "--." }
+ { CHAR: h "...." }
+ { CHAR: i ".." }
+ { CHAR: j ".---" }
+ { CHAR: k "-.-" }
+ { CHAR: l ".-.." }
+ { CHAR: m "--" }
+ { CHAR: n "-." }
+ { CHAR: o "---" }
+ { CHAR: p ".--." }
+ { CHAR: q "--.-" }
+ { CHAR: r ".-." }
+ { CHAR: s "..." }
+ { CHAR: t "-" }
+ { CHAR: u "..-" }
+ { CHAR: v "...-" }
+ { CHAR: w ".--" }
+ { CHAR: x "-..-" }
+ { CHAR: y "-.--" }
+ { CHAR: z "--.." }
+ { CHAR: 1 ".----" }
+ { CHAR: 2 "..---" }
+ { CHAR: 3 "...--" }
+ { CHAR: 4 "....-" }
+ { CHAR: 5 "....." }
+ { CHAR: 6 "-...." }
+ { CHAR: 7 "--..." }
+ { CHAR: 8 "---.." }
+ { CHAR: 9 "----." }
+ { CHAR: 0 "-----" }
+ { CHAR: . ".-.-.-" }
+ { CHAR: , "--..--" }
+ { CHAR: ? "..--.." }
+ { CHAR: ' ".----." }
+ { CHAR: ! "-.-.--" }
+ { CHAR: / "-..-." }
+ { CHAR: ( "-.--." }
+ { CHAR: ) "-.--.-" }
+ { CHAR: & ".-..." }
+ { CHAR: : "---..." }
+ { CHAR: ; "-.-.-." }
+ { CHAR: = "-...- " }
+ { CHAR: + ".-.-." }
+ { CHAR: - "-....-" }
+ { CHAR: _ "..--.-" }
+ { CHAR: " ".-..-." }
+ { CHAR: $ "...-..-" }
+ { CHAR: @ ".--.-." }
+ { CHAR: \s "/" }
+ } ;
+
+: ch>morse-assoc ( -- assoc )
+ morse-codes >hashtable ;
+
+: morse>ch-assoc ( -- assoc )
+ morse-codes [ reverse ] map >hashtable ;
+
+PRIVATE>
+
+: ch>morse ( ch -- str )
+ ch>lower ch>morse-assoc at* swap "" ? ;
+
+: morse>ch ( str -- ch )
+ morse>ch-assoc at* swap f ? ;
+
+: >morse ( str -- str )
+ [
+ [ CHAR: \s , ] [ ch>morse % ] interleave
+ ] "" make ;
+
+<PRIVATE
+
+: dot-char ( -- ch ) CHAR: . ;
+: dash-char ( -- ch ) CHAR: - ;
+: char-gap-char ( -- ch ) CHAR: \s ;
+: word-gap-char ( -- ch ) CHAR: / ;
+
+: =parser ( obj -- parser )
+ [ = ] curry satisfy ;
+
+LAZY: 'dot' ( -- parser )
+ dot-char =parser ;
+
+LAZY: 'dash' ( -- parser )
+ dash-char =parser ;
+
+LAZY: 'char-gap' ( -- parser )
+ char-gap-char =parser ;
+
+LAZY: 'word-gap' ( -- parser )
+ word-gap-char =parser ;
+
+LAZY: 'morse-char' ( -- parser )
+ 'dot' 'dash' <|> <+> ;
+
+LAZY: 'morse-word' ( -- parser )
+ 'morse-char' 'char-gap' list-of ;
+
+LAZY: 'morse-words' ( -- parser )
+ 'morse-word' 'word-gap' list-of ;
+
+PRIVATE>
+
+: morse> ( str -- str )
+ 'morse-words' parse car parsed>> [
+ [
+ >string morse>ch
+ ] map >string
+ ] map [ [ CHAR: \s , ] [ % ] interleave ] "" make ;
+
+<PRIVATE
+SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
+
+: queue ( symbol -- )
+ get source get swap queue-buffer ;
+
+: dot ( -- ) dot-buffer queue ;
+: dash ( -- ) dash-buffer queue ;
+: 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 )
+ beep-freq swap <morse-buffer> >sine-wave-buffer
+ send-buffer id>> ;
+
+: silent-buffer ( seconds -- id )
+ <morse-buffer> >silent-buffer send-buffer id>> ;
+
+: make-buffers ( unit-length -- )
+ {
+ [ sine-buffer dot-buffer set ]
+ [ 3 * sine-buffer dash-buffer set ]
+ [ silent-buffer intra-char-gap-buffer set ]
+ [ 3 * silent-buffer letter-gap-buffer set ]
+ } cleave ;
+
+: playing-morse ( quot unit-length -- )
+ [
+ init-openal 1 gen-sources first source set make-buffers
+ call
+ source get source-play
+ ] with-scope ;
+
+: play-char ( ch -- )
+ [ intra-char-gap ] [
+ {
+ { dot-char [ dot ] }
+ { dash-char [ dash ] }
+ { word-gap-char [ intra-char-gap ] }
+ } case
+ ] interleave ;
+
+PRIVATE>
+
+: play-as-morse* ( str unit-length -- )
+ [
+ [ letter-gap ] [ ch>morse play-char ] interleave
+ ] swap playing-morse ;
+
+: play-as-morse ( str -- )
+ 0.05 play-as-morse* ;
--- /dev/null
+Converts between text and morse code, and plays morse code.
--- /dev/null
+Alex Chapman
--- /dev/null
+Alex Chapman
--- /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.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 + ] uchar-array{ } map-as [ underlying>> ] [ length ] bi ;
+
+: 16bit-buffer-data ( seq -- data size )
+ [ 32768 * >integer ] short-array{ } map-as [ underlying>> ] [ byte-length ] 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 ;
+
--- /dev/null
+Alex Chapman
--- /dev/null
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays kernel namespaces make 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
+Simple sound synthesis using OpenAL.
--- /dev/null
+! 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 ;
+
+++ /dev/null
-Alex Chapman
+++ /dev/null
-! Copyright (C) 2007 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax ;
-IN: morse
-
-HELP: ch>morse
-{ $values
- { "ch" "A character that has a morse code translation" } { "str" "A string consisting of zero or more dots and dashes" } }
-{ $description "If the given character has a morse code translation, then return that translation, otherwise return an empty string." } ;
-
-HELP: morse>ch
-{ $values
- { "str" "A string of dots and dashes that represents a single character in morse code" } { "ch" "The translated character" } }
-{ $description "If the given string represents a morse code character, then return that character, otherwise return f" } ;
-
-HELP: >morse
-{ $values
- { "str" "A string of ASCII characters which can be translated into morse code" } { "str" "A string in morse code" } }
-{ $description "Translates ASCII text into morse code, represented by a series of dots, dashes, and slashes." }
-{ $see-also morse> ch>morse } ;
-
-HELP: morse>
-{ $values { "str" "A string of morse code, in which the character '.' represents dots, '-' dashes, ' ' spaces between letters, and ' / ' spaces between words." } { "str" "The ASCII translation of the given string" } }
-{ $description "Translates morse code into ASCII text" }
-{ $see-also >morse morse>ch } ;
-
-HELP: play-as-morse*
-{ $values { "str" "A string of ascii characters which can be translated into morse code" } { "unit-length" "The length of a dot" } }
-{ $description "Plays a string as morse code" } ;
-
-HELP: play-as-morse
-{ $values { "str" "A string of ascii characters which can be translated into morse code" } }
-{ $description "Plays a string as morse code" } ;
+++ /dev/null
-! Copyright (C) 2007 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays morse strings tools.test ;
-
-[ "" ] [ CHAR: \\ ch>morse ] unit-test
-[ "..." ] [ CHAR: s ch>morse ] unit-test
-[ CHAR: s ] [ "..." morse>ch ] unit-test
-[ f ] [ "..--..--.." morse>ch ] unit-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
+++ /dev/null
-! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators hashtables kernel lists math
-namespaces make openal parser-combinators promises sequences
-strings symbols synth synth.buffers unicode.case ;
-IN: morse
-
-<PRIVATE
-: morse-codes ( -- array )
- {
- { CHAR: a ".-" }
- { CHAR: b "-..." }
- { CHAR: c "-.-." }
- { CHAR: d "-.." }
- { CHAR: e "." }
- { CHAR: f "..-." }
- { CHAR: g "--." }
- { CHAR: h "...." }
- { CHAR: i ".." }
- { CHAR: j ".---" }
- { CHAR: k "-.-" }
- { CHAR: l ".-.." }
- { CHAR: m "--" }
- { CHAR: n "-." }
- { CHAR: o "---" }
- { CHAR: p ".--." }
- { CHAR: q "--.-" }
- { CHAR: r ".-." }
- { CHAR: s "..." }
- { CHAR: t "-" }
- { CHAR: u "..-" }
- { CHAR: v "...-" }
- { CHAR: w ".--" }
- { CHAR: x "-..-" }
- { CHAR: y "-.--" }
- { CHAR: z "--.." }
- { CHAR: 1 ".----" }
- { CHAR: 2 "..---" }
- { CHAR: 3 "...--" }
- { CHAR: 4 "....-" }
- { CHAR: 5 "....." }
- { CHAR: 6 "-...." }
- { CHAR: 7 "--..." }
- { CHAR: 8 "---.." }
- { CHAR: 9 "----." }
- { CHAR: 0 "-----" }
- { CHAR: . ".-.-.-" }
- { CHAR: , "--..--" }
- { CHAR: ? "..--.." }
- { CHAR: ' ".----." }
- { CHAR: ! "-.-.--" }
- { CHAR: / "-..-." }
- { CHAR: ( "-.--." }
- { CHAR: ) "-.--.-" }
- { CHAR: & ".-..." }
- { CHAR: : "---..." }
- { CHAR: ; "-.-.-." }
- { CHAR: = "-...- " }
- { CHAR: + ".-.-." }
- { CHAR: - "-....-" }
- { CHAR: _ "..--.-" }
- { CHAR: " ".-..-." }
- { CHAR: $ "...-..-" }
- { CHAR: @ ".--.-." }
- { CHAR: \s "/" }
- } ;
-
-: ch>morse-assoc ( -- assoc )
- morse-codes >hashtable ;
-
-: morse>ch-assoc ( -- assoc )
- morse-codes [ reverse ] map >hashtable ;
-
-PRIVATE>
-
-: ch>morse ( ch -- str )
- ch>lower ch>morse-assoc at* swap "" ? ;
-
-: morse>ch ( str -- ch )
- morse>ch-assoc at* swap f ? ;
-
-: >morse ( str -- str )
- [
- [ CHAR: \s , ] [ ch>morse % ] interleave
- ] "" make ;
-
-<PRIVATE
-
-: dot-char ( -- ch ) CHAR: . ;
-: dash-char ( -- ch ) CHAR: - ;
-: char-gap-char ( -- ch ) CHAR: \s ;
-: word-gap-char ( -- ch ) CHAR: / ;
-
-: =parser ( obj -- parser )
- [ = ] curry satisfy ;
-
-LAZY: 'dot' ( -- parser )
- dot-char =parser ;
-
-LAZY: 'dash' ( -- parser )
- dash-char =parser ;
-
-LAZY: 'char-gap' ( -- parser )
- char-gap-char =parser ;
-
-LAZY: 'word-gap' ( -- parser )
- word-gap-char =parser ;
-
-LAZY: 'morse-char' ( -- parser )
- 'dot' 'dash' <|> <+> ;
-
-LAZY: 'morse-word' ( -- parser )
- 'morse-char' 'char-gap' list-of ;
-
-LAZY: 'morse-words' ( -- parser )
- 'morse-word' 'word-gap' list-of ;
-
-PRIVATE>
-
-: morse> ( str -- str )
- 'morse-words' parse car parsed>> [
- [
- >string morse>ch
- ] map >string
- ] map [ [ CHAR: \s , ] [ % ] interleave ] "" make ;
-
-<PRIVATE
-SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
-
-: queue ( symbol -- )
- get source get swap queue-buffer ;
-
-: dot ( -- ) dot-buffer queue ;
-: dash ( -- ) dash-buffer queue ;
-: 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 )
- beep-freq swap <morse-buffer> >sine-wave-buffer
- send-buffer id>> ;
-
-: silent-buffer ( seconds -- id )
- <morse-buffer> >silent-buffer send-buffer id>> ;
-
-: make-buffers ( unit-length -- )
- {
- [ sine-buffer dot-buffer set ]
- [ 3 * sine-buffer dash-buffer set ]
- [ silent-buffer intra-char-gap-buffer set ]
- [ 3 * silent-buffer letter-gap-buffer set ]
- } cleave ;
-
-: playing-morse ( quot unit-length -- )
- [
- init-openal 1 gen-sources first source set make-buffers
- call
- source get source-play
- ] with-scope ;
-
-: play-char ( ch -- )
- [ intra-char-gap ] [
- {
- { dot-char [ dot ] }
- { dash-char [ dash ] }
- { word-gap-char [ intra-char-gap ] }
- } case
- ] interleave ;
-
-PRIVATE>
-
-: play-as-morse* ( str unit-length -- )
- [
- [ letter-gap ] [ ch>morse play-char ] interleave
- ] swap playing-morse ;
-
-: play-as-morse ( str -- )
- 0.05 play-as-morse* ;
+++ /dev/null
-Converts between text and morse code, and plays morse code.
+++ /dev/null
-Alex Chapman
+++ /dev/null
-Alex Chapman
+++ /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.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 + ] uchar-array{ } map-as [ underlying>> ] [ length ] bi ;
-
-: 16bit-buffer-data ( seq -- data size )
- [ 32768 * >integer ] short-array{ } map-as [ underlying>> ] [ byte-length ] 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 ;
-
+++ /dev/null
-Alex Chapman
+++ /dev/null
-! Copyright (C) 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel namespaces make 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
-Simple sound synthesis using OpenAL.
+++ /dev/null
-! 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 ;
-
projects / factor.git / commitdiff