{ $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" }
[ "-- --- .-. ... . / -.-. --- -.. ." ] [ "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
! 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
<PRIVATE
<PRIVATE
-: dot ( -- ch ) CHAR: . ;
-: dash ( -- ch ) CHAR: - ;
-: char-gap ( -- ch ) CHAR: \s ;
-: word-gap ( -- ch ) CHAR: / ;
+: 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 =parser ;
+ dot-char =parser ;
LAZY: 'dash' ( -- parser )
- dash =parser ;
+ dash-char =parser ;
LAZY: 'char-gap' ( -- parser )
- char-gap =parser ;
+ char-gap-char =parser ;
LAZY: 'word-gap' ( -- parser )
- word-gap =parser ;
+ word-gap-char =parser ;
LAZY: 'morse-char' ( -- parser )
'dot' 'dash' <|> <+> ;
] 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 ;
+
+: sine-buffer ( seconds -- id )
+ >r 8 22000 880 r> <sine-wave-buffer> send-buffer* ;
+
+: silent-buffer ( seconds -- id )
+ 8 22000 rot <silent-buffer> 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 ;
+
! 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
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 ;
--- /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 ;
+
projects / factor.git / commitdiff