calendar.format: make duration>human-readable more human readable

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

diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor
index 49e6ae39f594355eda6e3cb7c75904fb8b4bfd51..334ec9051c224fe3cc54d0b36bd73444b01b0e09 100644 (file)
--- a/extra/morse/morse.factor
+++ b/extra/morse/morse.factor
@@ -1,9 +1,12 @@
 ! 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 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-ch ch ;
+
 <PRIVATE
 
 CONSTANT: dot-char CHAR: .
@@ -14,107 +17,104 @@ CONSTANT: unknown-char CHAR: ?
 
 PRIVATE>
 
-DEFER: morse-code-table
-
-H{
-    { 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 "/" }
-} >biassoc \ morse-code-table set-global
-
-: morse-code-table ( -- biassoc )
-    \ morse-code-table get-global ;
+CONSTANT: morse-code-table $[
+    H{
+        { 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 "/" }
+    } >biassoc
+]
 
 : ch>morse ( ch -- morse )
-    ch>lower morse-code-table at [ unknown-char ] unless* ;
+    ch>lower morse-code-table at unknown-char 1string or ;
 
 : morse>ch ( str -- ch )
-    morse-code-table value-at [ char-gap-char ] unless* ;
-    
+    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 -- )
@@ -128,7 +128,7 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
 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
@@ -152,12 +152,14 @@ CONSTANT: beep-freq 880
         source get source-play
     ] 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 ;