morse

#!/usr/bin/perl

=begin metadata

Name: morse
Description: read morse and translate it to text
Author: Abigail, perlpowertools@abigail.be
Author: Michael Mikonos
License: perl

=end metadata

=cut

use strict;

use Getopt::Std qw(getopts);

my ($VERSION) = '1.3';

my %chartab = (
     0   => '-----',   1   => '.----',   2   => '..---',   3   => '...--',
     4   => '....-',   5   => '.....',   6   => '-....',   7   => '--...',
     8   => '---..',   9   => '----.',   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   => '--..',

    '.'  => '.-.-.-', ','  => '--..--', ':'  => '---...', '?'  => '..--..',
    "'"  => '.----.', '-'  => '-....-', '/'  => '-..-.',  '('  => '-.--.-',
    ')'  => '-.--.-', '"'  => '.-..-.', '='  => '-...-',  ';'  => '-.-.-.',
    '+'  => '.-.-.', 
);
my %translations = reverse %chartab;

my %wordtab = (
    'dit'  => '.',
    'daw'  => '-',
);

my %opt;
getopts('frs', \%opt) or die qq{Usage:
 $0 [-frs] [file  ...]
 $0 [-rs] [string ...]
};
if ($opt{'f'} || scalar(@ARGV) == 0) {
    if ($opt{'r'}) {
        $opt{'s'} ? decode_dot() : decode_word();
    } else {
        $opt{'s'} ? encode_dot() : encode_word();
    }
} else {
    if ($opt{'r'}) {
        $opt{'s'} ? decode_dot_arg() : decode_word_arg();
    } else {
        $opt{'s'} ? encode_dot_arg() : encode_word_arg();
    }
}

sub mors2txt {
    my $line = shift;

    $line =~ s/\A\s+//;
    foreach my $m (split /\s+/, $line) {
        if (!exists($translations{$m})) {
            die "$m: unknown token";
        }
        print $translations{$m};
    }
    print "\n" if (tell(*STDOUT) > 0);
}

sub txt2mors {
    my $line = shift;

    foreach my $c (split //, $line) {
        if ($c eq "\n" || $c eq ' ') {
            print "\n";
        } elsif (exists $chartab{$c}) {
            print ($chartab{$c}, "\n");
        } elsif (exists $chartab{lc $c}) {
            print ($chartab{lc $c}, "\n");
        }
    }
}

sub txt2word {
    my $line = shift;

    foreach my $c (split //, $line) {
        if ($c eq "\n") {
            print "\n";
        } elsif (exists $chartab{$c}) {
            my $w = $chartab{$c};
            $w =~ s/\./dit /g;
            $w =~ s/\-/daw /g;
            print ($w, "\n");
        }
    }
}

sub word2txt {
    my $line = shift;

    foreach my $part (split /[,\n]/, $line) {
        my $m = '';
        foreach my $tok (split /\s+/, $part) {
            next if (length($tok) == 0);
            if (!exists($wordtab{$tok})) {
                die "$tok: unknown token";
            }
            $m .= $wordtab{$tok};
        }
        next if (length($m) == 0);
        if (!exists($translations{$m})) {
            die "$m: unknown token";
        }
        print $translations{$m};
    }
    print "\n" if (tell(*STDOUT) > 0);
}

sub decode_dot_arg  { mors2txt(join "\n", @ARGV) }
sub decode_dot      { mors2txt(join '', readline) }
sub decode_word_arg { word2txt(join ' ', @ARGV) }
sub decode_word     { word2txt(join "\n", readline) }
sub encode_dot_arg  { txt2mors(join "\n", @ARGV) }
sub encode_dot      { txt2mors(join '', readline) }
sub encode_word_arg { txt2word(join "\n", @ARGV) }
sub encode_word     { txt2word(join '', readline) }

__END__

=pod

=head1 NAME

morse - translate text to morse code

=head1 SYNOPSIS

morse [-frs] [file  ...]

morse [-rs] [string ...]

=head1 DESCRIPTION

I<morse> takes input from either a list of files, standard input or command line arguments.
Morse code can be given in either
short form (-- --- .-. ... .) or long form (daw daw, daw daw daw, dit daw dit,
dit dit dit).
Long form is used by default.

Short-form morse uses both spaces and newline characters as a separator.
Long-form morse requires a space between each 'dit' or 'daw'.
Long-form also requires a comma or newline character as a separator for each morse code.

A morse code document may be translated back to text.
The program will terminate if it encounters a series of dots and dashes
that it cannot translate.

=head2 OPTIONS

The following options are available:

=over 3

=item -f

Treat command arguments as files instead of morse code strings.

=item -r

Decode input from morse to text.

=item -s

Process short-form morse (dots and dashes) instead of the default long-form.
The argument '--' should precede any morse code provided as command arguments.

=back

=head1 ENVIRONMENT

The working of I<morse> is not influenced by any environment variables.

=head1 EXAMPLES

Decode short-form morse from stdin.

  echo - .- --- | morse -rs

Decode long-form morse from stdin.

  echo daw, dit daw, daw daw daw | morse -r

Decode short-form morse from argument list.
Note that '--' terminates the processing of command options, so the first morse code is '-'.

  morse -rs -- - .- ---

Decode long-form morse from argument list.

  morse -r daw, dit daw, daw daw daw

Encode short-form morse from stdin.

  echo foo | morse -s

Encode long-form morse from stdin.

  echo foo | morse

Encode short-form morse from argument list.

  morse -s tst txt

Encode long-form morse from argument list.

  morse tst txt

Decode short-form morse from files.

  morse -frs file1 file2

Decode long-form morse from files.

  morse -fr file1 file2

Encode short-form morse from files.

  morse -fs file1 file2

Encode long-form morse from files.

  morse -f file1 file2

=head1 AUTHOR

The Perl implementation of I<morse> was written by Abigail,
I<perlpowertools@abigail.be>. The program was extended by
Michael Mikonos.

=head1 COPYRIGHT and LICENSE

This program is copyright by Abigail 1999.

This program is free and open software. You may use, copy, modify, distribute
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others to do the same.

=cut