use warnings;
use strict;
use Data::Dumper;
use Tk;
use Time::HiRes qw(gettimeofday usleep);

use Win32::Sound;

my $tonefile = 'tone.wav';

sub tone_on {
	Win32::Sound::Play($tonefile, SND_ASYNC, SND_LOOP);		
}

sub tone_off {
	Win32::Sound::Stop();
}

my $commentblock =<<'COMMENT'
	mixed abcdfgjklnpqruvwxyz
	only dots = ehis
	zero to two dots and at most one dash (fast) = rdestinau  D -.. E . S ... T - I .. N -. A .- T - I .. O --- N -.
	lots of dots N -. E . V ...- E . R .-.   S ... H .... I .. N -. E . 
	only dashes = mot
	lots of dashes T - O --- M -- M -- Y -.--   P .--. O --- P .--.
	two or more dashes and at most one dot (slow) =  oucgjkpqwxyz G --. R .-. O --- U ..- C -.-. H .... Y -.--

	circular  U ..- B -... A .- D -.. U ..- B -... A .- D -..
	constrast (letter boundaries always change .- or -.) 

	 a dah is conventionally 3 times as long as a dit. 
	Spacing between dits and dahs in a character is the length of one dit. 
	Spacing between letters in a word is the length of a dah (3 dits). 
	Spacing between words is 7 dits.

	FCC requirement for minimum Morse Code rating is 5 wpm.

	The word "PARIS" is used as a standard "word" in calculating words-per-minute.
	P .--. A .- R .-. I .. S ...
	PARIS times in at 
	P .--. 	= 11
	A .-   	= 5
	R .-.	= 7
	I .. 	= 3
	S ...	= 5
	4 * 3	=12 dits for spaces between letters in Paris
		= 7 dits for space between words
	total	=50 dits total per word

	 1 word     50 dits    1 minute    0.8333 dits
	-------- * --------- * -------- = -------------
	minute      1 word      60 secs    second


	 1 wpm =  0.83333 dits per second = 1.20 seconds per dit
	 5 wpm =  4.16667 dits per second = 0.24 seconds per dit
	10 wpm =  8.33333 dits per second = 0.12 seconds per dit
	20 wpm = 16.66667 dits per second = 0.06 seconds per dit
COMMENT
;


my $morsecode = <<'MARKER' 


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 --.. 
	Ä .-.- 
	Á .--.- 
	Å .--.- 
	Ch ---- 
	É ..-.. 
	Ñ --.-- 
	Ö ---. 
	Ü ..-- 
0 ----- 
1 .---- 
2 ..--- 
3 ...-- 
4 ....- 
5 ..... 
6 -.... 
7 --... 
8 ---.. 
9 ----. 
. .-.-.- 
, --..-- 
: ---... 
? ..--.. 
' .----. 
- -....- 
/ -..-.  
() -.--.- 
" .-..-. 
@ .--.-. 
= -...- 

MARKER
;

my %letter2code;
my %code2letter;

while(length($morsecode)) {
	next unless($morsecode =~ s{\A([^\n]*)\n}{});
	my $line = $1;
	next if($line =~ m{\A\s*\Z}); # skip blank lines
	next if($line =~ m{\A\t});    # skip lines starting with TAB. (marked as comments)
	unless($line =~ m{\A(\S+)\s([.-]+)\s*\Z}) {
		print "unknown line '$line'\n";
	}
	my $char = $1;
	my $code = $2;
	my @codes = split(//, $code);
	$letter2code{$char}=\@codes;
	$code2letter{$code}=$char;
}

$letter2code{' '}=[];

#print Dumper \%letter2code;




sub play_text_as_tones
{
	my ($text, $wpm)=@_;
	my $ditlength = 1.2 / $wpm; # 50 dits in a word. 1 word per minute = 1.2 dits per second.
	$ditlength *= 1000000; # usleep takes the number of microseconds to sleep
	$text=uc($text);
	while(length($text)){
		unless($text=~s{\A(.)}{}) {
			die "error extracting character from '$text'";
		}
		my $char = $1;
		play_char_as_tones($char,$ditlength);
	}
}

my $unit = 100000;
sub play_char_as_tones
{
	my ($char, $dotlength)=@_;
	unless(exists($letter2code{$char})) {
		die "character does not exist in letter2code table '$char'";
	}
	
	foreach my $tone (@{$letter2code{$char}}) {
		#print "$tone";
		my $delay = ($tone eq '-') ? 2*$dotlength : $dotlength;
		tone_on();
		usleep($delay);
		tone_off();
		usleep($dotlength/2);		
	}

	usleep($dotlength);
	#print "\n";		
}
	
# play_text_as_tones("calibrate", 10);

##############################################################
my $tonefreq = 4400;   # herz

sub generate_tone_file
{    
	my($filename, $tonefreq)=@_;

	# Create the object
	my $WAV = new Win32::Sound::WaveOut(44100, 8, 2);

	my $data = ""; 
	my $counter = 0;
	my $increment = $tonefreq/44100;

	no strict;
	no warnings;

	# Generate 44100 samples ( = 1 second)
	for my $i (1..(44100*2)) {	
		# Calculate the pitch 
		# (range 0..255 for 8 bits)
		my $v = sin($counter/2*3.14) * 128 + 128;    

		# "pack" it twice for left and right
		$data .= pack("cc", $v, $v);

		$counter += $increment;
	}

	$WAV->Load($data);       # get it
	$WAV->Write();           # hear it
	1 until $WAV->Status();  # wait for completion
	$WAV->Save($filename); # write to disk
	$WAV->Unload();          # drop it
}

unless(-e $tonefile) 
{
	generate_tone_file($tonefile, $tonefreq);
}

################################################################
    














sub finish { exit; };

my $main = MainWindow->new();
#$main->resizable('yes','no');
$main->title('morse.pl - http://www.greglondon.com');

my $xmit_frame = $main->Frame()
	->pack(-anchor=>'nw');


	my $margin = 10;
	my $linethick = 10;


my $scrolled_canvas = $main->Scrolled('Canvas', 
	-scrollbars=>'s', -height=> (3*$margin + $linethick) )
	->pack(-anchor=>'nw', -expand=>'yes', -fill => 'x');

my $recv_frame = $main->Frame()
	->pack(-anchor=>'nw');



$xmit_frame->Button (
	-text=>'QUIT',
	-command=> sub{finish;},
	)
	->grid(-row=>10,-column=>10,-sticky=>'ew');


my $mouse_mode_selection = 'telegraph';

my $col = 20;
foreach my $mouse_mode qw( telegraph iambic_a iambic_b ) {
	$xmit_frame->Radiobutton ( -text=>$mouse_mode, -value=>$mouse_mode, -variable=>\$mouse_mode_selection)
	->grid(-row=>10, -column=>$col, -sticky=>'ew');
	$col+=10;
	}

my $xmit_text = '';

$xmit_frame->Button ( -text=>"Transmit", -command=>sub{$xmit_text='Hello'} )
	->grid(-row=>20, -column=>10, -sticky=>'ew');

my $gui_xmit_wpm=0;

$xmit_frame->Label 
	( -text=>'wpm=' )
	->grid(-row=>20,-column=>15,-columnspan=>4,-sticky=>'ew');

$xmit_frame->Label 
	( -textvariable=>\$gui_xmit_wpm, -width=>3 )
	->grid(-row=>20,-column=>20,-columnspan=>4,-sticky=>'ew');


my $paddle = $xmit_frame->Label (
	-text=>'paddle', -relief=>'groove'
	)
	->grid(-row=>20,-column=>30,-columnspan=>4,-sticky=>'ew');

$xmit_frame->Entry( -textvariable => \$xmit_text, -width=>20 )
	->grid(-row=>20, -column=>40, -sticky=>'ew');


my $canvas = $scrolled_canvas->Subwidget("canvas");

my @chars_that_have_been_sent;

$recv_frame->Button ( -text=>"Recieve", 
	-command=>sub{ calculate_milliseconds_per_dit(); @chars_that_have_been_sent=(); RecieveTest(); } )
	->grid(-row=>10, -column=>10, -sticky=>'ew');


$recv_frame->Label 
	( -text=>'wpm=' )
	->grid(-row=>10,-column=>20,-sticky=>'ew');

my $gui_rcv_wpm=15;

my $milliseconds_per_dit;

sub calculate_milliseconds_per_dit{
	if(length($gui_rcv_wpm)==0) {
		$gui_rcv_wpm = 10; #default
	}

	$milliseconds_per_dit =  ( 60 * 1000)/($gui_rcv_wpm * 50);

	#print "milliseconds_per_dit = '$milliseconds_per_dit'\n";
}

sub validate_wpm {
	my ($in1, $in2, $in3)=@_;

	#print Dumper \@_;

	return 0 if (length($in1)>2);
	return 0 if (defined($in2) and ($in2 =~ m{\D}));

	return 1;
}

$recv_frame->Entry
	( -textvariable => \$gui_rcv_wpm, 
	  -validate=>'all', 
	  -validatecommand=>\&validate_wpm, 
  	  -width=>3 )
	->grid(-row=>10,-column=>30, -sticky=>'ew');


my $keypad = $recv_frame->Label(-text=>'keypad') 
	->grid(-row=>10,-column=>40,-sticky=>'ew');

my $user_keystrokes='';

$recv_frame->Label ( -textvariable => \$user_keystrokes, -width=>30)
	->grid(-row=>10,-column=>50,-sticky=>'ew');

{
	my @letters_to_choose_from_ARRAY = ('A' .. 'Z');

	my %letters_in_play;

	my $max_in_play=3;
	my $how_many_successes_qualifies_as_learned = 10;

	sub ChooseLetterToSend {
		if(scalar(@chars_that_have_been_sent)){
			my $sent = $chars_that_have_been_sent[-1]->{sent};
			my $typed='';
			if(exists($chars_that_have_been_sent[-1]->{typed})) {
				$typed = $chars_that_have_been_sent[-1]->{typed};
			}

			if($sent ne $typed) {
				return $sent;
			}
		}


		if(scalar(keys(%letters_in_play))<$max_in_play) {
			my $index = rand(scalar(@letters_to_choose_from_ARRAY));
			my $char = splice(@letters_to_choose_from_ARRAY, $index, 1);
			$letters_in_play{$char}=0;
			return $char;
		} else {
			my @array = keys(%letters_in_play);
			my $char = $array[rand(scalar(@array))];
			return $char;
		}
	}

	sub UserFailedLetterThisTime {
		my ($letter)=@_;
		$letters_in_play{$letter}=0;
	}

	sub UserRecognizedLetterThisTime {
		my ($letter)=@_;
		my $count = ($letters_in_play{$letter}) + 1;
		$letters_in_play{$letter} = $count+0;
		if($count>$how_many_successes_qualifies_as_learned) {
			push(@letters_to_choose_from_ARRAY, $letter);
			delete($letters_in_play{$letter});
		}	
	}
	
		
}



sub RecieveTest {

	my $char=ChooseLetterToSend ();

	play_text_as_tones($char, $gui_rcv_wpm);

	push(@chars_that_have_been_sent, {sent=>$char} );
	if(scalar(@chars_that_have_been_sent)>6) {
		shift(@chars_that_have_been_sent);
	}
};


sub repeat_last_transmission {
	foreach my $element (@chars_that_have_been_sent) {
		if(!(exists($element->{typed}))) {
			my $char = $element->{sent};
			play_text_as_tones($char, $gui_rcv_wpm);
		}
	}	

}

sub update_recieve_data_with_user_keystroke_char {
	my ($latest_keystroke)=@_;
	SEARCH: foreach my $element (@chars_that_have_been_sent) {
		if(!(exists($element->{typed}))) {
			$element->{typed}=$latest_keystroke;
			if($element->{sent} eq $latest_keystroke) {
				UserRecognizedLetterThisTime ($element->{sent});
			} else {
				UserFailedLetterThisTime($element->{sent});
			}
			last SEARCH;
		}
	}	
}

sub display_user_keystroke_history {	
	$user_keystrokes='';
	foreach my $element (@chars_that_have_been_sent) {
		my $sent = $element->{sent};

		if(exists($element->{typed})) {

			my $typed = $element->{typed};

			if($sent eq $typed) {
				$user_keystrokes .= $sent;
			} else {
				my $bad = lc($typed);
				$user_keystrokes .= "($sent/$bad)";
			}
		} else {
			$user_keystrokes .= '?';
		}

	}

}

$keypad->bind('<Enter>'=> sub{$keypad->focusForce();});
# $keypad->bind('<Leave>'=> sub{$keypad->focusLast();});


sub user_keypress { 
	my $event = $keypad->XEvent; 
	my $char = $event->K; 	

	if($char eq 'space') {
		repeat_last_transmission();
		return;
	}
	$char = uc($char); 

	#print "pressed '$char'\n"; 
	update_recieve_data_with_user_keystroke_char ($char);
	$keypad->idletasks();

	RecieveTest();
	display_user_keystroke_history ();
	$keypad->idletasks();
}

$keypad->bind('<KeyPress>' => \&user_keypress  );


my @telegraph_timings;

sub telegraph_press1 {
	tone_on();
	my $currenttime = gettimeofday;
	push(@telegraph_timings, [0,$currenttime]);
}

sub telegraph_release1 {
	tone_off();
	my $currenttime = gettimeofday;
	push(@telegraph_timings, [1,$currenttime]);
}

sub clean_canvas {
	$canvas->delete($canvas->find("all"));
}

sub fix_canvas_scroll_region {
	$canvas->configure(-scrollregion=>[$canvas->bbox("all")]);
}

sub visualize_transmit_timing {
	clean_canvas();

	my $seperator_line_height = (1.5 * $margin)+$linethick;

	$canvas->createLine(0, $seperator_line_height, $margin, $seperator_line_height );

	my $once = 1;
	DRAWING: while($once) {
		$once = 0;

		if(defined($xmit_text) and length($xmit_text)) {

			##########################################
			# First, draw the ideal version of the pattern
			##########################################


			my $xcoord = $margin;
			my $ycoord = $margin;
			my $ditwidth=30;

			my $uc = uc( $xmit_text );
			my @letters = split(//, $uc);

			while (@letters) {
				my $letter = shift(@letters);
				#print "letter is '$letter'\n";

				unless(exists($letter2code{$letter})) {
					print "couldn't find code for letter '$letter'\n";
					next;
				}

				my @codes = @{$letter2code{$letter}};
				while (@codes) {
					my $code = shift(@codes);
					#print "code is '$code'\n";

					my $len = 0;
					if($code eq '.') {
						$len = $ditwidth;
					} elsif ($code eq '-') {
						$len = 3 * $ditwidth;					
					} else {
						die "bad code in letter. code = '$code'. letter='$letter'";
					}

					my $end_coord = $xcoord+$len;
					$canvas->createRectangle($xcoord, $ycoord, $end_coord, $ycoord+$linethick, -fill=>'black');

					$xcoord = $end_coord;

					# space between symbols is one dit. space between letters is 3 dits.
					if(scalar(@codes)) {
						$xcoord += $ditwidth;
					}	
				}

				# there are 7 dits of silence between words
				if($letter eq ' ') {
					$xcoord += 7 * $ditwidth;
					next;

				# there are 3 dits of silence between letters.
				# (unless the next letter is a space)
				} elsif (scalar(@letters) and ($letters[0] ne ' ')) {
					$xcoord += 3 * $ditwidth;
				}				


			}

			$ycoord += $linethick + $margin;

			##########################################
			# clean up the paddletiming array
			##########################################
			#print Dumper \@telegraph_timings;


			last DRAWING unless(scalar(@telegraph_timings));

			my $start_time = $telegraph_timings[0]->[1];

			# first, make sure that the first entry in paddle timings is a keypress = 0
			while( scalar(@telegraph_timings) and ($telegraph_timings[0]->[0] == 1) ){
				my $temp = shift(@telegraph_timings);
				$start_time = $temp->[1];
				
			}

			last DRAWING unless(scalar(@telegraph_timings));			

			# second, make sure the last entry in the paddle timings is a key release == 1
			while( scalar(@telegraph_timings) and ($telegraph_timings[-1]->[0] == 0) ){
				pop(@telegraph_timings);
			}

			last DRAWING unless(scalar(@telegraph_timings));

			#print Dumper \@telegraph_timings;

			##########################################
			# now go through the ideal codes again
			# and see where the user stopped keying in
			##########################################

			my @pdl_copy = @telegraph_timings;

			@letters = split(//, $uc);			# example: hi

			my $user_dits = 0;  #length in dits
			my $totalpaddletime = 0; #time in seconds

			LETTERS: while (@letters) {
				my $letter = shift(@letters);		# example: 'i'
				#print "letter is '$letter'\n";
				unless(exists($letter2code{$letter})) {
					next;
				}

				if($letter eq ' ') {
					$user_dits += 4;
					next LETTERS;
				}

				my @codes = @{$letter2code{$letter}};
				CODES: while (@codes) {			# example:  dot dot
					my $code = shift(@codes);	# example:  dot
					#print "code is '$code'\n";

					last LETTERS unless(scalar(@pdl_copy)); # this should be a press == 0
					my $paddle1 = shift(@pdl_copy);
					last LETTERS unless(scalar(@pdl_copy)); # this should be a release == 1
					my $paddle2 = shift(@pdl_copy);

					$totalpaddletime = $paddle2->[1] - $start_time;

					if($code eq '.') {
						$user_dits  += 1;
					} elsif ($code eq '-') {
						$user_dits += 3;
					} else {
						die "bad code in letter. code = '$code'. letter='$letter'";
					}

					if(scalar(@codes) and scalar(@pdl_copy)){
						$user_dits += 1;
					}
				}

				if(scalar(@letters) and scalar(@pdl_copy)) {
					$user_dits += 3;
				}
			}

			
			my $user_words_per_minute = (60 * $user_dits) / (50 * $totalpaddletime);
			$gui_xmit_wpm = int($user_words_per_minute);
			#print "user_dits is '$user_dits'\n";   # total number of dits xmitted by user
			#print "totalpaddletime is '$totalpaddletime'\n"; # total duration of user paddling in seconds
			#print "user_words_per_minute is '$user_words_per_minute'\n"; # user words per minute given number of dits they transmitted in time


			last DRAWING if ($totalpaddletime == 0);

			my $pixels_per_second = ($user_dits * $ditwidth) / $totalpaddletime;
			#print "pixels_per_second is '$pixels_per_second '\n";

			##################################################
			# we've calculated how many pixels per second 
			# to use to scale the timings to be in line with the "ideal"
			# code pattern. Now go through the paddle timeings and 
			# use the pixels-per-second value to draw the pattern 
			##################################################

			$xcoord = $margin;

			shift(@telegraph_timings);

			while(@telegraph_timings) {
				my $entry = shift(@telegraph_timings);
				my $flag = $entry->[0];
				my $deltatime= $entry->[1] - $start_time;

				my $end_coord = $margin + ($deltatime * $pixels_per_second);

				my $fill = $flag ? 'black' : 'white';

				if($fill eq 'black') {	
					$canvas->createRectangle($xcoord, $ycoord, $end_coord, $ycoord+$linethick, -fill=>$fill);
				}

				$xcoord = $end_coord;	
			}


		}
	}
	fix_canvas_scroll_region();

	@telegraph_timings=();
	
}
 

my $callback_overhead=0;
my $max_system_wpm=30;

sub calculate_callback_overhead {
	
	# store the current tonefile filename in a temp variable.
	# change the filename to "silent", generate a silent file.
	# want a silent file because we're going to start playing
	# the file a whole bunch of times. quiet is good.
	
	my $temptonefile=$tonefile;
	#$tonefile='silent.wav';
	unless(-e $tonefile){
		generate_tone_file($tonefile, 1);
	}

	# now call the callback pairs as many times as possible in 5 seconds.
	# and see how long it takes on average for a single press/release
	my $count = 100;
	my $starttime = gettimeofday;
	
	
	for(my $i=0; $i<$count; $i++){
		telegraph_press1();
		telegraph_release1();
	}

	my $endtime = gettimeofday;
	
	my $timeforloop=$endtime-$starttime;
	my $timeforone = $timeforloop / $count;

	$callback_overhead = $timeforone;
	print "press/release overhead is $callback_overhead seconds\n";
	
	$max_system_wpm = int(1.2 / ($callback_overhead * 6))-1;
	print "max words per minute your system can handle = $max_system_wpm\n";
	
	# set the tonefile back to the original filename.
	$tonefile = $temptonefile;

}

#calculate_callback_overhead();

my $prev_iambic_code;

my $dit_is_pushed=0;
my $dash_is_pushed=0;

# note: $mouse_mode_selection == ( telegraph iambic_a iambic_b )

my @code_queue;
my $current_code;
my $last_code_was_dit=0;

sub iambic_callback {
	#print ("iambic_callback\n");
	#print "dit_is_pushed is '$dit_is_pushed'\n";
	#print "dash_is_pushed is '$dash_is_pushed'\n";
	#print Dumper \@code_queue;

	if(scalar(@code_queue)) {
		$current_code=shift(@code_queue);
	} else {
		$current_code = 'off';

		if(0) {
		} elsif ($dit_is_pushed and $dash_is_pushed) {
			if($last_code_was_dit) {
				push(@code_queue, 'dash');
			} else {
				push(@code_queue, 'dit');
			}
		} elsif ($dit_is_pushed) {
			push(@code_queue, 'dit');
		} elsif ($dash_is_pushed) {
			
			push(@code_queue, 'dash');
		} else {
			$last_code_was_dit=0;
		}
	}


	if($current_code eq 'dit') {
		telegraph_press1 ();
		$last_code_was_dit=1;
		$main->after($milliseconds_per_dit, \&iambic_callback)
	} elsif($current_code eq 'dash') {
		telegraph_press1 ();
		$last_code_was_dit=0;
		$main->after(3*$milliseconds_per_dit, \&iambic_callback)
	} else {
		# turn sound off
		telegraph_release1 ();

		# if there are any more codes in the queue, schedule callback.
		if(scalar(@code_queue)) {
			$main->after($milliseconds_per_dit, \&iambic_callback)
		}
	}

}

sub press_mouse_1 {
	if($mouse_mode_selection eq 'telegraph') {
		telegraph_press1 ();
	} else {

		$dit_is_pushed=1;
		return if($dash_is_pushed);
		push(@code_queue, 'dit');

		iambic_callback();
	}
}

sub release_mouse_1 {
	$dit_is_pushed=0;
	if($mouse_mode_selection eq 'telegraph') {
		telegraph_release1 ();
	} elsif (($mouse_mode_selection eq 'iambic_b') and ($current_code eq 'dash')){
		push(@code_queue, 'off','dit');
	}
}


sub press_mouse_3 {
	if($mouse_mode_selection eq 'telegraph') {
		telegraph_press1 ();
	} else {
		$dash_is_pushed=1;
		return if($dit_is_pushed);

		push(@code_queue, 'dash');

		iambic_callback();
	}
}

sub release_mouse_3 {
	$dash_is_pushed=0;
	if($mouse_mode_selection eq 'telegraph') {
		telegraph_release1 ();
	} elsif (($mouse_mode_selection eq 'iambic_b') and ($current_code eq 'dit')){
		push(@code_queue, 'off','dash');
	}

}



$paddle->bind('<ButtonPress-1>' => [\&press_mouse_1 , Ev('A')]);

$paddle->bind('<ButtonRelease-1>' => [\&release_mouse_1, Ev('A')]);


$paddle->bind('<ButtonPress-3>' => [\&press_mouse_3 , Ev('A')]);

$paddle->bind('<ButtonRelease-3>' => [\&release_mouse_3, Ev('A')]);


$paddle->bind('<Enter>' => [sub{ calculate_milliseconds_per_dit() }, Ev('A')]);

$paddle->bind('<Leave>' => [sub{tone_off(); visualize_transmit_timing(); }, Ev('A')]);



MainLoop();


=head1 morse.pl

morse.pl - This is a morse code trainer, both transmit 
and receive, written in pure perl. It uses standard 
sound to transmit tones to the user, and the user keys
in morse code using the mouse buttons.

This is a beta version of the program. 

=head1 README

The speed of your sytem will determine how fast the
program will properly transmit and recieve. I have an
older system that can only transmit up to about 15
words per minute before the sound gets distorted.

The run the program and a GUI will appear. 

To practice transmitting, click on the button labeled
"Transmit". This will put some text into the entry
widget that you are to transmit.

Move the mouse over the label "paddle".

Key in the morse code pattern using the mouse button.
When you are finished transmitting, the program will
display the ideal version of the transmitted text
and your version.

To practice recieving, click on the button labeled
"Recieve". The gui will transmit a single letter.
Move the mouse over the "keypad" label. Type the 
letter that was just transmitted. THe program will 
then tell you if you are correct or not, and transmit
the next letter.

=pod SCRIPT CATEGORIES
Educational

=pod OSNAMES
Windows

=head1 AUTHOR

morse.pl - Copyright 2006 Greg London,  All rights reserved.

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

=cut