#!/usr/bin/perl
# -----------------------------------------------------------------------------
# zzzmorse -- encode to / decode from morse code
#             Make symlinks as *encode and *decode to set encode/decode mode.
#             Give input as arguments or enter something terminated by ^D.
# Copyright (C) 2003, 2004 Fabian "zzznowman" Pietsch <fabian@zzznowman.dyndns.org>
#
# Inspired by and initially based on morse_encode.pl & morse_decode.pl,
# available at http://loeffel.dyndns.org/stuff/
# Copyright (C) 2003 s_20 & maka 
#
# Distributed under the GNU GPL (General Public Licence)
# zzzmorse is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# zzzmorse is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# -----------------------------------------------------------------------------
#
# Version 0.1.4 (2004-04-30)
#
# ChangeLog:
#   o 0.1.1
#     o Now encodes  ! ; | _ \ ` ´ ß  as  . . , - / ' ' sz
#   o 0.1.2
#     o fixed typo in credits
#     o fixed space expansion (see comment below on $trans_to{' '})
#     o minor fixes to comments etc.
#   o 0.1.3
#     [skipped to keep versions in synch with zzzmorse.pl (Irssi version)]
#   o 0.1.4
#     o added encoding for '@': '.--.-.'
#
# Bugs:
#   o Currently doesn't encode:  # * = + ~ µ ^ ° § $ % & ² ³ < >  etc.
#   o While encoding, the code for Ch isn't used; this is due to only humans
#     being able to decide whether 'ch' in a word is meant to be a german 'ch'
#     or not. (At least I guess so...)
#

use strict;

# morse translation table
# source: http://www.soton.ac.uk/~scp93ch/morse/index.html?http://www.soton.ac.uk/~scp93ch/morse/morse.html
my %trans_to = (
	# letters
	'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' => '--..',

	# digits
	'1' => '.----',
	'2' => '..---',
	'3' => '...--',
	'4' => '....-',
	'5' => '.....',
	'6' => '-....',
	'7' => '--...',
	'8' => '---..',
	'9' => '----.',
	'0' => '-----',

	# foreign letters
	'Ä' => '.-.-',
	'Á' => '.--.-',
	'Å' => '.--.-',
	'Ch' => '----',
	'É' => '..-..',
	'Ñ' => '--.--',
	'Ö' => '---.',
	'Ü' => '..--',

	# punctuation chars
	'.' => '.-.-.-',
	',' => '--..--',
	':' => '---...',
	'?' => '..--..',
	"'" => '.----.',
	'-' => '-....-',
	'@' => '.--.-.',
	'/' => '-..-.',		# "fraction bar"
	'{PAR}' => '-.--.-',	# "brackets (parentheses)"
	'"' => '.-..-.',

	' ' => '',   		# spacing: char component: 1 unit  -> nothing
				#          chars:          3 units -> space
				#          words:          7 units -> two spaces
				# space between chars forms in final @out expansion
				# spaces between words form by expanding the
				#   empty string, so that split()ing leads to
				#   only one space again while decoding

	'{ERR}' => '........'	# "error" / "delete last word"
  );
my %trans_from = reverse(%trans_to);

# mode of operation: user chooses by calling zzzmorse like that. (use symlinks)
my %modes = ('encode' => \&morse_encode, 'decode' => \&morse_decode);
my $mode = 'decode';
$mode = 'encode' if ($0 =~ /encode(\.pl)?$/);
$mode = 'decode' if ($0 =~ /decode(\.pl)?$/);
die("Invalid mode of operation '$mode'") unless (defined($modes{$mode}));


# any arguments given?
if (@ARGV) {
	# only process arguments
	print($modes{$mode}->(@ARGV) . "\n");
}
else {
	# go interactive
	print("zzzmorse: $mode mode -- finish with ^D (Ctrl-D) on a single line\n");
	while (my $morse = <STDIN>) {
		# remove trailing newline
		chomp($morse);

		# Users are dumb, so filter user's dumbness.
		# While decoding, we're either
		#  o parsing the output of a program which
		#    has already done this job for us or
		#  o parsing data from a user who knows morse code,
		#    so (hopefully) knows what he is doing...

		# ...so is this encode mode?
		if ($mode eq 'encode') {
			# there are some native language's letters missing here
			#   most probably, I know... *sigh*
			$morse =~ tr/_!;|\`´äÀáàÃãËëÈéèÏïÍÌíìöÓÒóòÕõüÚÙúùÿ\\/-..,''ÄAÁAAAEEEÉEIIIIIIÖOOOOOOÜUUUUY\//;
			$morse =~ s/ß/sz/;

			# convert to upper case
			$morse =~ s/([a-z])/uc($1)/eg;
		}

		# finally en/decode current line
		print($modes{$mode}->($morse) . "\n");
	}
}


# encode array of tokens to morse code
# if only one argument is given, it's split into its characters
sub morse_encode {
	my @in = $#_ ? @_ : split(//, $_[0]);
	my @out;

	foreach my $token (@in) {
		# handle  () {} []  correctly
		$token =~ s/^(\(|\)|\[|\]|\{|\})$/{PAR}/g;

		if (defined($trans_to{$token})) {
			push(@out, $trans_to{$token});
		}
		else {
			warn("Can't encode '$token'");
			push(@out, '{???}');
		}
	}

	# return @out in list context; else expand it with spaces
	# (e.g.,  @out = ('.', '-', '.-')  becomes  "@out" eq '. - .-'  )
	return wantarray ? @out : "@out";
}

# decode array of tokens from morse code
# if only one argument is given, it's split into its words(/split by spaces)
sub morse_decode {
	# $#_ -> max. index of @_ => at least two elements in @_ if $#_ is true
	my @in = $#_ ? @_ : split(/ /, $_[0]);
	my @out;

	foreach my $token (@in) {
		# if ($token eq '') {
		# 	# empty tokens are autoconverted to spaces while decoding
		# 	push(@out, ' ');
		# }
		# ^ ..this directly works through $trans_from now
		if (defined($trans_from{$token})) {
			push(@out, $trans_from{$token});
		}
		else {
			warn("Can't decode '$token'");
			push(@out, '{???}');
		}
	}

	# return @out in list context; else join the decoded characters together
	# (e.g.,  @out = ('a', 'b', 'c')  becomes  "abc"  )
	return wantarray ? @out : join('', @out);
}