From bd548d542347aceb76fda026bed71c2234e13ea4 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Sun, 27 Apr 2008 22:36:42 +1000 Subject: [PATCH] add openal.waves to generate tones, and code to play morse code --- extra/morse/morse-docs.factor | 4 ++ extra/morse/morse-tests.factor | 2 + extra/morse/morse.factor | 69 +++++++++++++++++++++++---- extra/openal/openal.factor | 8 +++- extra/openal/waves/waves-tests.factor | 5 ++ extra/openal/waves/waves.factor | 53 ++++++++++++++++++++ 6 files changed, 130 insertions(+), 11 deletions(-) create mode 100644 extra/openal/waves/waves-tests.factor create mode 100644 extra/openal/waves/waves.factor diff --git a/extra/morse/morse-docs.factor b/extra/morse/morse-docs.factor index c11ba23db7..31fc7f34c2 100644 --- a/extra/morse/morse-docs.factor +++ b/extra/morse/morse-docs.factor @@ -23,3 +23,7 @@ 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" } diff --git a/extra/morse/morse-tests.factor b/extra/morse/morse-tests.factor index 97efe1afb4..c87fa483e3 100644 --- a/extra/morse/morse-tests.factor +++ b/extra/morse/morse-tests.factor @@ -9,3 +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!" 0.05 play-as-morse ] unit-test diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor index f493951ed5..d0b9e4003a 100644 --- a/extra/morse/morse.factor +++ b/extra/morse/morse.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: assocs hashtables kernel lazy-lists namespaces openal -parser-combinators promises sequences strings unicode.case ; +USING: assocs combinators hashtables kernel lazy-lists math namespaces +openal openal.waves parser-combinators promises sequences strings symbols +unicode.case ; IN: morse <+> ; @@ -123,3 +124,51 @@ PRIVATE> ] map >string ] map [ [ CHAR: \s , ] [ % ] interleave ] "" make ; +r 8 22000 880 r> send-buffer* ; + +: silent-buffer ( seconds -- id ) + 8 22000 rot send-buffer* ; + +: 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 ; + diff --git a/extra/openal/openal.factor b/extra/openal/openal.factor index ff67a30ea3..c0a79d8353 100644 --- a/extra/openal/openal.factor +++ b/extra/openal/openal.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien system combinators alien.syntax namespaces +USING: kernel arrays alien system combinators alien.syntax namespaces alien.c-types sequences vocabs.loader shuffle combinators.lib openal.backend ; IN: openal @@ -266,6 +266,12 @@ os macosx? "openal.macosx" "openal.other" ? require gen-buffer dup rot load-wav-file [ alBufferData ] 4keep alutUnloadWAV ; +: queue-buffers ( source buffers -- ) + [ length ] [ >c-uint-array ] bi alSourceQueueBuffers ; + +: queue-buffer ( source buffer -- ) + 1array queue-buffers ; + : set-source-param ( source param value -- ) alSourcei ; diff --git a/extra/openal/waves/waves-tests.factor b/extra/openal/waves/waves-tests.factor new file mode 100644 index 0000000000..b295283aac --- /dev/null +++ b/extra/openal/waves/waves-tests.factor @@ -0,0 +1,5 @@ +USING: kernel openal openal.waves sequences tools.test ; +IN: openal.waves.tests + + +[ ] [ 8 22000 440 1 play-sine-wave ] unit-test diff --git a/extra/openal/waves/waves.factor b/extra/openal/waves/waves.factor new file mode 100644 index 0000000000..abe9f8fb69 --- /dev/null +++ b/extra/openal/waves/waves.factor @@ -0,0 +1,53 @@ +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 ; + +: ( 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) ; + +: ( bits sample-freq freq seconds -- buffer ) + >r dupd r> sine-wave-seq ; + +: ( bits sample-freq seconds -- buffer ) + dupd * >integer [ drop 0 ] map ; + +: play-sine-wave ( bits sample-freq freq seconds -- ) + init-openal + send-buffer* + 1 gen-sources first + [ AL_BUFFER rot set-source-param ] [ source-play ] bi + check-error ; +