#! /usr/bin/perl -w
use strict;
use IO::Handle;
use File::Temp;

=head1 NAME

mkmorse - Generate ASCII or audio Morse code

=head1 SYNOPSIS

B<mkmorse> [I<OPTIONS>] [B<-->] I<TEXT>

=head1 DESCRIPTION

B<mkmorse> converts a text string to Morse code and writes it to
standard output.  The output format is determined by the options.

=head1 OPTIONS

=over 4

=item B<--format> I<FORMAT>

Select the output format.  Possible formats are B<text>, B<binary>,
B<wav> and B<mp3>.

B<binary> produces single-channel, big-endian, signed, 16-bit samples.

B<wav> and B<mp3> depend on B<sox>(1).

The default is B<text>.

=item B<--rate> I<RATE>

Select the sample rate in samples per second for audio output.  The
default is B<44100>.

=item B<--length> I<LENGTH>

Select the length of a dot in seconds.  The default is B<0.1>.

=item B<--tone> I<FREQUENCY>

Select the frequency of the audio output in Hz.  The default is B<440>.

=item B<--amplitude> I<AMPLITUDE>

Select the amplitude of the audiot output, in the range 0 to 1.  The
default is B<1.0>.

=item B<--debug>

Display debug messages.

=item B<--help>

Display a usage message.

=back

=head1 SEE ALSO

B<sox>(1)

=cut

our %morse = (
    "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" => "--..",
    "1" => ".----",
    "2" => "..---",
    "3" => "...--",
    "4" => "....-",
    "5" => ".....",
    "6" => "-....",
    "7" => "--...",
    "8" => "---..",
    "9" => "----.",
    "0" => "-----",
);

our $format = "text";
our $rate = 44100;
our $length = 0.1;
our $tone = 440;
our $amplitude = 1.0;
our $PI = 3.14159265358979323844;
our $output;
our $debug = 0;

while(@ARGV > 0 && $ARGV[0] =~ /^-/) {
    local $_ = shift;
    if($_ eq "--format") {
	$format = shift;
    } elsif($_ eq "--rate") {
	$rate = shift;
    } elsif($_ eq "--length") {
	$length = shift;
    } elsif($_ eq "--tone") {
	$tone = shift;
    } elsif($_ eq "--amplitude") {
	$amplitude = shift;
    } elsif($_ eq "--debug") {
	$debug = 1;
    } elsif($_ eq "--help") {
	print
"Usage:
  mkmorse [OPTIONS] [--] MESSAGE > OUTPUT

Options:
  --format FORMAT    Output format
  --rate RATE        Sample rate (Hz; default=44100)
  --length SECONDS   Length of a dot (s; default=0.1)
  --tone FREQ        Tone frequency (Hz; default=440)
  --amplitude AMP    Amplitude (default=1)
Output formats:
  text               ASCII (default)
  binary             raw (sox -t raw -B -b 16 -c 1 -e signed-integer)
  wav                .wav (requires sox)
  mp3                .mp3 (requires sox)
";
    } elsif($_ eq "--") {
	last;
    } else {
	die "ERROR: unknown option '$_'\n";
    }
}

local $_ = join(" ", @ARGV);

# Normalize
s/[^a-zA-Z0-9 \t\n]+//g;
s/[ \t\n]+/ /g;
s/^ //;
s/ $//;

# Convert
s/[a-zA-Z0-9]/"$morse{lc($&)} "/ge;

sub silence($) {
    my $intervals = shift;
    my $samples = $intervals * $length * $rate;
    $output->printf("\0" x (2 * $samples)) or die "ERROR: writing audio: $!\n";
}

sub tone($) {
    my $intervals = shift;
    my $samples = $intervals * $length * $rate;
    for(my $n = 0; $n < $samples; ++$n) {
	my $value = int(32767 * $amplitude * sin($n * 2 * $PI * $tone / $rate));
	if($value < 0) { $value = ($value + 65536) & 65535; }
	$output->print(chr(int($value / 256)), chr($value & 255))
	    or die "ERROR: writing audio: $!\n";
    }
}

if($format eq 'text') {
    print "$_\n" or die "ERROR: stdout: $!\n";
} elsif($format eq 'binary'
	or $format eq 'wav'
	or $format eq 'mp3') {
    print STDERR "DEBUG: morse: $_\n" if $debug;
    if($format eq 'binary') {
	$output = new IO::Handle();
	$output->fdopen(fileno(STDOUT), "w");
    } else {
	$output = File::Temp->new();
	print STDERR "DEBUG: writing to ", $output->filename, "\n" if $debug;
    }
    my $state = "";
    while(/(\.|-| |  )/g) {
	if($& eq ".") {
	    if($state ne "") { silence(1); }
	    tone(1);
	    $state = ".";
	} elsif($& eq "-") {
	    if($state ne "") { silence(1); }
	    tone(3);
	    $state = ".";
	} elsif($& eq " ") {
	    silence(3);
	    $state = "";
	} elsif($& eq "  ") {
	    silence(7);
	    $state = "";
	}
    }
    $output->flush();
    if($format ne 'binary') {
	my @command = ("sox",
		       "-t", "raw",
		       "-B",
		       "-b", "16",
		       "-c", "1",
		       "-e", "signed-integer",
		       "-r", $rate,
		       $output->filename,
		       "-t", $format,
		       "-");
	print STDERR "DEBUG: ", join(" ", @command), "\n" if $debug;
	my $rc = system(@command);
	if($rc) { die "ERROR: sox: $rc\n"; }
    }
} else {
    die "ERROR: unknown format '$format'\n";
}
close STDOUT or die "ERROR: stdout: $!\n";