#!/usr/bin/perl
# -----------------------------------------------------------------------------
# zzzmorse.pl (Irssi version) -- encode to / decode from morse code
# Copyright (C) 2003 Fabian "zzznowman" Pietsch <fabian@zzznowman.dyndns.org>
#
# Irssi interface usage taken from kenny.pl
# http://alfie.ist.org/projects/irssi/scripts/kenny.pl
# Copyright (C) 2002 Gerfried Fuchs <alfie@channel.debian.de>
#
# 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.2 (2003-11-18)
#
# 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 Irssi qw(command_bind command signal_add_last signal_stop settings_get_bool settings_add_bool);
use strict;
use vars qw($VERSION %IRSSI);

$VERSION = '0.1.2';

%IRSSI = (
	'authors'     => 'Fabian "zzznowman" Pietsch',
	'contact'     => 'fabian@zzznowman.dyndns.org',
	'name'        => 'zzzmorse',
	'description' => 'Autodecodes morse coded messages, adds /morse, /demorse. Based on zzzmorse (the standalone version).',
	'license'     => 'GPL',
	'url'         => 'http://zzz.deixu.net/software/raw/script/irssi/zzzmorse.pl',
	'changed'     => '2003-11-18'
);


# 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);


# 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'");
			Irssi::print("[zzzmorse] can't encode '$token'", MSGLEVEL_CRAP);
			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'");
			Irssi::print("[zzzmorse] can't decode '$token'", MSGLEVEL_CRAP);
			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);
}


#
# Irssi interface specific code
#

sub cmd_morse {
	my ($msg, undef, $channel) = @_;
	# 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...

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

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

	$channel->command("msg $channel->{'name'} " . &morse_encode($msg));
}

sub cmd_demorse {
	my ($msg, undef, $channel) = @_;

	if ($channel) {
		$channel->print('[zzzmorse] ' . &morse_decode($msg), MSGLEVEL_CRAP);
	}
	else {
		Irssi::print('[zzzmorse] ' . &morse_decode($msg), MSGLEVEL_CRAP);
	}
}

sub sig_morse {
	my ($server, $msg, $nick, $address, $target) = @_;
	if ($msg =~ /^([.-]+ )+[ .-]*$/) {
		$target = $nick if ($target eq '');

		# the address may _never_ be empty, if it is its own_public
		$nick = $server->{'nick'} if ($address eq '');

		$server->window_item_find($target)
		  ->print("[zzzmorse] <$nick> " . &morse_decode($msg), MSGLEVEL_CRAP);
		signal_stop if (settings_get_bool('zzzmorse_stopraw'));
	}
}


command_bind('morse',   'cmd_morse');
command_bind('demorse', 'cmd_demorse');

signal_add_last('message own_public',  'sig_morse');
signal_add_last('message public',      'sig_morse');
signal_add_last('message own_private', 'sig_morse');
signal_add_last('message private',     'sig_mores');

settings_add_bool('lookandfeel', 'zzzmorse_stopraw', 0);