85 lines
2.9 KiB
Forth
85 lines
2.9 KiB
Forth
HEX
|
|
\ PC speaker hardware control (requires GIVEIO or DOSBOX for windows operation)
|
|
042 constant fctrl
|
|
043 constant tctrl
|
|
061 constant sctrl
|
|
0FC constant smask
|
|
|
|
\ PC@ is Port char fetch (Intel IN instruction). PC! is port char store (Intel OUT instruction)
|
|
: speak ( -- ) sctrl pc@ 03 or sctrl pc! ;
|
|
: silence ( -- ) sctrl pc@ smask and 01 or sctrl pc! ;
|
|
|
|
: tone ( freq -- ) \ freq is actually just a divisor value
|
|
?dup \ check for non-zero input
|
|
if 0B6 tctrl pc! \ enable PC speaker
|
|
dup fctrl pc! \ set freq
|
|
8 rshift fctrl pc!
|
|
speak
|
|
else
|
|
silence
|
|
then ;
|
|
|
|
\ morse demonstration begins here
|
|
DECIMAL
|
|
1000 value freq \ arbitrary value that sounded ok
|
|
90 value adit \ 1 dit will be 90 ms
|
|
|
|
: dit_dur adit ms ;
|
|
: dah_dur adit 3 * ms ;
|
|
: wordgap adit 5 * ms ;
|
|
: off_dur adit 2/ ms ;
|
|
: lettergap dah_dur ;
|
|
|
|
: sound ( -- ) freq tone ;
|
|
|
|
: MORSE-EMIT ( char -- )
|
|
dup bl = \ check for space character
|
|
if
|
|
wordgap drop \ and delay if detected
|
|
else
|
|
pad C! \ write char to buffer
|
|
pad 1 evaluate \ evaluate 1 character
|
|
lettergap \ pause for correct sounding morse code
|
|
then ;
|
|
|
|
: TRANSMIT ( ADDR LEN -- )
|
|
cr \ newline,
|
|
bounds \ convert loop indices to address ranges
|
|
do
|
|
I C@ dup emit \ dup and send char to console
|
|
morse-emit \ send the morse code
|
|
loop ;
|
|
|
|
VOCABULARY MORSE \ prevent name conflicts with letters and numbers
|
|
|
|
MORSE DEFINITIONS \ the following definitions go into MORSE namespace
|
|
: . ( -- ) sound dit_dur silence off_dur ;
|
|
: - ( -- ) sound dah_dur silence off_dur ;
|
|
|
|
\ define morse letters as Forth words. They transmit when executed
|
|
|
|
: A . - ; : B - . . . ; : C - . - . ; : D - . . ;
|
|
: E . ; : F . . - . ; : G - - . ; : H . . . . ;
|
|
: I . . ; : J . - - - ; : K - . - ; : L . - . . ;
|
|
: M - - ; : N - . ; : O - - - ; : P . - - . ;
|
|
: Q - - . - ; : R . - . ; : S . . . ; : T - ;
|
|
: U . . - ; : V . . . - ; : W . - - ; : X - . . - ;
|
|
: Y - . - - ; : Z - - . . ;
|
|
|
|
: 0 - - - - - ; : 1 . - - - - ;
|
|
: 2 . . - - - ; : 3 . . . - - ;
|
|
: 4 . . . . - ; : 5 . . . . . ;
|
|
: 6 - . . . . ; : 7 - - . . . ;
|
|
: 8 - - - . . ; : 9 - - - - . ;
|
|
|
|
: ' - . . - . ;
|
|
: \ . - - - . ;
|
|
: ! . - . - . ;
|
|
: ? . . - - . . ;
|
|
: , - - . . - - ;
|
|
: / - . . - . ;
|
|
: . . - . - . - ;
|
|
|
|
PREVIOUS DEFINITIONS \ go back to previous namespace
|
|
: TRANSMIT MORSE TRANSMIT PREVIOUS ;
|