diff options
Diffstat (limited to 'scripts/morse.pl')
-rw-r--r-- | scripts/morse.pl | 347 |
1 files changed, 347 insertions, 0 deletions
diff --git a/scripts/morse.pl b/scripts/morse.pl new file mode 100644 index 0000000..d60e01a --- /dev/null +++ b/scripts/morse.pl @@ -0,0 +1,347 @@ +use strict; + +use vars qw($VERSION %IRSSI); +$VERSION = "2004021901"; +%IRSSI = ( + authors => "Stefan 'tommie' Tomanek", + contact => "stefan\@pico.ruhr.de", + name => "morse", + description => "turns your messages into morse or spelling code", + license => "GPLv2", + changed => "$VERSION", + commands => "morse spell" +); + +use Irssi 20020324; + +use vars qw(%codes %spell); + +%codes = ( + 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=>"--..", + 0=>"-----", + 1=>".----", + 2=>"..---", + 3=>"...--", + 4=>"....-", + 5=>".....", + 6=>"-....", + 7=>"--...", + 8=>"---..", + 9=>"----.", + ' '=>" ", + '.'=>".-.-.-", + ','=>"--..--", + '?'=>"..--..", + ':'=>"---...", + ';'=>"-.-.-.", + '-'=>"-....-", + '_'=>"..--.-", + '"'=>".-..-.", + "'"=>".----.", + '/'=>"-..-.", + '('=>"-.--.", + ')'=>"-.--.-", + '='=>"-...-", + 'Ä'=>'.-.-', + 'Ö'=>'---.', + 'Ü'=>'..--', + '@'=>'.--.-.' +); +my %spell = ( + 'intern.' => { + 'A' => 'Amsterdam', + 'B' => 'Baltimore', + 'C' => 'Casablanca', + 'D' => 'Danemark', + 'E' => 'Edison', + 'F' => 'Florida', + 'G' => 'Gallipoli', + 'H' => 'Havana', + 'I' => 'Italia', + 'J' => 'Jérusalem', + 'K' => 'Kilogramme', + 'L' => 'Liverpool', + 'M' => 'Madagaskar', + 'N' => 'New York', + 'O' => 'Oslo', + 'P' => 'Paris', + 'Q' => 'Québec', + 'R' => 'Roma', + 'S' => 'Santiago', + 'T' => 'Tripoli', + 'U' => 'Upsala', + 'V' => 'Valencia', + 'W' => 'Washington', + 'X' => 'Xanthippe', + 'Y' => 'Yokohama', + 'Z' => 'Zürich' + }, + 'GB' => { + 'A' => 'Andrew', + 'B' => 'Benjamin', + 'C' => 'Charlie', + 'D' => 'David', + 'E' => 'Edward', + 'F' => 'Frederick', + 'G' => 'George', + 'H' => 'Harry', + 'I' => 'Isaac', + 'J' => 'Jack', + 'K' => 'King', + 'L' => 'Lucy', + 'M' => 'Mary', + 'N' => 'Nellie', + 'O' => 'Oliver', + 'P' => 'Peter', + 'Q' => 'Queenie', + 'R' => 'Robert', + 'S' => 'Sugar', + 'T' => 'Tommy', + 'U' => 'Uncle', + 'V' => 'Victor', + 'W' => 'William', + 'X' => 'Xmas', + 'Y' => 'Yellow', + 'Z' => 'Zebra' + }, + 'USA' => { + 'A' => 'Abel', + 'B' => 'Baker', + 'C' => 'Charlie', + 'D' => 'Dog', + 'E' => 'Easy', + 'F' => 'Fox', + 'G' => 'George', + 'H' => 'How', + 'I' => 'Item', + 'J' => 'Jig', + 'K' => 'King', + 'L' => 'Love', + 'M' => 'Mike', + 'N' => 'Nan', + 'O' => 'Oboe', + 'P' => 'Peter', + 'Q' => 'Queen', + 'R' => 'Roger', + 'S' => 'Sugar', + 'T' => 'Tare', + 'U' => 'Uncle', + 'V' => 'Victor', + 'W' => 'William', + 'X' => 'X', + 'Y' => 'Yoke', + 'Z' => 'Zebra' + }, + 'ICAO' => { + 'A' => 'Alfa', + 'B' => 'Bravo', + 'C' => 'Charlie', + 'D' => 'Delta', + 'E' => 'Echo', + 'F' => 'Foxtrot', + 'G' => 'Golf', + 'H' => 'Hotel', + 'I' => 'India', + 'J' => 'Juliett', + 'K' => 'Kilo', + 'L' => 'Lima', + 'M' => 'Mike', + 'N' => 'November', + 'O' => 'Oscar', + 'P' => 'Papa', + 'Q' => 'Quebec', + 'R' => 'Romeo', + 'S' => 'Sierra', + 'T' => 'Tango', + 'U' => 'Uniform', + 'V' => 'Victor', + 'W' => 'Whiskey', + 'X' => 'X-Ray', + 'Y' => 'Yankee', + 'Z' => 'Zulu' + }, + 'D' => { + 'A' => 'Anton', + 'B' => 'Berta', + 'C' => 'Cäsar', + 'D' => 'Dora', + 'E' => 'Emil', + 'F' => 'Friedrich', + 'G' => 'Gustav', + 'H' => 'Heinrich', + 'I' => 'Ida', + 'J' => 'Julius', + 'K' => 'Kaufmann', + 'L' => 'Ludwig', + 'M' => 'Martha', + 'N' => 'Nordpol', + 'O' => 'Otto', + 'P' => 'Paula', + 'Q' => 'Quelle', + 'R' => 'Richard', + 'S' => 'Samuel', + 'T' => 'Theodor', + 'U' => 'Ulrich', + 'V' => 'Viktor', + 'W' => 'Wilhelm', + 'X' => 'Xanthippe', + 'Y' => 'Ypsilon', + 'Z' => 'Zacharias' + } +); + +sub text2morse ($) { + my ($text) = @_; + my $result; + my %deumlaut = ('ä' => 'Ä', + 'ö' => 'Ö', + 'ü' => 'Ü', + 'ß' => 'ss' + ); + $text =~ s/$_/$deumlaut{$_}/ foreach keys %deumlaut; + foreach (split(//, $text)) { + if (defined $codes{uc $_}) { + $result .= $codes{uc $_}." "; + } elsif (Irssi::settings_get_bool('morse_kill_unknown_characters')) { + $result .= " "; + } else { + $result .= $_." "; + } + } + return $result; +} + +sub morse2text ($) { + my ($morse) = @_; + my (%table, $result); + $table{$codes{$_}} = $_ foreach keys %codes; + foreach (split(/ /, $morse)) { + if (defined $table{$_}) { + $result .= $table{$_}; + } else { + $result .= $_." "; + } + } + $result =~ s/ +/ /g; + return $result; +} + +sub morse_decode ($$$) { + my ($server, $target, $text) = @_; + return unless ($text =~ /(^|.*? )([\.\-]+ [\.\- ]+)($| .*)/g); + my $witem = $server->window_item_find($target); + + return unless ($witem); + $witem->print("%B[morse]>>%n ".$1."%U".morse2text($2)."%U ".$3, MSGLEVEL_CLIENTCRAP); +} + +sub spell_decode ($$$) { + my ($server, $target, $text) = @_; + my $codes; + foreach my $type (keys %spell) { + $codes .= $spell{$type}{$_}.'|' foreach keys %{ $spell{$type} }; + } + $codes =~ s/\|$//; + return unless ($text =~ /^($codes| |[\:\,\.\-\?\!\(\)])+$/); + return unless ($text =~ /($codes)/); + my $witem = $server->window_item_find($target); + return unless ($witem); + $witem->print("%B[spell]>>%n ".despell($text), MSGLEVEL_CLIENTCRAP); +} + +sub despell ($) { + my ($input) = @_; + my %data; + foreach my $type (keys %spell) { + $data{ $spell{$type}{$_} } = $_ foreach keys %{ $spell{$type} }; + } + my $output; + foreach (split / /, $input) { + if (defined $data{$_}) { + $output .= $data{$_}; + } else { + $output .= $_." "; + } + } + return $output; +} + +sub cmd_morse ($$$) { + my ($arg, $server, $witem) = @_; + if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) { + $witem->command('MSG '.$witem->{name}.' '.text2morse($arg)); + } else { + print CLIENTCRAP "%B>>%n ".text2morse($arg); + } +} + +sub cmd_spell ($$$) { + my ($args, $server, $witem) = @_; + my $type = Irssi::settings_get_str('morse_spelling_alphabet'); + return unless defined $spell{$type}; + my $encode; + foreach (split(//, $args)) { + if (defined $spell{$type}{uc $_}) { + $encode .= $spell{$type}{uc $_}." "; + } else { + $encode .= $_; + } + } + if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) { + $witem->command('MSG '.$witem->{name}.' '.$encode); + } else { + print CLIENTCRAP "%B>>%n ".$encode; + } + +} + +sub cmd_despell ($$$) { + my ($args, $server, $witem) = @_; + print CLIENTCRAP "%B>>%n ".despell($args); +} + +sub cmd_demorse ($$$) { + my ($arg, $server, $witem) = @_; + print CLIENTCRAP "%B>>%n ".morse2text($arg); +} + +Irssi::command_bind('morse', \&cmd_morse); +Irssi::command_bind('spell', \&cmd_spell); +Irssi::command_bind('despell', \&cmd_despell); +Irssi::command_bind('demorse', \&cmd_demorse); + +Irssi::settings_add_bool($IRSSI{name}, 'morse_kill_unknown_characters', 0); +Irssi::settings_add_str($IRSSI{name}, 'morse_spelling_alphabet', "ICAO"); + +Irssi::signal_add('message public', sub { morse_decode($_[0], $_[4], $_[1]); }); +Irssi::signal_add('message own_public', sub { morse_decode($_[0], $_[2], $_[1]); }); + +Irssi::signal_add('message public', sub { spell_decode($_[0], $_[4], $_[1]); }); +Irssi::signal_add('message own_public', sub { spell_decode($_[0], $_[2], $_[1]); }); +print "%B>>%n ".$IRSSI{name}." ".$VERSION." loaded"; + |