! Copyright (C) 2007, 2008, 2009 Alex Chapman, 2009 Diego Martinelli
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal parser sequences splitting strings synth synth.buffers ;
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors ascii assocs biassocs combinators kernel
+literals math multiline namespaces openal openal.alut sequences
+splitting strings synth synth.buffers ;
IN: morse
-ERROR: no-morse-code ch ;
+ERROR: no-morse-ch ch ;
<PRIVATE
CONSTANT: dash-char CHAR: -
CONSTANT: char-gap-char CHAR: \s
CONSTANT: word-gap-char CHAR: /
-CONSTANT: unknown-char "?"
+CONSTANT: unknown-char CHAR: ?
PRIVATE>
{ CHAR: + ".-.-." }
{ CHAR: - "-....-" }
{ CHAR: _ "..--.-" }
- { CHAR: " ".-..-." }
+ { CHAR: \" ".-..-." }
{ CHAR: $ "...-..-" }
{ CHAR: @ ".--.-." }
{ CHAR: \s "/" }
]
: ch>morse ( ch -- morse )
- ch>lower morse-code-table at unknown-char or ;
+ ch>lower morse-code-table at unknown-char 1string or ;
: morse>ch ( str -- ch )
morse-code-table value-at char-gap-char or ;
-
+
<PRIVATE
-
+
: word>morse ( str -- morse )
- [ ch>morse ] { } map-as " " join ;
+ [ ch>morse ] { } map-as join-words ;
: sentence>morse ( str -- morse )
- " " split [ word>morse ] map " / " join ;
-
+ split-words [ word>morse ] map " / " join ;
+
: trim-blanks ( str -- newstr )
[ blank? ] trim ; inline
: morse>word ( morse -- str )
- " " split [ morse>ch ] "" map-as ;
+ split-words [ morse>ch ] "" map-as ;
: morse>sentence ( morse -- sentence )
- "/" split [ trim-blanks morse>word ] map " " join ;
+ "/" split [ trim-blanks morse>word ] map join-words ;
: replace-underscores ( str -- str' )
[ dup CHAR: _ = [ drop CHAR: - ] when ] map ;
PRIVATE>
-
+
: >morse ( str -- newstr )
trim-blanks sentence>morse ;
-
+
: morse> ( morse -- plain )
replace-underscores morse>sentence ;
-SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> parsed ;
-
+SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> suffix! ;
+
<PRIVATE
-
+
SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
: queue ( symbol -- )
CONSTANT: beep-freq 880
: <morse-buffer> ( -- buffer )
- half-sample-freq <8bit-mono-buffer> ;
+ half-sample-freq <8-bit-mono-buffer> ;
: sine-buffer ( seconds -- id )
beep-freq swap <morse-buffer> >sine-wave-buffer
{ dot-char [ dot ] }
{ dash-char [ dash ] }
{ word-gap-char [ intra-char-gap ] }
- [ drop intra-char-gap ]
+ { unknown-char [ intra-char-gap ] }
+ [ no-morse-ch ]
} case
] interleave ;