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