io.pathnames: go with / on windows for canonicalize-path

[factor.git] / extra / morse / morse.factor

diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor
index 2951c96077e425f740ed534b84a95877d65099d8..334ec9051c224fe3cc54d0b36bd73444b01b0e09 100644 (file)
--- a/extra/morse/morse.factor
+++ b/extra/morse/morse.factor
@@ -1,13 +1,24 @@
-! 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 ;
+! Copyright (C) 2007, 2008, 2009 Alex Chapman, 2009 Diego Martinelli
+! 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-ch ch ;
+
 <PRIVATE
-: morse-codes ( -- array )
-    {
+
+CONSTANT: dot-char CHAR: .
+CONSTANT: dash-char CHAR: -
+CONSTANT: char-gap-char CHAR: \s
+CONSTANT: word-gap-char CHAR: /
+CONSTANT: unknown-char CHAR: ?
+
+PRIVATE>
+
+CONSTANT: morse-code-table $[
+    H{
         { CHAR: a ".-"    }
         { CHAR: b "-..."  }
         { CHAR: c "-.-."  }
@@ -59,72 +70,51 @@ IN: morse
         { 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 ;
+    } >biassoc
+]
 
-PRIVATE>
-
-: ch>morse ( ch -- str )
-    ch>lower ch>morse-assoc at* swap "" ? ;
+: ch>morse ( ch -- morse )
+    ch>lower morse-code-table at unknown-char 1string or ;
 
 : morse>ch ( str -- ch )
-    morse>ch-assoc at* swap f ? ;
-
-: >morse ( str -- str )
-    [
-        [ CHAR: \s , ] [ ch>morse % ] interleave
-    ] "" make ;
+    morse-code-table value-at char-gap-char or ;
 
 <PRIVATE
 
-: dot-char ( -- ch ) CHAR: . ;
-: dash-char ( -- ch ) CHAR: - ;
-: char-gap-char ( -- ch ) CHAR: \s ;
-: word-gap-char ( -- ch ) CHAR: / ;
+: word>morse ( str -- morse )
+    [ ch>morse ] { } map-as join-words ;
 
-: =parser ( obj -- parser )
-    [ = ] curry satisfy ;
+: sentence>morse ( str -- morse )
+    split-words [ word>morse ] map " / " join ;
 
-LAZY: 'dot' ( -- parser )
-    dot-char =parser ;
+: trim-blanks ( str -- newstr )
+    [ blank? ] trim ; inline
 
-LAZY: 'dash' ( -- parser )
-    dash-char =parser ;
+: morse>word ( morse -- str )
+    split-words [ morse>ch ] "" map-as ;
 
-LAZY: 'char-gap' ( -- parser )
-    char-gap-char =parser ;
+: morse>sentence ( morse -- sentence )
+    "/" split [ trim-blanks morse>word ] map join-words ;
 
-LAZY: 'word-gap' ( -- parser )
-    word-gap-char =parser ;
+: replace-underscores ( str -- str' )
+    [ dup CHAR: _ = [ drop CHAR: - ] when ] map ;
 
-LAZY: 'morse-char' ( -- parser )
-    'dot' 'dash' <|> <+> ;
-
-LAZY: 'morse-word' ( -- parser )
-    'morse-char' 'char-gap' list-of ;
+PRIVATE>
 
-LAZY: 'morse-words' ( -- parser )
-    'morse-word' 'word-gap' list-of ;
+: >morse ( str -- newstr )
+    trim-blanks sentence>morse ;
 
-PRIVATE>
+: morse> ( morse -- plain )
+    replace-underscores morse>sentence ;
 
-: morse> ( str -- str )
-    'morse-words' parse car parsed>> [
-        [ 
-            >string morse>ch
-        ] map >string
-    ] map [ [ CHAR: \s , ] [ % ] interleave ] "" make ;
+SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> suffix! ;
 
 <PRIVATE
+
 SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
 
 : queue ( symbol -- )
@@ -135,10 +125,10 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
 : intra-char-gap ( -- ) intra-char-gap-buffer queue ;
 : letter-gap ( -- ) letter-gap-buffer queue ;
 
-: beep-freq 880 ;
+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
@@ -160,14 +150,16 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
         init-openal 1 gen-sources first source set make-buffers
         call
         source get source-play
-    ] with-scope ;
+    ] with-scope ; inline
 
-: play-char ( ch -- )
+: play-char ( string -- )
     [ intra-char-gap ] [
         {
             { dot-char [ dot ] }
             { dash-char [ dash ] }
             { word-gap-char [ intra-char-gap ] }
+            { unknown-char [ intra-char-gap ] }
+            [ no-morse-ch ]
         } case
     ] interleave ;
 
@@ -176,7 +168,7 @@ PRIVATE>
 : play-as-morse* ( str unit-length -- )
     [
         [ letter-gap ] [ ch>morse play-char ] interleave
-    ] swap playing-morse ;
+    ] swap playing-morse ; inline
 
 : play-as-morse ( str -- )
-    0.05 play-as-morse* ;
+    0.05 play-as-morse* ; inline