Paste: Morse code translator
Author: | saurabh |
Mode: | factor |
Date: | Wed, 29 Jul 2009 12:57:47 |
Plain Text |
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
{
{ 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
morse-codes >hashtable ;
: morse>ch-assoc
morse-codes [ reverse ] map >hashtable ;
PRIVATE>
: ch>morse
ch>lower ch>morse-assoc at* swap "" ? ;
: morse>ch
morse>ch-assoc at* swap f ? ;
: >morse
[
[ CHAR: \s , ] [ ch>morse % ] interleave
] "" make ;
<PRIVATE
: dot-char CHAR: . ;
: dash-char CHAR: - ;
: char-gap-char CHAR: \s ;
: word-gap-char CHAR: / ;
: =parser
[ = ] curry satisfy ;
LAZY: 'dot'
dot-char =parser ;
LAZY: 'dash'
dash-char =parser ;
LAZY: 'char-gap'
char-gap-char =parser ;
LAZY: 'word-gap'
word-gap-char =parser ;
LAZY: 'morse-char'
'dot' 'dash' <|> <+> ;
LAZY: 'morse-word'
'morse-char' 'char-gap' list-of ;
LAZY: 'morse-words'
'morse-word' 'word-gap' list-of ;
PRIVATE>
: morse>
'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
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>
half-sample-freq <8bit-mono-buffer> ;
: sine-buffer
beep-freq swap <morse-buffer> >sine-wave-buffer
send-buffer id>> ;
: silent-buffer
<morse-buffer> >silent-buffer send-buffer id>> ;
: make-buffers
{
[ 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
[
init-openal 1 gen-sources first source set make-buffers
call
source get source-play
] with-scope ;
: play-char
[ intra-char-gap ] [
{
{ dot-char [ dot ] }
{ dash-char [ dash ] }
{ word-gap-char [ intra-char-gap ] }
} case
] interleave ;
PRIVATE>
: play-as-morse*
[
[ letter-gap ] [ ch>morse play-char ] interleave
] swap playing-morse ;
: play-as-morse
0.05 play-as-morse* ;
New Annotation