1use strict; 2 3use vars qw($VERSION %IRSSI); 4$VERSION = "2004021901"; 5%IRSSI = ( 6 authors => "Stefan 'tommie' Tomanek", 7 contact => "stefan\@pico.ruhr.de", 8 name => "morse", 9 description => "turns your messages into morse or spelling code", 10 license => "GPLv2", 11 changed => "$VERSION", 12 commands => "morse spell" 13); 14 15use Irssi 20020324; 16 17use vars qw(%codes %spell); 18 19%codes = ( 20 A=>".-", 21 B=>"-...", 22 C=>"-.-.", 23 D=>"-..", 24 E=>".", 25 F=>"..-.", 26 G=>"--.", 27 H=>"....", 28 I=>"..", 29 J=>".---", 30 K=>"-.-", 31 L=>".-..", 32 M=>"--", 33 N=>"-.", 34 O=>"---", 35 P=>".--.", 36 Q=>"--.-", 37 R=>".-.", 38 S=>"...", 39 T=>"-", 40 U=>"..-", 41 V=>"...-", 42 W=>".--", 43 X=>"-..-", 44 Y=>"-.--", 45 Z=>"--..", 46 0=>"-----", 47 1=>".----", 48 2=>"..---", 49 3=>"...--", 50 4=>"....-", 51 5=>".....", 52 6=>"-....", 53 7=>"--...", 54 8=>"---..", 55 9=>"----.", 56 ' '=>" ", 57 '.'=>".-.-.-", 58 ','=>"--..--", 59 '?'=>"..--..", 60 ':'=>"---...", 61 ';'=>"-.-.-.", 62 '-'=>"-....-", 63 '_'=>"..--.-", 64 '"'=>".-..-.", 65 "'"=>".----.", 66 '/'=>"-..-.", 67 '('=>"-.--.", 68 ')'=>"-.--.-", 69 '='=>"-...-", 70 '�'=>'.-.-', 71 '�'=>'---.', 72 '�'=>'..--', 73 '@'=>'.--.-.' 74); 75my %spell = ( 76 'intern.' => { 77 'A' => 'Amsterdam', 78 'B' => 'Baltimore', 79 'C' => 'Casablanca', 80 'D' => 'Danemark', 81 'E' => 'Edison', 82 'F' => 'Florida', 83 'G' => 'Gallipoli', 84 'H' => 'Havana', 85 'I' => 'Italia', 86 'J' => 'J�rusalem', 87 'K' => 'Kilogramme', 88 'L' => 'Liverpool', 89 'M' => 'Madagaskar', 90 'N' => 'New York', 91 'O' => 'Oslo', 92 'P' => 'Paris', 93 'Q' => 'Qu�bec', 94 'R' => 'Roma', 95 'S' => 'Santiago', 96 'T' => 'Tripoli', 97 'U' => 'Upsala', 98 'V' => 'Valencia', 99 'W' => 'Washington', 100 'X' => 'Xanthippe', 101 'Y' => 'Yokohama', 102 'Z' => 'Z�rich' 103 }, 104 'GB' => { 105 'A' => 'Andrew', 106 'B' => 'Benjamin', 107 'C' => 'Charlie', 108 'D' => 'David', 109 'E' => 'Edward', 110 'F' => 'Frederick', 111 'G' => 'George', 112 'H' => 'Harry', 113 'I' => 'Isaac', 114 'J' => 'Jack', 115 'K' => 'King', 116 'L' => 'Lucy', 117 'M' => 'Mary', 118 'N' => 'Nellie', 119 'O' => 'Oliver', 120 'P' => 'Peter', 121 'Q' => 'Queenie', 122 'R' => 'Robert', 123 'S' => 'Sugar', 124 'T' => 'Tommy', 125 'U' => 'Uncle', 126 'V' => 'Victor', 127 'W' => 'William', 128 'X' => 'Xmas', 129 'Y' => 'Yellow', 130 'Z' => 'Zebra' 131 }, 132 'USA' => { 133 'A' => 'Abel', 134 'B' => 'Baker', 135 'C' => 'Charlie', 136 'D' => 'Dog', 137 'E' => 'Easy', 138 'F' => 'Fox', 139 'G' => 'George', 140 'H' => 'How', 141 'I' => 'Item', 142 'J' => 'Jig', 143 'K' => 'King', 144 'L' => 'Love', 145 'M' => 'Mike', 146 'N' => 'Nan', 147 'O' => 'Oboe', 148 'P' => 'Peter', 149 'Q' => 'Queen', 150 'R' => 'Roger', 151 'S' => 'Sugar', 152 'T' => 'Tare', 153 'U' => 'Uncle', 154 'V' => 'Victor', 155 'W' => 'William', 156 'X' => 'X', 157 'Y' => 'Yoke', 158 'Z' => 'Zebra' 159 }, 160 'ICAO' => { 161 'A' => 'Alfa', 162 'B' => 'Bravo', 163 'C' => 'Charlie', 164 'D' => 'Delta', 165 'E' => 'Echo', 166 'F' => 'Foxtrot', 167 'G' => 'Golf', 168 'H' => 'Hotel', 169 'I' => 'India', 170 'J' => 'Juliett', 171 'K' => 'Kilo', 172 'L' => 'Lima', 173 'M' => 'Mike', 174 'N' => 'November', 175 'O' => 'Oscar', 176 'P' => 'Papa', 177 'Q' => 'Quebec', 178 'R' => 'Romeo', 179 'S' => 'Sierra', 180 'T' => 'Tango', 181 'U' => 'Uniform', 182 'V' => 'Victor', 183 'W' => 'Whiskey', 184 'X' => 'X-Ray', 185 'Y' => 'Yankee', 186 'Z' => 'Zulu' 187 }, 188 'D' => { 189 'A' => 'Anton', 190 'B' => 'Berta', 191 'C' => 'C�sar', 192 'D' => 'Dora', 193 'E' => 'Emil', 194 'F' => 'Friedrich', 195 'G' => 'Gustav', 196 'H' => 'Heinrich', 197 'I' => 'Ida', 198 'J' => 'Julius', 199 'K' => 'Kaufmann', 200 'L' => 'Ludwig', 201 'M' => 'Martha', 202 'N' => 'Nordpol', 203 'O' => 'Otto', 204 'P' => 'Paula', 205 'Q' => 'Quelle', 206 'R' => 'Richard', 207 'S' => 'Samuel', 208 'T' => 'Theodor', 209 'U' => 'Ulrich', 210 'V' => 'Viktor', 211 'W' => 'Wilhelm', 212 'X' => 'Xanthippe', 213 'Y' => 'Ypsilon', 214 'Z' => 'Zacharias' 215 } 216); 217 218sub text2morse ($) { 219 my ($text) = @_; 220 my $result; 221 my %deumlaut = ('�' => '�', 222 '�' => '�', 223 '�' => '�', 224 '�' => 'ss' 225 ); 226 $text =~ s/$_/$deumlaut{$_}/ foreach keys %deumlaut; 227 foreach (split(//, $text)) { 228 if (defined $codes{uc $_}) { 229 $result .= $codes{uc $_}." "; 230 } elsif (Irssi::settings_get_bool('morse_kill_unknown_characters')) { 231 $result .= " "; 232 } else { 233 $result .= $_." "; 234 } 235 } 236 return $result; 237} 238 239sub morse2text ($) { 240 my ($morse) = @_; 241 my (%table, $result); 242 $table{$codes{$_}} = $_ foreach keys %codes; 243 foreach (split(/ /, $morse)) { 244 if (defined $table{$_}) { 245 $result .= $table{$_}; 246 } else { 247 $result .= $_." "; 248 } 249 } 250 $result =~ s/ +/ /g; 251 return $result; 252} 253 254sub morse_decode ($$$) { 255 my ($server, $target, $text) = @_; 256 return unless ($text =~ /(^|.*? )([\.\-]+ [\.\- ]+)($| .*)/g); 257 my $witem = $server->window_item_find($target); 258 259 return unless ($witem); 260 $witem->print("%B[morse]>>%n ".$1."%U".morse2text($2)."%U ".$3, MSGLEVEL_CLIENTCRAP); 261} 262 263sub spell_decode ($$$) { 264 my ($server, $target, $text) = @_; 265 my $codes; 266 foreach my $type (keys %spell) { 267 $codes .= $spell{$type}{$_}.'|' foreach keys %{ $spell{$type} }; 268 } 269 $codes =~ s/\|$//; 270 return unless ($text =~ /^($codes| |[\:\,\.\-\?\!\(\)])+$/); 271 return unless ($text =~ /($codes)/); 272 my $witem = $server->window_item_find($target); 273 return unless ($witem); 274 $witem->print("%B[spell]>>%n ".despell($text), MSGLEVEL_CLIENTCRAP); 275} 276 277sub despell ($) { 278 my ($input) = @_; 279 my %data; 280 foreach my $type (keys %spell) { 281 $data{ $spell{$type}{$_} } = $_ foreach keys %{ $spell{$type} }; 282 } 283 my $output; 284 foreach (split / /, $input) { 285 if (defined $data{$_}) { 286 $output .= $data{$_}; 287 } else { 288 $output .= $_." "; 289 } 290 } 291 return $output; 292} 293 294sub cmd_morse ($$$) { 295 my ($arg, $server, $witem) = @_; 296 if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) { 297 $witem->command('MSG '.$witem->{name}.' '.text2morse($arg)); 298 } else { 299 print CLIENTCRAP "%B>>%n ".text2morse($arg); 300 } 301} 302 303sub cmd_spell ($$$) { 304 my ($args, $server, $witem) = @_; 305 my $type = Irssi::settings_get_str('morse_spelling_alphabet'); 306 return unless defined $spell{$type}; 307 my $encode; 308 foreach (split(//, $args)) { 309 if (defined $spell{$type}{uc $_}) { 310 $encode .= $spell{$type}{uc $_}." "; 311 } else { 312 $encode .= $_; 313 } 314 } 315 if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) { 316 $witem->command('MSG '.$witem->{name}.' '.$encode); 317 } else { 318 print CLIENTCRAP "%B>>%n ".$encode; 319 } 320 321} 322 323sub cmd_despell ($$$) { 324 my ($args, $server, $witem) = @_; 325 print CLIENTCRAP "%B>>%n ".despell($args); 326} 327 328sub cmd_demorse ($$$) { 329 my ($arg, $server, $witem) = @_; 330 print CLIENTCRAP "%B>>%n ".morse2text($arg); 331} 332 333Irssi::command_bind('morse', \&cmd_morse); 334Irssi::command_bind('spell', \&cmd_spell); 335Irssi::command_bind('despell', \&cmd_despell); 336Irssi::command_bind('demorse', \&cmd_demorse); 337 338Irssi::settings_add_bool($IRSSI{name}, 'morse_kill_unknown_characters', 0); 339Irssi::settings_add_str($IRSSI{name}, 'morse_spelling_alphabet', "ICAO"); 340 341Irssi::signal_add('message public', sub { morse_decode($_[0], $_[4], $_[1]); }); 342Irssi::signal_add('message own_public', sub { morse_decode($_[0], $_[2], $_[1]); }); 343 344Irssi::signal_add('message public', sub { spell_decode($_[0], $_[4], $_[1]); }); 345Irssi::signal_add('message own_public', sub { spell_decode($_[0], $_[2], $_[1]); }); 346print "%B>>%n ".$IRSSI{name}." ".$VERSION." loaded"; 347 348