morse.fs
\ vim:ft=forth:fenc=utf-8:ts=4:sw=4:et:
\ This is a morse code keying program, or it will be when it's finished.
\ Text entered at the keyboard will cause a serial control line to be toggled
\ with a signal appropriate for keying a CW transceiver.
\ Right now it mostly consists of utility words, and words to test the utility
\ words.
\
\ By Robert Liesenfeld AK6L, original idea and inspiration by Bob Liesenfeld WB0POQ.
\ Forth advice and a couple of utility words by Alexander Guy.
\ Software licenses are boring. Use this code if you want, I hope it is interesting.
\ Or better yet, educational. Put my name on it if you like, or don't.
create morse_table 48 2 * allot \ There aren't 48 valid morse characters, but this allows us to index based
\ on ASCII values. A few of the cells (<5) will go unused.
morse_table 48 2 * erase \ Clear the table
variable bit_count
variable encoded_char
\ Returns a flag indicating whether the number n1 is between hi and lo.
: inside? ( hi lo n1 -- flag ) swap over <= -rot >= and ;
\ Returns a flag indicating whether the ASCII character is within the range of letters we have in our table.
: valid? ( ascii -- flag ) [char] Z [char] + 2 roll inside? ;
\ Given the ASCII value of a letter, produces an address in morse_table for the bit count.
\ The address of the encoded character can be derived from this (1+, NOT 1 cells +)
: maddr ( ascii -- addr )
\ and encoded character. Name stands for "morse address".
[char] + - 2 * \ Build the offset into the morse_table
morse_table + \ Add offset to base address
;
\ Store an encoded character and its associated bit count in the morse_table.
: morse! ( encbyte count ascii -- ) >r r@ maddr c! r> maddr 1+ c! ;
\ Fetch an encoded character and its associated bit count from the morse_table.
: morse@ ( ascii -- encbyte count ) >r r@ maddr 1+ c@ r> maddr c@ ;
\ Compile an ASCII character and dit-dah representation into an encoded character and bitcount,
\ and store them in the morse_table.
: morse, ( ascii input stream: morse -- )
dup valid? invert if abort" Character out of range" then
\ Check if the ASCII character on the stack is a valid morse code character
>r \ Put ASCII code for letter in question on return stack
0 bit_count ! \ Initialize bit_count to zero
0 encoded_char ! \ Initialize encoded_char to zero
tib bl word count over + swap \ Find words on the input stream, build start and end addresses for do loop
do
i c@ \ Using the loop index, fetch the next character from the input stream
46 45 2 pick inside? invert \ Range check of input values
if leave then \ If range check fails, bounce!
45 - \ Reduce the dit or dah to a 0 or 1 (0 for dah)
encoded_char @ 1 lshift \ Fetch the encoded character and << it one bit
or \ OR the dit or dah with it
bit_count @ 1+ bit_count ! \ Increment the bit count, put it back on the return stack
encoded_char ! \ Store the latest modification to encoded_char
loop
encoded_char @ bit_count @ \ Fetch encoded_char and the bit_count
r> \ Get the ASCII code for the letter we're compiling
morse! \ Store values in proper place in morse table
drop \ Drop the tib address
;
\ Print dits and dahs based on a byte and the count of significant bits.
: (morse.) ( encbyte count -- )
dup 0= if 2drop exit then \ If the count is zero, this is an empty table entry (e.g. invalid morse character)
>r \ Put the count on the return stack ( encbyte -- )
8 r@ - \ Subtract the count from 8 ( encbyte sum -- )
lshift \ Shift the encoded character left by sum bits ( <<encbyte -- )
r> 0 \ Retrieve the count from the return stack, push a 0 to make loop bounds ( <<encbyte count 0 -- )
do
dup \ Duplicate the shifted, encoded byte ( <<encbyte <<encbyte -- )
i lshift \ Shift left by the current loop iteration ( <<encbyte <<<<encbyte -- )
128 and \ AND out the leftmost bit ( <<encbyte bit -- )
if ." ." else ." -" then \ Print a dit or a dah based on the bit ( <<encbyte -- )
loop
drop \ Drop the shifted, encoded byte
;
\ Range-checked call to (morse.), with ASCII-to-encbyte/count lookup
\ Prints dits and dahs that correspond to an ASCII character.
: morse. ( ascii -- )
dup [char] Z [char] + 2 roll inside?
invert if drop exit then
morse@ (morse.)
;
\ Range-checked, looped "emit".
: emit# ( n c -- ) swap dup 0= if 2drop exit then dup 10 u> if .s cr abort" Value(s) too large" then 0 do dup emit loop drop ;
: spaces ( n -- ) $20 emit# ;
: ones ( n -- ) $31 emit# ;
\ Utility function to dump morse_table in a meaningful fashion.
\ Exists simply to test the words that do the actual work.
: dumptable ( -- )
cr cr \ Output header
." ch mask morse ch mask morse ch mask morse ch mask morse " cr
." ------------------------------------------------------------------------------------" cr
48 [char] + + \ Calculate offset to end of table
[char] + \ Start of table
do
[char] + i swap -
dup
0= invert
if 4 mod 0= if cr then else drop then \ Print a CR every 5 table entries
i emit 2 spaces \ Print the character in this table
i morse@
dup \ Save a copy of the bit count for (morse.)
dup 6 swap - \ Calc number of spaces to print
spaces \ Print spaces
ones \ Print ones
2 spaces \ Print some padding
dup -rot \ Save a copy of bitcount underneath
(morse.) \ Print morse representation of character
6 swap - spaces \ Keep spacing even
4 spaces
loop
cr cr
;
\ Build the morse table. I've left out a couple of less-commonly-used morse
\ characters, such as @ ("commercial-at" according to Wikipedia) and : (colon).
char + morse, .-.-.
char , morse, --..--
char - morse, -....-
char . morse, .-.-.-
char / morse, -..-.
char = morse, -...-
char ? morse, ..--..
char 0 morse, -----
char 1 morse, .----
char 2 morse, ..---
char 3 morse, ...--
char 4 morse, ....-
char 5 morse, .....
char 6 morse, -....
char 7 morse, --...
char 8 morse, ---..
char 9 morse, ----.
char A morse, .-
char B morse, -...
char C morse, -.-.
char D morse, -..
char E morse, .
char F morse, ..-.
char G morse, --.
char H morse, ....
char I morse, ..
char J morse, .---
char K morse, -.-
char L morse, .-..
char M morse, --
char N morse, -.
char O morse, ---
char P morse, .--.
char Q morse, --.-
char R morse, .-.
char S morse, ...
char T morse, -
char U morse, ..-
char V morse, ...-
char W morse, .--
char X morse, -..-
char Y morse, -.--
char Z morse, --..
\ Dump the table we just compiled, to make sure it worked.
dumptable
Generated by GNU enscript 1.6.4.