steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix morse for characters that don't exist like "\n". "resource:core/kernel/kernel.factor" utf8 file-contents play-as-morse listen to factor!

db4
Doug Coleman 2009-04-26 01:25:19 -05:00
parent 10ca076722
commit dd15bd0fee
2 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/morse/morse-tests.factor
View File

@ -41,3 +41,4 @@ IN: morse.tests
MORSE] ] unit-test MORSE] ] unit-test
! [ ] [ "sos" 0.075 play-as-morse* ] unit-test ! [ ] [ "sos" 0.075 play-as-morse* ] unit-test
! [ ] [ "Factor rocks!" play-as-morse ] unit-test ! [ ] [ "Factor rocks!" play-as-morse ] unit-test
! [ ] [ "\n" play-as-morse ] unit-test

11
extra/morse/morse.factor
View File

@ -3,13 +3,15 @@
USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal parser sequences splitting strings synth synth.buffers ; USING: accessors ascii assocs biassocs combinators hashtables kernel lists literals math namespaces make multiline openal parser sequences splitting strings synth synth.buffers ;
IN: morse IN: morse
ERROR: no-morse-code ch ;
<PRIVATE <PRIVATE
CONSTANT: dot-char CHAR: . CONSTANT: dot-char CHAR: .
CONSTANT: dash-char CHAR: - CONSTANT: dash-char CHAR: -
CONSTANT: char-gap-char CHAR: \s CONSTANT: char-gap-char CHAR: \s
CONSTANT: word-gap-char CHAR: / CONSTANT: word-gap-char CHAR: /
CONSTANT: unknown-char CHAR: ? CONSTANT: unknown-char "?"
PRIVATE> PRIVATE>
@ -74,10 +76,10 @@ CONSTANT: morse-code-table $[
] ]
: ch>morse ( ch -- morse ) : ch>morse ( ch -- morse )
ch>lower morse-code-table at [ unknown-char ] unless* ; ch>lower morse-code-table at unknown-char or ;
: morse>ch ( str -- ch ) : morse>ch ( str -- ch )
morse-code-table value-at [ char-gap-char ] unless* ; morse-code-table value-at char-gap-char or ;
<PRIVATE <PRIVATE
@ -148,12 +150,13 @@ CONSTANT: beep-freq 880
source get source-play source get source-play
] with-scope ; inline ] with-scope ; inline
: play-char ( ch -- ) : play-char ( string -- )
[ intra-char-gap ] [ [ intra-char-gap ] [
{ {
{ dot-char [ dot ] } { dot-char [ dot ] }
{ dash-char [ dash ] } { dash-char [ dash ] }
{ word-gap-char [ intra-char-gap ] } { word-gap-char [ intra-char-gap ] }
[ drop intra-char-gap ]
} case } case
] interleave ; ] interleave ;