\ morse	2001-05-28	1fou
.( Loading morse..) cr
needs sound
needs toolkit
needs morse-table

variable	UNIT
variable	TONE
create MorseBuffer 86 allot

\ next comes the fix of "MS freeze" bug
\ http://www.quartus.net/discus/messages/23/781.html?990308673

: MS 9 + 10 /
	?dup
	if 0 systaskdelay drop
	then
;

: Unit!	( n -- )	UNIT ! ;
: Unit@	( -- n )	UNIT @ ;
: Hz		( n -- )	TONE ! ;
: Hz?		( -- n )	TONE @ ;
800 Hz  35 Unit!
\ define some words for speed setup
: PARIS	( n -- ) \ paris = 50 units
	6000 swap / Unit! ;
: CODEX	( N -- ) \ codex = 60 units
	60 50 */ PARIS ;
: WPM	( n -- ) \ based on CODEX
	5 * CODEX ;
: PARIS? 6000 Unit@ / ;
: drop-events ( -- )
begin ekey? while ekey drop repeat ;

: dit	Unit@ dup 64 swap Hz?
	sound
	ms drop-events ;
: dah	Unit@ dup 3 * 64 swap Hz?
	sound
	ms drop-events ;
: pause2	Unit@ 2 * ms drop-events ;
: pause4	Unit@ 4 * ms drop-events ;

: code.	( binary -- )
	?dup
	0= if  exit
	then
	begin
		2 /mod swap	( n b )
		over		( n b n )
	while		( n b )
		if	dah	( n )
		else	dit	( n )
		then	
	repeat
	2drop
	pause2
;

: play-stack
	begin
		?dup
	while
		code.
	repeat ;

: letter-index	( c -- c )
	(hex) 20 -
	;

: MorseChar?	( c -- c | false )
	dup (hex) 20 <
	over (hex) 5B >
	or
	if	drop false
	then
;

: >morse	( c -- n )
	>upper
	MorseChar?
	dup
	if
		letter-index
		MorseCodeTable + c@
	then ;

: CQ c" cq cq cq " ;
: +K c" pse k" ;

: CW.		( c -- )
	>morse code. ;

: ssend 	( addr u -- )
	0 do
		dup i + c@
		cw.
	loop
	drop ;

: csend	( addr -- )
	count ssend ;

: zsend	( zaddr -- )
	begin
		dup c@
		?dup
	while
		cw.
		1+
	repeat
	drop
;

: CQ c" cq cq cq " csend ;
: +K c" pse k" csend ;
: QBF C" QUICK BROWN FOX JUMPS OVER THE LAZY DOG 1234567890 =?/.-+ " csend ;

: tcvr
	begin
		cr ." cw> "
		MorseBuffer dup 85 accept
		?dup
		if ssend
		else
			cr ." Tcvr finished"
			exit
		then
	again
;