1# unleash the gay!!!  shoutz to #insub
2# author: cj_ <rover@gruntle.org>
3# type /gay help for usage after loading
4#
5# "If used sparingly, and in good taste, ASCII art generally
6# is very well-received !"
7#                             -- Some Sucker
8
9use Irssi;
10use Text::Wrap;
11use strict;
12use vars qw($VERSION %IRSSI $SPLASH);
13
14$VERSION = "5.8";
15%IRSSI = (
16	author		=> 'cj_',
17	contact		=> 'rover@gruntle.org',
18	download	=> 'http://gruntle.org/projects/irssi/gay',
19	name		=> 'gay',
20	description	=> 'a lot of annoying ascii color/art text filters',
21	license		=> 'Public Domain',
22	changed		=> 'Tue Aug 26 11:21:15 PDT 2003',
23	version		=> $VERSION,
24);
25
26############################################################
27# this is for displaying in various places to bug the user #
28############################################################
29
30# usage/contact info
31$SPLASH = "$IRSSI{name} $IRSSI{version} by $IRSSI{author} <$IRSSI{contact}>";
32
33# quick help
34my $USAGE = <<EOU;
35/COMMAND [-123456] [-blink] [-msg <target>] [-pre <text>]
36         [-fig] [-font <font>] [-cow] [-cowfile <file>]
37         [-matrix] [-box|-3d|-arrow] [-check|capchk]
38         [-spook] [-rev] [-mirror] [-leet] [-hug] [-flip]
39	 [-YES] <text>
40EOU
41
42# for /gay col, list colormap
43my $COLMAP = <<COLMAP;
440,1\26\26 0 = white
451,0\26\26 1 = black
462,1\26\26 2 = blue
473,1\26\26 3 = green
484,1\26\26 4 = orange
495,1\26\26 5 = red (yellow in epic/bx)
506,1\26\26 6 = magenta
517,1\26\26 7 = yellow (red in epic/bx)
528,1\26\26 8 = bright yellow
539,1\26\26 9 = bright green
5410,1\26\26 10 = cyan
5511,1\26\26 11 = gray
5612,1\26\26 12 = bright blue
5713,1\26\26 13 = bright purple
5814,1\26\26 14 = dark gray
5915,1\26\26 15 = light gray
60COLMAP
61
62# spook array.. in a perfect world this would
63# be in its own file.  this is stolen right out of emacs.  gg
64
65my @spook_lines = (
66	"\$400 million in gold bullion",
67	"[Hello to all my fans in domestic surveillance]", "AK-47",
68	"ammunition", "arrangements", "assassination", "BATF", "bomb", "CIA",
69	"class struggle", "Clinton", "Cocaine", "colonel",
70	"counter-intelligence", "cracking", "Croatian", "cryptographic",
71	"Delta Force", "DES", "domestic disruption", "explosion", "FBI", "FSF",
72	"fissionable", "Ft. Bragg", "Ft. Meade", "genetic", "Honduras",
73	"jihad", "Kennedy", "KGB", "Khaddafi", "kibo", "Legion of Doom",
74	"Marxist", "Mossad", "munitions", "Nazi", "Noriega", "North Korea",
75	"NORAD", "NSA", "nuclear", "Ortega", "Panama", "Peking", "PLO",
76	"plutonium", "Qaddafi", "quiche", "radar", "Rule Psix",
77	"Saddam Hussein", "SDI", "SEAL Team 6", "security", "Semtex",
78	"Serbian", "smuggle", "South Africa", "Soviet ", "spy", "strategic",
79	"supercomputer", "terrorist", "Treasury", "Uzi", "Waco, Texas",
80	"World Trade Center",
81
82	# mine
83	"Eggs", "Libya", "Bush", "Kill the president", "GOP", "Republican",
84	"Shiite", "Muslim", "Chemical Ali", "Ashcroft", "Terrorism",
85	"Al Qaeda", "Al Jazeera", "Hamas", "Israel", "Palestine", "Arabs",
86);
87
88# leet mapping
89my $leet_map = {
90	a => [ "4", "/\\", "@", "a", "A" ],
91	b => [ "|o", "b", "B" ],
92	c => [ "C", "c", "<" ],
93	d => [ "d", "D", "|)" ],
94	e => [ "e", "E", "3" ],
95	f => [ "f", "F", "/=" ],
96	g => [ "g", "G", "6" ],
97	h => [ "h", "H", "|-|" ],
98	i => [ "i", "I", "|", "1" ],
99	j => [ "j", "J" ],
100	k => [ "keke", "x", "X", "k", "K", "|<" ],
101	l => [ "l", "L", "7", "|_" ],
102	m => [ "|V|", "|\\/|", "m", "M" ],
103	n => [ "n", "N", "|\\|" ],
104	o => [ "0", "o", "O", "()", "[]", "<>" ],
105	p => [ "p", "P", "9" ],
106	q => [ "q", "Q" ],
107	r => [ "r", "R" ],
108	s => [ "s", "S", "5" ],
109	t => [ "t", "T", "7" ],
110	u => [ "|_|", "u", "U", "\\/" ],
111	v => [ "v", "V", "\\/" ],
112	w => [ "w", "W", "uu", "UU", "uU", "Uu", "\\/\\/" ],
113	x => [ "x", "X", "><" ],
114	y => [ "y", "Y" ],
115	z => [ "z", "Z", "5" ],
116};
117
118# random text for text substitution
119# needless to say if someone has this string
120# in their text, it'll get clobbered.
121my $rnd = "rAnDoM";
122
123
124# handler to reap dead children
125# need this to avoid zombie/defunt processes
126# waiting around to have their exit status read
127my $child_pid;
128sub sigchild_handler {
129	waitpid($child_pid, 0);
130}
131
132# declar this a global to prevent gay.pl
133# from constantly checking
134my $cowpath;
135
136# markup stuff
137my $COWCUT = "---COWCUT---";
138
139###############################
140# these are the main commands #
141###############################
142
143sub gay {
144	my $text = shift;
145	if    ($text =~ /^help/i   )     { show_help()               }
146	elsif ($text =~ /^vers/i   )     { Irssi::print($SPLASH)     }
147	elsif ($text =~ /^update/i )     { update()                  }
148	elsif ($text =~ /^usage/i  )     { show_error($USAGE)        }
149	elsif ($text =~ /^col/i    )     { show_error($COLMAP)       }
150	else                             { process(undef, $text, @_) }
151}
152
153# these are aliases that use a predefined set of filters
154sub colcow    { process("cr",  @_) }	# cowsay -> rainbow
155sub gayexec   { process("e",   @_) }    # execute
156sub gaycat    { process("x",   @_) }	# gaycat w/ byte restriction
157sub gv        { process("v",   @_) }	# display version info
158
159###############################
160# this handles the processing #
161###############################
162
163sub process {
164	my ($flags, $text, $server, $dest) = @_;
165
166	if (!$server || !$server->{connected}) {
167		Irssi::print("Not connected to server");
168		return;
169	}
170
171	return unless $dest;
172
173	# set up defaults
174	my @text;
175	my $prefix;
176	my $style = Irssi::settings_get_int("gay_default_style");
177	my $cowfile = Irssi::settings_get_str("cowfile");
178	my $figfont = Irssi::settings_get_str("figfont");
179	my $sendto = $dest->{name};
180
181	# parse args
182	my @args;
183	my $error_returned = 0;
184	if ($text) {
185		(@args, $error_returned) = shellwords($text);
186		return if $error_returned;
187	}
188
189	my $force = 0;
190	while (my $arg = shift(@args)) {
191		if ($arg =~ /^-msg/)      { $sendto = shift(@args); next }
192		if ($arg =~ /^-pre/)      { $prefix = shift(@args); next }
193		if ($arg =~ /^-blink/)    { $flags .= "b"; next }
194		if ($arg =~ /^-jive/)     { $flags .= "j"; next }
195		if ($arg =~ /^-cowfile/)  { $cowfile = shift(@args); next }
196		if ($arg =~ /^-cow/)      { $flags .= "c"; next }
197		if ($arg =~ /^-fig/)      { $flags .= "f"; next }
198		if ($arg =~ /^-font/)     { $figfont = shift(@args); next }
199		if ($arg =~ /^-box/)      { $flags .= "o"; next }
200		if ($arg =~ /^-3d/)       { $flags .= "3"; next }
201		if ($arg =~ /^-arrow/)    { $flags .= "a"; next }
202		if ($arg =~ /^-check/)    { $flags .= "C"; next }
203		if ($arg =~ /^-capchk/)   { $flags .= "h"; next }
204		if ($arg =~ /^-matrix/)   { $flags .= "m"; next }
205		if ($arg =~ /^-spook/)    { $flags .= "s"; next }
206		if ($arg =~ /^-mirror/)   { $flags .= "M"; next }
207		if ($arg =~ /^-rev/)      { $flags .= "R"; next }
208		if ($arg =~ /^-leet/)     { $flags .= "l"; next }
209		if ($arg =~ /^-hug/)      { $flags .= "H"; next }
210		if ($arg =~ /^-flip/)     { $flags .= "F"; next }
211		if ($arg =~ /^-YES/)      { $force = 1; next    }
212		if ($arg =~ /^-(\d)$/)    { $flags .= "r"; $style = $1; next }
213
214		# doesn't match arguments, must be text!
215		push(@text, $arg);
216	}
217	$text = join(" ", @text);
218	$text =~ s/\\n/\n/sg;
219
220	########################################
221	# sanity check before applying filters #
222	########################################
223
224	# this stuff tries to protect you from yourself
225	# .. using -YES will skip this
226	unless ($force) {
227		if ($flags =~ /h/ and $flags =~ /M/) {
228			Irssi::print("Combining -capchk and -mirror is bad, mkay (try -YES)");
229			return;
230		}
231
232		if ($flags =~ /s/ and $flags =~ /f/) {
233			Irssi::print("Spook and figlet is probably a bad idea (see: -YES)");
234			return;
235		}
236
237		if ((length($text) > 10) and $flags =~ /f/) {
238			Irssi::print("That's a lot of figlet.. use -YES if you are sure");
239			return;
240		}
241	}
242
243	# for outlining, precedence must be set
244	# 3dbox > arrow > box
245	$flags =~ s/(o|a)//g if $flags =~ /3/;
246	$flags =~ s/o//g     if $flags =~ /a/;
247
248	# check should override rainbow for now
249	$flags =~ s/r//g if $flags =~ /C/;
250
251	# ... so should capchk, unless it's a cow, in which case
252	# we invoke cowcut-fu
253	my $cowcut = 0;
254	if ($flags =~ /h/) {
255		# yes, capchk was specified
256		if ($flags =~ /c/ and $flags =~ /r/) {
257			$cowcut = 1;
258		} else {
259			$flags =~ s/r//g;
260		}
261	}
262
263	# capchk takes precedence over check
264	$flags =~ s/C//g if $flags =~ /h/;
265
266
267	##############################
268	# filter text based on flags #
269	##############################
270
271	# where to get text
272	$text = "$IRSSI{name} $IRSSI{version} - $IRSSI{download}" if $flags =~ /v/;
273	$text = execute($text)           if $flags =~ /e/;
274	$text = slurp($text)             if $flags =~ /x/;
275	$text = spookify($text)          if $flags =~ /s/;
276
277	# change the text contents itself
278	$text = jive($text)              if $flags =~ /j/;
279	$text = leet($text)              if $flags =~ /l/;
280	$text = reverse_ascii($text)     if $flags =~ /R/;
281	$text = matrix($text)            if $flags =~ /m/;
282
283	# change the text appearance
284	$text = figlet($text, $figfont)  if $flags =~ /f/;
285	$text = hug($text)               if $flags =~ /H/;
286	$text = wrap($text)              if $flags !~ /f/;
287
288	# change the text presentation
289	$text = checker($text)                    if $flags =~ /h/;
290	$text = reverse_ascii($text)              if $flags =~ /M/;
291	$text = cowsay($text, $cowfile, $cowcut)  if $flags =~ /c/;
292	$text = reverse_ascii($text)              if $flags =~ /M/ and $flags =~ /c/;
293	$text = upside_down($text)                if $flags =~ /F/;
294	$text = checker($text)                    if $flags =~ /C/;
295
296	# draw a box, pass a style flag
297	$text = outline($text, 0)                 if $flags =~ /o/;
298	$text = outline($text, 1)                 if $flags =~ /3/;
299	$text = outline($text, 2)                 if $flags =~ /a/;
300
301	# change the final products visual appearance
302	$text = rainbow($text, $style)   if $flags =~ /r/;
303	$text = blink($text)             if $flags =~ /b/;
304
305	########################
306	# output final product #
307	########################
308
309	foreach my $line (split(/\n/, $text)) {
310		$line = "$prefix $line" if ($prefix);
311		$server->command("msg $sendto $line");
312	}
313}
314
315######################################################
316# these filters pass text through various gayalizers #
317######################################################
318
319sub find_cowpath {
320	# see if we can find the program
321	my $cowsay_cmd = Irssi::settings_get_str('cowsay_cmd');
322	$cowsay_cmd = -x $cowsay_cmd ? $cowsay_cmd : whereis("cowsay");
323	unless (-x $cowsay_cmd) {
324		Irssi::print("$cowsay_cmd not found or not executable!");
325		return;
326	}
327
328	unless (open(COWSAY, "<$cowsay_cmd")) {
329		Irssi::print("problem reading $cowsay_cmd");
330		return;
331	}
332
333	my $find_cowpath;
334	while (my $line = <COWSAY>) {
335		if ($line =~ m!^\$cowpath = \$ENV\{'COWPATH'\} \|\| '(.*?)';!) {
336			$find_cowpath = $1;
337			last;
338		}
339	}
340
341	close COWSAY;
342
343	if (!$find_cowpath) { Irssi::print("I was unable to find the cowpath!") }
344	return $find_cowpath;
345}
346
347sub cowsay {
348	# my cowsay implementation.. because normal cowsay
349	# messes up bubble-size if you have imbedded
350	# color codes.. this works pretty much the same,
351	# except it doesn't have support for stuff like
352	# tongue and eyes.
353
354	my $text = shift;
355	my $cowfile = shift || "default";
356	my $cowcut = shift;
357
358	# my mother tried to find my cowpath once.. once.
359	if (!$cowpath) { $cowpath = $ENV{COWPATH} || find_cowpath() }
360
361	my @output;
362
363	# this is the whole point of doing my own cowsay
364	my $length = 0;
365	my @text = split(/\n/, $text);
366	foreach my $line (@text) {
367		my $l = clean_length($line);
368		$length = $l if $l > $length;
369	}
370
371	# add filler to the end
372	foreach my $line (@text) {
373		$line .= (" " x ($length - clean_length($line)));
374	}
375
376	my $div = " " . ("-" x ($length+2));
377	push(@output, $div);
378	push(@output, $COWCUT) if $cowcut;
379	my $count = 0;
380	my $total = scalar(@text) - 1;
381	foreach my $line (@text) {
382		if ($total == 0) {
383			push(@output, "< $line >");
384		} elsif ($count == 0) {
385			push(@output, "/ $line \\");
386		} elsif ($count == $total) {
387			push(@output, "\\ $line /");
388		} else {
389			push(@output, "| $line |");
390		}
391		$count++;
392	}
393
394	# this is rainbow() markup for toggling colorize
395	push(@output, $COWCUT) if $cowcut;
396	push(@output, $div);
397
398
399	my $full;
400	$cowfile .= ".cow" unless ($cowfile =~ /\.cow$/);
401	if ($cowfile =~ m!/!) {
402		$full = $cowfile;
403	} else {
404		foreach my $path (split(/:/, $cowpath)) {
405			if (-f "$path/$cowfile") {
406				$full = "$path/$cowfile";
407				last;
408			}
409		}
410	}
411
412	unless (-f $full) {
413		Irssi::print("could not find cowfile: $cowfile");
414		return;
415	}
416
417	my $the_cow = "";
418	my $thoughts = '\\';
419	my $eyes = "oo";
420	my $tongue = "  ";
421
422
423	unless (open(IN, "<$full")) {
424		Irssi::print("couldn't read $full: $!");
425		return;
426	}
427	my $cow_code = join('', <IN>);
428	close IN;
429
430	eval $cow_code;
431
432	push(@output, split(/\n/, $the_cow));
433	return join("\n", @output);
434}
435
436sub figlet {
437	# pass text through figlet
438	my $text = shift;
439	my $figlet_font = shift || 'standard';
440	my $figlet_wrap = Irssi::settings_get_int('linewrap');
441
442	# see if we can find the program
443	my $figlet_cmd = Irssi::settings_get_str('figlet_cmd');
444	$figlet_cmd = -x $figlet_cmd ? $figlet_cmd : whereis("figlet");
445	unless (-x $figlet_cmd) {
446		Irssi::print("$figlet_cmd not found or not executable!");
447		return;
448	}
449
450	open3(*READ, *WRITE, *ERR, "$figlet_cmd -f $figlet_font -w $figlet_wrap");
451	print WRITE $text;
452	close WRITE;
453
454	$text = join('', <READ>);
455	close READ;
456
457	# check for errors
458	show_error(join('', <ERR>));
459	close ERR;
460
461	$text =~ s/^\s+\n//g;     # sometime sit leaves leading blanks too!
462	$text =~ s/\n\s+\n$//s;   # figlet leaves a trailing blank line.. sometimes
463
464	return $text;
465}
466
467sub jive {
468	# pass text through jive filter
469	my $text = shift;
470
471	# see if we can find the program
472	my $jive_cmd = Irssi::settings_get_str('jive_cmd');
473	$jive_cmd = -x $jive_cmd ? $jive_cmd : whereis("jive");
474	unless (-x $jive_cmd) {
475		Irssi::print("$jive_cmd not found or not executable!");
476		return;
477	}
478
479	open3(*READ, *WRITE, *ERR, "$jive_cmd");
480	print WRITE $text;
481	close WRITE;
482
483	$text = join('', <READ>);
484	close READ;
485
486	# check for errors
487	show_error(join('', <ERR>));
488	close ERR;
489
490	return $text;
491}
492
493sub checker {
494	# checker filter.  thanks to uke, my gay competition
495	my $text = shift;
496	my $checksize = Irssi::settings_get_int('check_size');
497	my $checktext  = Irssi::settings_get_int('check_text');
498
499	my @colors = split(/\s*,\s*/, Irssi::settings_get_str("check_colors"));
500
501	my $rownum = 0;
502	my $offset = 0;
503	my @text = split(/\n/, $text);
504
505	# what is the longest line?
506	my $length = 0;
507	foreach my $line (@text) {
508		$length = length($line) if length($line) > $length;
509	}
510
511	foreach my $line (@text) {
512		# pad line with whitespace
513		$line .= (" " x ($length - length($line)));
514
515		my $newline;
516		my $state = 0;
517		for (my $i = 0; $i < length($line); $i = $i + $checksize) {
518			my $chunk = substr($line, $i, $checksize);
519			my $index = ($state + $offset); $index -= scalar(@colors) if $index >= scalar(@colors);
520
521			# figure out color code
522			my $code = "\x03" . $checktext . "," . $colors[$index] . "\26\26";
523
524			$newline .= "$code$chunk";
525			$state++; $state = 0 if $state >= scalar(@colors);
526		}
527		# make sure it is reset to default so colors don't "leak"
528		# into the outline() routine
529		$line = $newline . "";
530
531		# increment rowcount/swap offset
532		$rownum++;
533		if ($rownum == $checksize) {
534			$rownum = 0;
535			$offset++; $offset = 0 if $offset >= scalar(@colors);
536		}
537	}
538	return join("\n", @text);
539}
540
541sub rainbow {
542	# make colorful text
543	my ($text, $style) = @_;
544
545	# calculate stateful color offset
546	my $state_offset = 0;
547	if (Irssi::settings_get_bool("rainbow_keepstate")) {
548		$state_offset = Irssi::settings_get_int("rainbow_offset");
549		if ($state_offset < 0 or $state_offset > 20) {
550			$state_offset = 0;
551		} else {
552			$state_offset++;
553		}
554
555		Irssi::settings_set_int("rainbow_offset", $state_offset);
556	}
557
558	# generate colormap based on style
559	my @colormap;
560	if ($style == 1) {
561		# rainbow
562		@colormap = (4,4,7,7,5,5,8,8,9,9,3,3,10,10,11,11,12,12,2,2,6,6,13,13);
563	} elsif ($style == 2) {
564		# patriotic
565		@colormap = (4,4,0,0,12,12,4,4,0,0,12,12,4,4,0,0,12,12,4,4,0,0,12,12);
566	} elsif ($style == 3) {
567		# random colors
568		while (scalar(@colormap) < 24) {
569			my $color = int(rand(0) * 15) + 1;
570			$color = 0 if $color == 1;
571			push(@colormap, $color);
572		}
573	} elsif ($style == 4) {
574		# alternating colors shade, color is random
575		my $rand = int(rand(0) * 6) + 1;
576		if ($rand == 1) {
577			# blue
578			@colormap = (2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12);
579		} elsif ($rand == 2) {
580			# green
581			@colormap = (3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9);
582		} elsif ($rand == 3) {
583			# purple
584			@colormap = (6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13);
585		} elsif ($rand == 4) {
586			# gray
587			@colormap = (14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15);
588		} elsif ($rand == 5) {
589			# yellow
590			@colormap = (7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8);
591		} elsif ($rand == 6) {
592			# red
593			@colormap = (4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5);
594		}
595	} elsif ($style == 5) {
596		# alternating shades of grey.  i liked this one so much i gave
597		# it its own style.  does NOT like to blink, though
598		@colormap = (14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15);
599	} elsif ($style == 6) {
600		# greyscale
601		@colormap = (0,0,15,15,11,11,14,14,11,11,15,15,0,0,15,15,11,11,14,14,11,11,15,15);
602	} else {
603		# invalid style setting
604		Irssi::print("invalid style setting: $style");
605		return;
606	}
607
608	# this gets toggle if cowcut markup is seen
609	my $colorize = 1;
610
611	# colorize.. thanks 2 sisko
612	my $newtext;
613	my $row = 0;
614	foreach my $line (split(/\n/, $text)) {
615		if ($line =~ /$COWCUT/) {
616			# toggle state when we see this
617			$colorize++;
618			$colorize = 0 if $colorize == 2;
619			next;
620		}
621
622		if ($colorize == 0) {
623			$newtext .= "$line\n";
624			next;
625		}
626
627		for (my $i = 0; $i < length($line); $i++) {
628			my $chr = substr($line, $i, 1);
629			my $color = $i + $row + $state_offset;
630			$color = $color ?  $colormap[$color %($#colormap-1)] : $colormap[0];
631			$newtext .= "\003$color" unless ($chr =~ /\s/);
632			my $ord = ord($chr);
633			if (($ord >= 48 and $ord <= 57) or $ord == 44) {
634				$newtext .= "\26\26";
635			}
636			$newtext .= $chr;
637		}
638		$newtext .= "\n";
639		$row++;
640	}
641
642	return $newtext;
643}
644
645sub blink {
646	# make the text blink
647	my $text = shift;
648	my @newtext;
649	foreach my $line (split(/\n/, $text)) {
650		push(@newtext, "$line");
651	}
652	return join("\n", @newtext);
653}
654
655sub clean_length {
656	my $text = shift;
657	$text =~ s/\x03\d+(,\d+)?(\26\26)?//g;
658	$text =~ s/\[0m//g;
659	return length($text);
660}
661
662sub matrix {
663	# 0-day greetz to EnCapSulaTE1!11!one
664	my $text = shift;
665	my $size = Irssi::settings_get_int("matrix_size");
666	my $spacing = Irssi::settings_get_int("matrix_spacing");
667
668	$size = 1 if ($size < 1);
669
670	# first, let's dispense with the newlinesa
671	# because they have no meaning up/down
672	$text =~ s/\n/ /sg;
673
674	my @text;
675	for (my $i = 0; $i < length($text); $i += $size) {
676		my $chunk = substr($text, $i, $size);
677		for (my $j = 0; $j < length($chunk); $j++) {
678			$text[$j] .= substr($chunk, $j, 1) . (" " x $spacing);
679		}
680	}
681	return join("\n", @text);
682}
683
684sub outline {
685	# draw a box around text.. thanks 2 twid
686	# for the idea
687	my ($text, $style) = @_;
688	my ($_3d, $_arrow);
689
690	if ($style == 1) {
691		$_3d = 1;
692	} elsif ($style == 2) {
693		# arrow-style, thanks to rob
694		$_arrow = 1;
695	}
696
697	my @text = split(/\n/, $text);
698
699	# what is the longest line
700	my $length = 0;
701
702	foreach my $line (@text) {
703		$length = clean_length($line) if clean_length($line) > $length;
704	}
705
706	# add box around each line
707	my $lc = "|"; my $rc = "|";
708	if ($_arrow) { $lc = ">"; $rc = "<" }
709	foreach my $line (@text) {
710		$line = "$lc $line" . (" " x ($length - clean_length($line) + 1)) . "$rc";
711		$line .= " |" if ($_3d);
712	}
713
714	# top/bottom frame
715	my ($top_frame, $bottom_frame);
716	if ($_arrow) {
717		$top_frame = "\\" . ("^" x ($length + 2)) . "/";
718		$bottom_frame = "/" . ("^" x ($length + 2)) . "\\";
719	} else {
720		$top_frame = "+" . ("-" x ($length + 2)) . "+";
721		$bottom_frame = $top_frame;
722	}
723
724
725	if ($_3d) {
726		push(@text, $bottom_frame . "/");
727		unshift(@text, $top_frame . " |");
728	} else {
729		push(@text, $bottom_frame);
730		unshift(@text, $top_frame);
731	}
732
733	if ($_3d) {
734		unshift(@text, " /" . (" " x ($length + 2)) . "/|");
735		unshift(@text, "  " . ("_" x ($length + 3)));
736	}
737
738
739	return join("\n", @text);
740}
741
742sub whereis {
743	# evaluate $PATH, since this doesn't seem to be inherited
744	# in sh subproccess in irssi.. odd
745	my $cmd = shift;
746	foreach my $path (split(/:/, $ENV{PATH})) {
747		my $test = "$path/$cmd";
748		if (-x $test) {
749			return $test;
750		}
751	}
752}
753
754sub slurp {
755	# read in a file with max setting (useful for catting /dev/urandom :D )
756	# maybe make this read in chunks, not by line, or something.. seems clumsy
757	my $file = shift;
758
759	# expand ~
760	$file =~ s!^~([^/]*)!$1 ? (getpwnam($1))[7] : ($ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7])!ex;
761
762	unless (open(IN, "<$file")) {
763		Irssi::print("could not open $file: $!");
764		return;
765	}
766
767	my $max = Irssi::settings_get_int("colcat_max");
768	my $text;
769	while (my $line = <IN>) {
770		$text .= $line;
771		last if length($text) >= $max;
772	}
773	close IN;
774
775	return $text;
776}
777
778sub execute {
779	# execute command and return output
780	my $text = shift;
781
782	open3(*READ, *WRITE, *ERR, $text);
783	close WRITE;
784
785	$text = join('', <READ>);
786	close READ;
787
788	# check for errors
789	show_error(join('', <ERR>));
790	close ERR;
791
792	return $text;
793}
794
795
796
797sub show_help {
798	my $help = <<EOH;
799$USAGE
800
801STYLES:
802-1     rainbow
803-2     red white and blue
804-3     random colors
805-4     random alternating colors
806-5     alternating gray
807-6     greyscale
808
809COMMANDS:
810/gay                 just like /say, but gay
811/gay help            this help screen
812/gay version         show version information
813/gay usage           just show usage line
814/gay update          check for new release & update
815/gayexec             like /exec, but gayer
816/gaycat              pipe a file
817/gv                  tell the world you're gay
818
819SETTINGS:
820
821cowfile <cowsay file>
822figfont <figlet file>
823linewrap <# to wrap at>
824cowsay_cmd <path to cowsay program>
825figlet_cmd <path to figlet program>
826jive_cmd <path to jive program>
827colcat_max #
828gay_default_style #
829rainbow_keepstate <ON|OFF>
830check_size #
831check_colors #,#,...
832check_text #
833matrix_size, #
834matrix_spacing #
835spook_words #
836hug_size #
837EOH
838	Irssi::print(draw_box($SPLASH, $help, undef, 1), MSGLEVEL_CLIENTCRAP);
839}
840
841sub draw_box {
842	# taken from a busted script distributed with irssi
843	# just a simple ascii line-art around help text
844	my ($title, $text, $footer, $color) = @_;
845	$footer = $title unless($footer);
846	my $box;
847	$box .= '%R,--[%n%9%U' . $title . '%U%9%R]%n' . "\n";
848	foreach my $line (split(/\n/, $text)) {
849		$box .= '%R|%n ' . $line . "\n";
850	}
851	$box .= '%R`--<%n' . $footer . '%R>->%n';
852	$box =~ s/%.//g unless $color;
853	return $box;
854}
855
856sub show_error {
857	# take text gathered from STDERR and pass it here
858	# to display to the client
859	my $text = shift;
860	foreach my $line (split(/\n/, $text)) {
861		Irssi::print($line);
862	}
863}
864
865sub open3 {
866	my ($read, $write, $err, $command) = @_;
867
868	pipe($read, RTMP);
869	pipe($err, ETMP);
870	pipe(WTMP, $write);
871
872	select($read); $| = 1;
873	select($err); $| = 1;
874	select($write); $| = 1;
875	select(STDOUT);
876
877	return 0 unless defined $command;
878
879	# fork
880	my $pid = fork();
881	if ($pid) {
882		# parent
883		$child_pid = $pid;
884		$SIG{CHLD} = \&sigchild_handler;
885		close RTMP; close WTMP; close ETMP;
886		return $pid;
887	} else {
888		# child
889		close $write; close $read; close $err;
890		open(STDIN,  "<&WTMP"); close WTMP;
891		open(STDOUT, ">&RTMP"); close RTMP;
892		open(STDERR, ">&ETMP"); close ETMP;
893		exec($command);
894		exit 0;
895	}
896}
897
898sub update {
899	# automatically check for updates
900	my $baseURL = $IRSSI{download};
901
902	# do we have useragent?
903	eval "use LWP::UserAgent";
904	if ($@) {
905		Irssi::print("LWP::UserAgent failed to load: $!");
906		return;
907	}
908
909	# first see what the latest version is
910	my $ua = LWP::UserAgent->new();
911	my $req = HTTP::Request->new(
912		GET	=> "$baseURL/CURRENT",
913	);
914	my $res = $ua->request($req);
915	if (!$res->is_success()) {
916		Irssi::print("Problem contacting the mothership");
917		return;
918	}
919
920	my $latest_version = $res->content(); chomp $latest_version;
921	Irssi::print("Your version is: $VERSION");
922	Irssi::print("Current version is: $latest_version");
923
924	if ($VERSION >= $latest_version) {
925		Irssi::print("You are up to date");
926		return;
927	}
928
929	# uh oh, old stuff!  time to update
930	Irssi::print("You are out of date, fetching latest");
931	$req = HTTP::Request->new(
932		GET	=> "$baseURL/gay-$latest_version.pl",
933	);
934	$res = $ua->request($req);
935	if (!$res->is_success()) {
936		Irssi::print("Problem contacting the mothership");
937		return;
938	}
939
940	my $src = $res->content();
941
942	# check for integrity
943	if ($src !~ /(\$VERSION = "$latest_version";)/s) {
944		Irssi::print("Version mismatch, aborting");
945		return;
946	}
947
948	# where should we save this?
949	my $script_dir = "$ENV{HOME}/.irssi/scripts";
950	if (! -d $script_dir) {
951		Irssi::print("Could not determine script dir");
952		return;
953	}
954
955	# save the shit already
956	unless (open(OUT, ">$script_dir/downloaded-gay.pl")) {
957		Irssi::print("Couldn't write to $script_dir/gay.pl: $!");
958		return;
959	}
960
961	print OUT $src;
962	close OUT;
963
964	# copy to location
965	rename("$script_dir/gay.pl", "$script_dir/gay-$VERSION.pl");
966	rename("$script_dir/downloaded-gay.pl", "$script_dir/gay.pl");
967
968	Irssi::print("Updated successfully! '/run gay' to load");
969}
970
971sub spookify {
972	# add emacs spook text.  if there is previously existing text, it appends
973	my $text = shift;
974	my $count = Irssi::settings_get_int('spook_words') || return $text;
975	my @spook_words;
976	for (my $i = 0; $i < $count; $i++) {
977		my $word = $spook_lines[int(rand(0) * scalar(@spook_lines))];
978		push(@spook_words, $word);
979	}
980	my $text = join(" ", @spook_words) . " $text";
981	return $text;
982}
983
984sub wrap {
985	# fix that shit
986	my $text = shift;
987	my $wrap = Irssi::settings_get_int("linewrap") || return $text;
988	$Text::Wrap::columns = $wrap;
989	my @output;
990	foreach my $line (split(/\n/, $text)) {
991		if (length($line) > $wrap) {
992			($line) = Text::Wrap::wrap(undef, undef, $line);
993		}
994		$line =~ s/\t/     /g;
995		push(@output, $line);
996	}
997
998	$text = join("\n", @output);
999	return $text;
1000}
1001
1002sub leet {
1003	# leet speak :(
1004	my $text = shift;
1005	my @output;
1006	foreach my $line (split(/\n/, $text)) {
1007		my $newline;
1008		for (my $i = 0; $i < length($line); $i++) {
1009			my $char = lc(substr($line, $i, 1));
1010			if ($leet_map->{$char}) {
1011				my @possibles = @{$leet_map->{$char}};
1012				$char = $possibles[int(rand(0) * scalar(@possibles))];
1013			}
1014			$newline .= $char;
1015		}
1016		push(@output, $newline);
1017	}
1018	return join("\n", @output);
1019}
1020
1021sub hug {
1022	my $text = shift;
1023	my @text = split(/\n/, $text);
1024	my $size = Irssi::settings_get_int("hug_size");
1025
1026	# what is the longest line
1027	my $length = 0;
1028	foreach my $line (@text) {
1029		$length = clean_length($line) if clean_length($line) > $length;
1030	}
1031
1032
1033	my @output;
1034	foreach my $line (@text) {
1035		$line = ("{" x $size) . ' ' . $line . (' ' x ($length - length($line))) . ' ' . ("}" x $size);
1036		push(@output, $line);
1037	}
1038
1039	return join("\n", @output);
1040}
1041
1042sub reverse_ascii {
1043	#####################
1044	# reverse ascii art #
1045	#####################
1046
1047	my $text = shift;
1048	my @lines = split(/\n/, $text);
1049
1050	# how big is the longest line
1051	my $length = 0;
1052	foreach my $line (@lines) {
1053		my $line_length = clean_length($line);
1054		$length = $line_length if ($line_length > $length);
1055	}
1056
1057	my @output;
1058	foreach my $line (@lines) {
1059		if ($line =~ /$COWCUT/) {
1060			push(@output, $line);
1061		} else {
1062			$line =~ s!/!$rnd!g;  $line =~ s!\\!/!g; $line =~ s!$rnd!\\!g;
1063			$line =~ s!{!$rnd!g;  $line =~ s!}!{!g;  $line =~ s!$rnd!}!g;
1064			$line =~ s!\(!$rnd!g; $line =~ s!\)!(!g; $line =~ s!$rnd!)!g;
1065			$line =~ s!\[!$rnd!g; $line =~ s!\]![!g; $line =~ s!$rnd!]!g;
1066			$line =~ s!<!$rnd!g;  $line =~ s!>!<!g;  $line =~ s!$rnd!>!g;
1067			push(@output, sprintf("%" . $length . "s", scalar(reverse($line))));
1068		}
1069	}
1070
1071	return join("\n", @output);
1072}
1073
1074sub upside_down {
1075	# kind of like reverse_ascii, only on a different axis
1076	my $text = shift;
1077	my @output;
1078	foreach my $line (split(/\n/, $text)) {
1079		$line =~ s!/!$rnd!g;  $line =~ s!\\!/!g; $line =~ s!$rnd!\\!g;
1080		$line =~ s!v!$rnd!g;  $line =~ s!\^!v!g; $line =~ s!$rnd!^!g;
1081		$line =~ s!_!-!g;
1082		unshift(@output, $line);
1083	}
1084
1085	return join("\n", @output);
1086}
1087
1088# irssi is not friendly to require semantic
1089# so just use perl's shellwords.pl here
1090sub shellwords {
1091	my $text = join('', @_) if @_;
1092	my (@words, $snippet, $field);
1093
1094	$text =~ s/^\s+//;
1095	while ($text ne '') {
1096		$field = '';
1097		for (;;) {
1098			if ($text =~ s/^"(([^"\\]|\\.)*)"//) {
1099				($snippet = $1) =~ s#\\(.)#$1#g;
1100			}
1101			elsif ($text =~ /^"/) {
1102				Irssi::print("Unmatched double quote");
1103				return;
1104			}
1105			elsif ($text =~ s/^'(([^'\\]|\\.)*)'//) {
1106				($snippet = $1) =~ s#\\(.)#$1#g;
1107			}
1108			elsif ($text =~ /^'/) {
1109				Irssi::print("Unmatched single quote");
1110				return;
1111			}
1112			elsif ($text =~ s/^\\(.)//) {
1113				$snippet = $1;
1114			}
1115			elsif ($text =~ s/^([^\s\\'"]+)//) {
1116				$snippet = $1;
1117			}
1118			else {
1119				$text =~ s/^\s+//;
1120				last;
1121			}
1122			$field .= $snippet;
1123		}
1124		push(@words, $field);
1125	}
1126	return @words;
1127}
1128
1129# command bindings
1130Irssi::command_bind("gay", \&gay);
1131Irssi::command_bind("colcow", \&colcow);
1132Irssi::command_bind("gayexec", \&gayexec);
1133Irssi::command_bind("gaycat", \&gaycat);
1134Irssi::command_bind("gv", \&gv);
1135
1136
1137############
1138# settings #
1139############
1140
1141# cowsay
1142Irssi::settings_add_str($IRSSI{name}, 'cowfile', 'default');
1143Irssi::settings_add_str($IRSSI{name}, 'cowsay_cmd', 'cowsay');
1144
1145# figlet
1146Irssi::settings_add_str($IRSSI{name}, 'figfont', 'standard');
1147Irssi::settings_add_int($IRSSI{name}, 'linewrap', 50);
1148Irssi::settings_add_str($IRSSI{name}, 'figlet_cmd', 'figlet');
1149
1150# rainbow
1151Irssi::settings_add_int($IRSSI{name}, 'rainbow_offset', 0);
1152Irssi::settings_add_bool($IRSSI{name}, 'rainbow_keepstate', 1);
1153Irssi::settings_add_int($IRSSI{name}, 'gay_default_style', 1);
1154
1155# checkers
1156Irssi::settings_add_int($IRSSI{name}, 'check_size', 3);
1157Irssi::settings_add_int($IRSSI{name}, 'check_text', 0);
1158Irssi::settings_add_str($IRSSI{name}, 'check_colors', "4,2");
1159
1160# the matrix
1161Irssi::settings_add_int($IRSSI{name}, "matrix_size", 6);
1162Irssi::settings_add_int($IRSSI{name}, "matrix_spacing", 2);
1163
1164# misc
1165Irssi::settings_add_int($IRSSI{name}, 'colcat_max', 2048);
1166Irssi::settings_add_str($IRSSI{name}, 'jive_cmd', 'jive');
1167Irssi::settings_add_int($IRSSI{name}, 'spook_words', 6);
1168Irssi::settings_add_int($IRSSI{name}, 'hug_size', 5);
1169
1170###########
1171# startup #
1172###########
1173
1174Irssi::print("$SPLASH.  '/gay help' for usage");
1175
1176