# unleash the gay!!!  shoutz to #insub
# author: cj_ <rover@gruntle.org>
# type /gay help for usage after loading
#
# "If used sparingly, and in good taste, ASCII art generally 
# is very well-received !"
#                             -- Some Sucker

use Irssi;
use Text::Wrap;
use strict;
use vars qw($VERSION %IRSSI $SPLASH);

$VERSION = "5.5";
%IRSSI = (
	author		=> 'cj_',
	contact		=> 'rover@gruntle.org',
	download	=> 'http://gruntle.org/projects/irssi/gay',
	name		=> 'gay',
	description	=> 'a lot of annoying ascii color/art text filters',
	license		=> 'Public Domain',
	changed		=> 'Mon Aug 18 17:45:31 PDT 2003',
	version		=> $VERSION,
);

############################################################
# this is for displaying in various places to bug the user #
############################################################

# usage/contact info
$SPLASH = "$IRSSI{name} $IRSSI{version} by $IRSSI{author} <$IRSSI{contact}>";

# quick help
my $USAGE = <<EOU;
/COMMAND [-123456] [-blink] [-msg <target>] [-pre <text>]
         [-fig] [-font <font>] [-cow] [-cowfile <file>] 
         [-matrix] [-box|-3d|-arrow] [-check|capchk]
         [-spook] [-rev] [-leet] [-hug] <text>
EOU

# for /gay col, list colormap
my $COLMAP = <<COLMAP;
0,1\26\26 0 = white
1,0\26\26 1 = black
2,1\26\26 2 = blue
3,1\26\26 3 = green
4,1\26\26 4 = orange
5,1\26\26 5 = red (yellow in epic/bx)
6,1\26\26 6 = magenta
7,1\26\26 7 = yellow (red in epic/bx)
8,1\26\26 8 = bright yellow
9,1\26\26 9 = bright green
10,1\26\26 10 = cyan
11,1\26\26 11 = gray
12,1\26\26 12 = bright blue
13,1\26\26 13 = bright purple
14,1\26\26 14 = dark gray
15,1\26\26 15 = light gray
COLMAP

# spook array.. in a perfect world this would
# be in its own file.  this is stolen right out of emacs.  gg

my @spook_lines = (
	"\$400 million in gold bullion",
	"[Hello to all my fans in domestic surveillance]", "AK-47",
	"ammunition", "arrangements", "assassination", "BATF", "bomb", "CIA",
	"class struggle", "Clinton", "Cocaine", "colonel",
	"counter-intelligence", "cracking", "Croatian", "cryptographic",
	"Delta Force", "DES", "domestic disruption", "explosion", "FBI", "FSF",
	"fissionable", "Ft. Bragg", "Ft. Meade", "genetic", "Honduras",
	"jihad", "Kennedy", "KGB", "Khaddafi", "kibo", "Legion of Doom",
	"Marxist", "Mossad", "munitions", "Nazi", "Noriega", "North Korea",
	"NORAD", "NSA", "nuclear", "Ortega", "Panama", "Peking", "PLO",
	"plutonium", "Qaddafi", "quiche", "radar", "Rule Psix",
	"Saddam Hussein", "SDI", "SEAL Team 6", "security", "Semtex",
	"Serbian", "smuggle", "South Africa", "Soviet ", "spy", "strategic",
	"supercomputer", "terrorist", "Treasury", "Uzi", "Waco, Texas",
	"World Trade Center",

	# mine
	"Eggs", "Libya", "Bush", "Kill the president", "GOP", "Republican"
);

# leet mapping
my $leet_map = {
	a => [ "4", "/\\", "@", "a", "A" ],
	b => [ "|o", "b", "B" ],
	c => [ "C", "c", "<" ],
	d => [ "d", "D", "|)" ],
	e => [ "e", "E", "3" ],
	f => [ "f", "F", "/=" ],
	g => [ "g", "G", "6" ],
	h => [ "h", "H", "|-|" ],
	i => [ "i", "I", "|", "1" ],
	j => [ "j", "J" ],
	k => [ "keke", "x", "X", "k", "K", "|<" ],
	l => [ "l", "L", "7", "|_" ],
	m => [ "|V|", "|\\/|", "m", "M" ],
	n => [ "n", "N", "|\\|" ],
	o => [ "0", "o", "O", "()", "[]", "<>" ],
	p => [ "p", "P", "9" ],
	q => [ "q", "Q" ],
	r => [ "r", "R" ],
	s => [ "s", "S", "5" ],
	t => [ "t", "T", "7" ],
	u => [ "|_|", "u", "U", "\\/" ],
	v => [ "v", "V", "\\/" ],
	w => [ "w", "W", "uu", "UU", "uU", "Uu", "\\/\\/" ],
	x => [ "x", "X", "><" ],
	y => [ "y", "Y" ],
	z => [ "z", "Z", "5" ],
};


# handler to reap dead children
# need this to avoid zombie/defunt processes
# waiting around to have their exit status read
my $child_pid;  
sub sigchild_handler {
	waitpid($child_pid, 0);
}

# declar this a global to prevent gay.pl
# from constantly checking
my $cowpath;

# markup stuff
my $COWCUT = "---COWCUT---";

###############################
# these are the main commands #
###############################

sub gay {
	my $text = shift;
	if    ($text =~ /^help/i   )     { show_help()               }
	elsif ($text =~ /^vers/i   )     { Irssi::print($SPLASH)     }
	elsif ($text =~ /^update/i )     { update()                  }
	elsif ($text =~ /^usage/i  )     { show_error($USAGE)        }
	elsif ($text =~ /^col/i    )     { show_error($COLMAP)       }
	else                             { process(undef, $text, @_) }
}

# these are aliases that use a predefined set of filters
sub colcow    { process("cr",  @_) }	# cowsay -> rainbow
sub gayexec   { process("e",   @_) }    # execute
sub gaycat    { process("x",   @_) }	# gaycat w/ byte restriction
sub gv        { process("v",   @_) }	# display version info

###############################
# this handles the processing #
###############################

sub process {
	my ($flags, $text, $server, $dest) = @_;

	if (!$server || !$server->{connected}) {
		Irssi::print("Not connected to server");
		return;
	}

	return unless $dest;

	# set up defaults
	my @text;
	my $prefix;
	my $style = Irssi::settings_get_int("gay_default_style");
	my $cowfile = Irssi::settings_get_str("cowfile");
	my $figfont = Irssi::settings_get_str("figfont");
	my $sendto = $dest->{name};

	# parse args
	my @args = shellwords($text);
	while (my $arg = shift(@args)) {
		if ($arg =~ /^-msg/)     { $sendto = shift(@args); next }
		if ($arg =~ /^-pre/)     { $prefix = shift(@args); next }
		if ($arg =~ /^-blink/)   { $flags .= "b"; next }
		if ($arg =~ /^-jive/)    { $flags .= "j"; next }
		if ($arg =~ /^-cowfile/) { $cowfile = shift(@args); next }
		if ($arg =~ /^-cow/)     { $flags .= "c"; next }
		if ($arg =~ /^-fig/)     { $flags .= "f"; next }
		if ($arg =~ /^-font/)    { $figfont = shift(@args); next }
		if ($arg =~ /^-box/)     { $flags .= "o"; next }
		if ($arg =~ /^-3d/)      { $flags .= "3"; next }
		if ($arg =~ /^-arrow/)   { $flags .= "a"; next }
		if ($arg =~ /^-check/)   { $flags .= "C"; next }
		if ($arg =~ /^-capchk/)  { $flags .= "h"; next }
		if ($arg =~ /^-matrix/)  { $flags .= "m"; next }
		if ($arg =~ /^-spook/)   { $flags .= "s"; next }
		if ($arg =~ /^-rev/)     { $flags .= "R"; next }
		if ($arg =~ /^-leet/)    { $flags .= "l"; next }
		if ($arg =~ /^-hug/)     { $flags .= "H"; next }
		if ($arg =~ /^-(\d)$/)   { $flags .= "r"; $style = $1; next }

		# doesn't match arguments, must be text!
		push(@text, $arg);
	}
	$text = join(" ", @text);
	$text =~ s/\\n/\n/sg;

	# for outlining, precedence must be set
	# 3dbox > arrow > box
	$flags =~ s/(o|a)//g if $flags =~ /3/;
	$flags =~ s/o//g     if $flags =~ /a/;

	# check should override rainbow for now
	$flags =~ s/r//g if $flags =~ /C/;

	# ... so should capchk, unless it's a cow, in which case
	# we invoke cowcut-fu
	my $cowcut = 0;
	if ($flags =~ /h/) {
		# yes, capchk was specified
		if ($flags =~ /c/ and $flags =~ /r/) {
			$cowcut = 1;
		} else {
			$flags =~ s/r//g;
		}
	}

	# capchk takes precedence over check
	$flags =~ s/C//g if $flags =~ /h/;


	##############################
	# filter text based on flags #
	##############################
	
	# where to get text
	$text = "$IRSSI{name} $IRSSI{version} - $IRSSI{download}" if $flags =~ /v/;
	$text = execute($text)           if $flags =~ /e/;
	$text = slurp($text)             if $flags =~ /x/;
	$text = spookify($text)          if $flags =~ /s/;

	# change the text contents itself
	$text = jive($text)              if $flags =~ /j/;
	$text = leet($text)              if $flags =~ /l/;
	$text = reverse($text)           if $flags =~ /R/;
	$text = matrix($text)            if $flags =~ /m/;

	# change the text appearance
	$text = figlet($text, $figfont)  if $flags =~ /f/;
	$text = hug($text)               if $flags =~ /H/;
	$text = wrap($text)              if $flags !~ /f/;

	# change the text presentation
	$text = checker($text)                    if $flags =~ /h/;
	$text = cowsay($text, $cowfile, $cowcut)  if $flags =~ /c/;
	$text = checker($text)                    if $flags =~ /C/;

	# draw a box, pass a style flag
	$text = outline($text, 0)                 if $flags =~ /o/;
	$text = outline($text, 1)                 if $flags =~ /3/;
	$text = outline($text, 2)                 if $flags =~ /a/;

	# change the final products visual appearance
	$text = rainbow($text, $style)   if $flags =~ /r/;
	$text = blink($text)             if $flags =~ /b/;

	########################
	# output final product #
	########################

	foreach my $line (split(/\n/, $text)) {
		$line = "$prefix $line" if ($prefix);
		$server->command("msg $sendto $line");
	}
}

######################################################
# these filters pass text through various gayalizers #
######################################################

sub find_cowpath {
	# see if we can find the program
	my $cowsay_cmd = Irssi::settings_get_str('cowsay_cmd');
	$cowsay_cmd = -x $cowsay_cmd ? $cowsay_cmd : whereis("cowsay");
	unless (-x $cowsay_cmd) {
		Irssi::print("$cowsay_cmd not found or not executable!");
		return;
	}

	unless (open(COWSAY, "<$cowsay_cmd")) {
		Irssi::print("problem reading $cowsay_cmd");
		return;
	}

	my $find_cowpath;
	while (my $line = <COWSAY>) {
		if ($line =~ m!^\$cowpath = \$ENV\{'COWPATH'\} \|\| '(.*?)';!) {
			$find_cowpath = $1;
			last;
		}
	}

	close COWSAY;

	if (!$find_cowpath) { Irssi::print("I was unable to find the cowpath!") }
	return $find_cowpath;
}

sub cowsay {
	# my cowsay implementation.. because normal cowsay
	# messes up bubble-size if you have imbedded
	# color codes.. this works pretty much the same,
	# except it doesn't have support for stuff like
	# tongue and eyes.
	
	my $text = shift;
	my $cowfile = shift || "default";
	my $cowcut = shift;

	# my mother tried to find my cowpath once.. once.
	if (!$cowpath) { $cowpath = $ENV{COWPATH} || find_cowpath() }

	my @output;

	# this is the whole point of doing my own cowsay
	my $length = 0;
	my @text = split(/\n/, $text);
	foreach my $line (@text) {
		my $l = clean_length($line);
		$length = $l if $l > $length;
	}

	# add filler to the end
	foreach my $line (@text) {
		$line .= (" " x ($length - clean_length($line)));
	}

	my $div = " " . ("-" x ($length+2));
	push(@output, $div);
	push(@output, $COWCUT) if $cowcut;
	my $count = 0;
	my $total = scalar(@text) - 1;
	foreach my $line (@text) {
		if ($total == 0) {
			push(@output, "< $line >");
		} elsif ($count == 0) {
			push(@output, "/ $line \\");
		} elsif ($count == $total) {
			push(@output, "\\ $line /");
		} else {
			push(@output, "| $line |");
		}
		$count++;
	}
	
	# this is rainbow() markup for toggling colorize
	push(@output, $COWCUT) if $cowcut;
	push(@output, $div);


	my $full;
	$cowfile .= ".cow" unless ($cowfile =~ /\.cow$/);
	if ($cowfile =~ m!/!) {
		$full = $cowfile;
	} else {
		foreach my $path (split(/:/, $cowpath)) {
			if (-f "$path/$cowfile") {
				$full = "$path/$cowfile";
				last;
			}
		}
	}

	unless (-f $full) {
		Irssi::print("could not find cowfile: $cowfile");
		return;
	}

	my $the_cow = "";
	my $thoughts = '\\';
	my $eyes = "oo";
	my $tongue = "  ";


	unless (open(IN, "<$full")) {
		Irssi::print("couldn't read $full: $!");
		return;
	}
	my $cow_code = join('', <IN>);
	close IN;

	eval $cow_code;

	push(@output, split(/\n/, $the_cow));
	return join("\n", @output);
}

sub figlet {
	# pass text through figlet
	my $text = shift;
	my $figlet_font = shift || 'standard';
	my $figlet_wrap = Irssi::settings_get_int('linewrap');

	# see if we can find the program
	my $figlet_cmd = Irssi::settings_get_str('figlet_cmd');
	$figlet_cmd = -x $figlet_cmd ? $figlet_cmd : whereis("figlet");
	unless (-x $figlet_cmd) {
		Irssi::print("$figlet_cmd not found or not executable!");
		return;
	}

	open3(*READ, *WRITE, *ERR, "$figlet_cmd -f $figlet_font -w $figlet_wrap");
	print WRITE $text;
	close WRITE;

	$text = join('', <READ>);
	close READ;

	# check for errors
	show_error(join('', <ERR>));
	close ERR;

	$text =~ s/^\s+\n//g;     # sometime sit leaves leading blanks too!
	$text =~ s/\n\s+\n$//s;   # figlet leaves a trailing blank line.. sometimes

	return $text;
}

sub jive {
	# pass text through jive filter
	my $text = shift;

	# see if we can find the program
	my $jive_cmd = Irssi::settings_get_str('jive_cmd');
	$jive_cmd = -x $jive_cmd ? $jive_cmd : whereis("jive");
	unless (-x $jive_cmd) {
		Irssi::print("$jive_cmd not found or not executable!");
		return;
	}

	open3(*READ, *WRITE, *ERR, "$jive_cmd");
	print WRITE $text;
	close WRITE;

	$text = join('', <READ>);
	close READ;

	# check for errors
	show_error(join('', <ERR>));
	close ERR;

	return $text;
}

sub checker {
	# checker filter.  thanks to uke, my gay competition
	my $text = shift;
	my $checksize = Irssi::settings_get_int('check_size');
	my $checktext  = Irssi::settings_get_int('check_text');

	my @colors = split(/\s*,\s*/, Irssi::settings_get_str("check_colors"));

	my $rownum = 0;
	my $offset = 0;
	my @text = split(/\n/, $text);

	# what is the longest line?
	my $length = 0;
	foreach my $line (@text) {
		$length = length($line) if length($line) > $length;
	}

	foreach my $line (@text) {
		# pad line with whitespace
		$line .= (" " x ($length - length($line)));

		my $newline;
		my $state = 0;
		for (my $i = 0; $i < length($line); $i = $i + $checksize) {
			my $chunk = substr($line, $i, $checksize);
			my $index = ($state + $offset); $index -= scalar(@colors) if $index >= scalar(@colors);

			# figure out color code
			my $code = "\x03" . $checktext . "," . $colors[$index] . "\26\26";

			$newline .= "$code$chunk";
			$state++; $state = 0 if $state >= scalar(@colors);
		}
		# make sure it is reset to default so colors don't "leak"
		# into the outline() routine
		$line = $newline . "";

		# increment rowcount/swap offset
		$rownum++;
		if ($rownum == $checksize) {
			$rownum = 0;
			$offset++; $offset = 0 if $offset >= scalar(@colors);
		}
	}
	return join("\n", @text);
}

sub rainbow {
	# make colorful text
	my ($text, $style) = @_;

	# calculate stateful color offset
	my $state_offset = 0;
	if (Irssi::settings_get_bool("rainbow_keepstate")) {
		$state_offset = Irssi::settings_get_int("rainbow_offset");
		if ($state_offset < 0 or $state_offset > 20) {
			$state_offset = 0;
		} else {
			$state_offset++;
		}

		Irssi::settings_set_int("rainbow_offset", $state_offset);
	}
	
	# generate colormap based on style
	my @colormap;
	if ($style == 1) {
		# rainbow
		@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);
	} elsif ($style == 2) {
		# patriotic
		@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);
	} elsif ($style == 3) {
		# random colors
		while (scalar(@colormap) < 24) {
			my $color = int(rand(0) * 15) + 1;
			$color = 0 if $color == 1;
			push(@colormap, $color);
		}
	} elsif ($style == 4) {
		# alternating colors shade, color is random
		my $rand = int(rand(0) * 6) + 1;
		if ($rand == 1) {
			# blue
			@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);
		} elsif ($rand == 2) {
			# green
			@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);
		} elsif ($rand == 3) {
			# purple
			@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);
		} elsif ($rand == 4) {
			# gray
			@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);
		} elsif ($rand == 5) {
			# yellow
			@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);
		} elsif ($rand == 6) {
			# red
			@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);
		}
	} elsif ($style == 5) {
		# alternating shades of grey.  i liked this one so much i gave
		# it its own style.  does NOT like to blink, though
		@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);
	} elsif ($style == 6) {
		# greyscale
		@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);
	} else {
		# invalid style setting
		Irssi::print("invalid style setting: $style");
		return;
	}

	# this gets toggle if cowcut markup is seen
	my $colorize = 1;

	# colorize.. thanks 2 sisko
	my $newtext;
	my $row = 0;
	foreach my $line (split(/\n/, $text)) {
		if ($line =~ /$COWCUT/) {
			# toggle state when we see this
			$colorize++;
			$colorize = 0 if $colorize == 2;
			next;
		}

		if ($colorize == 0) {
			$newtext .= "$line\n";
			next;
		}

		for (my $i = 0; $i < length($line); $i++) {
			my $chr = substr($line, $i, 1);
			my $color = $i + $row + $state_offset;
			$color = $color ?  $colormap[$color %($#colormap-1)] : $colormap[0];
			$newtext .= "\003$color" unless ($chr =~ /\s/);
			my $ord = ord($chr);
			if (($ord >= 48 and $ord <= 57) or $ord == 44) {
				$newtext .= "\26\26";
			}
			$newtext .= $chr;
		}
		$newtext .= "\n";
		$row++;
	}

	return $newtext;
}

sub blink {
	# make the text blink
	my $text = shift;
	my @newtext;
	foreach my $line (split(/\n/, $text)) {
		push(@newtext, "$line");
	}
	return join("\n", @newtext);
}

sub clean_length {
	my $text = shift;
	$text =~ s/\x03\d+(,\d+)?(\26\26)?//g;
	$text =~ s/\[0m//g;
	return length($text);
}

sub matrix {
	# 0-day greetz to EnCapSulaTE1!11!one
	my $text = shift;
	my $size = Irssi::settings_get_int("matrix_size");
	my $spacing = Irssi::settings_get_int("matrix_spacing");

	$size = 1 if ($size < 1);

	# first, let's dispense with the newlinesa
	# because they have no meaning up/down
	$text =~ s/\n/ /sg;

	my @text;
	for (my $i = 0; $i < length($text); $i += $size) {
		my $chunk = substr($text, $i, $size);
		for (my $j = 0; $j < length($chunk); $j++) {
			$text[$j] .= substr($chunk, $j, 1) . (" " x $spacing);
		}
	}
	return join("\n", @text);
}

sub outline {
	# draw a box around text.. thanks 2 twid
	# for the idea
	my ($text, $style) = @_;
	my ($_3d, $_arrow);

	if ($style == 1) {
		$_3d = 1;
	} elsif ($style == 2) {
		# arrow-style, thanks to rob
		$_arrow = 1;
	}
	
	my @text = split(/\n/, $text);

	# what is the longest line
	my $length = 0;
	
	foreach my $line (@text) {
		$length = clean_length($line) if clean_length($line) > $length;
	}

	# add box around each line
	my $lc = "|"; my $rc = "|";
	if ($_arrow) { $lc = ">"; $rc = "<" }
	foreach my $line (@text) {
		$line = "$lc $line" . (" " x ($length - clean_length($line) + 1)) . "$rc";
		$line .= " |" if ($_3d);
	}

	# top/bottom frame
	my ($top_frame, $bottom_frame);
	if ($_arrow) {
		$top_frame = "\\" . ("^" x ($length + 2)) . "/";
		$bottom_frame = "/" . ("^" x ($length + 2)) . "\\";
	} else {
		$top_frame = "+" . ("-" x ($length + 2)) . "+";
		$bottom_frame = $top_frame;
	}


	if ($_3d) {
		push(@text, $bottom_frame . "/");
		unshift(@text, $top_frame . " |");
	} else {
		push(@text, $bottom_frame);
		unshift(@text, $top_frame);
	}

	if ($_3d) {
		unshift(@text, " /" . (" " x ($length + 2)) . "/|");
		unshift(@text, "  " . ("_" x ($length + 3)));
	}


	return join("\n", @text);
}

sub whereis {
	# evaluate $PATH, since this doesn't seem to be inherited
	# in sh subproccess in irssi.. odd
	my $cmd = shift;
	foreach my $path (split(/:/, $ENV{PATH})) {
		my $test = "$path/$cmd";
		if (-x $test) {
			return $test;
		}
	}
}

sub slurp {
	# read in a file with max setting (useful for catting /dev/urandom :D )
	# maybe make this read in chunks, not by line, or something.. seems clumsy
	my $file = shift;

	# expand ~
	$file =~ s!^~([^/]*)!$1 ? (getpwnam($1))[7] : ($ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7])!ex;

	unless (open(IN, "<$file")) {
		Irssi::print("could not open $file: $!");
		return;
	}

	my $max = Irssi::settings_get_int("colcat_max");
	my $text;
	while (my $line = <IN>) {
		$text .= $line;
		last if length($text) >= $max;
	}
	close IN;

	return $text;
}

sub execute {
	# execute command and return output
	my $text = shift;

	open3(*READ, *WRITE, *ERR, $text);
	close WRITE;

	$text = join('', <READ>);
	close READ;
	
	# check for errors
	show_error(join('', <ERR>));
	close ERR;

	return $text;
}



sub show_help {
	my $help = <<EOH;
$USAGE

STYLES:
-1     rainbow
-2     red white and blue
-3     random colors
-4     random alternating colors
-5     alternating gray
-6     greyscale

COMMANDS:
/gay                 just like /say, but gay
/gay help            this help screen
/gay version         show version information
/gay usage           just show usage line
/gay update          check for new release & update
/gayexec             like /exec, but gayer
/gaycat              pipe a file
/gv                  tell the world you're gay

SETTINGS:

cowfile <cowsay file>
figfont <figlet file>
linewrap <# to wrap at>
cowsay_cmd <path to cowsay program>
figlet_cmd <path to figlet program>
jive_cmd <path to jive program>
colcat_max # 
gay_default_style #
rainbow_keepstate <ON|OFF>
check_size #
check_colors #,#,...
check_text #
matrix_size, #
matrix_spacing #
spook_words #
hug_size #
EOH
	Irssi::print(draw_box($SPLASH, $help, undef, 1), MSGLEVEL_CLIENTCRAP);
}

sub draw_box {
	# taken from a busted script distributed with irssi
	# just a simple ascii line-art around help text
	my ($title, $text, $footer, $color) = @_;
	$footer = $title unless($footer);
	my $box;
	$box .= '%R,--[%n%9%U' . $title . '%U%9%R]%n' . "\n";
	foreach my $line (split(/\n/, $text)) {
		$box .= '%R|%n ' . $line . "\n";
	}
	$box .= '%R`--<%n' . $footer . '%R>->%n';
	$box =~ s/%.//g unless $color;
	return $box;
}

sub show_error {
	# take text gathered from STDERR and pass it here
	# to display to the client
	my $text = shift;
	foreach my $line (split(/\n/, $text)) {
		Irssi::print($line);
	}
}

sub open3 {
	my ($read, $write, $err, $command) = @_;

	pipe($read, RTMP);
	pipe($err, ETMP);
	pipe(WTMP, $write);

	select($read); $| = 1;
	select($err); $| = 1;
	select($write); $| = 1;
	select(STDOUT);

	return 0 unless defined $command;

	# fork
	my $pid = fork();
	if ($pid) {
		# parent
		$child_pid = $pid;
		$SIG{CHLD} = \&sigchild_handler;
		close RTMP; close WTMP; close ETMP;
		return $pid;
	} else {
		# child
		close $write; close $read; close $err;
		open(STDIN,  "<&WTMP"); close WTMP;
		open(STDOUT, ">&RTMP"); close RTMP;
		open(STDERR, ">&ETMP"); close ETMP;
		exec($command);
		exit 0;
	}
}

sub update {
	# automatically check for updates
	my $baseURL = $IRSSI{download};
	
	# do we have useragent?
	eval "use LWP::UserAgent";
	if ($@) {
		Irssi::print("LWP::UserAgent failed to load: $!");
		return;
	}

	# first see what the latest version is
	my $ua = LWP::UserAgent->new();
	my $req = HTTP::Request->new(
		GET	=> "$baseURL/CURRENT",
	);
	my $res = $ua->request($req);
	if (!$res->is_success()) {
		Irssi::print("Problem contacting the mothership");
		return;
	}

	my $latest_version = $res->content(); chomp $latest_version;
	Irssi::print("Your version is: $VERSION");
	Irssi::print("Current version is: $latest_version");

	if ($VERSION >= $latest_version) {
		Irssi::print("You are up to date");
		return;
	}

	# uh oh, old stuff!  time to update
	Irssi::print("You are out of date, fetching latest");
	$req = HTTP::Request->new(
		GET	=> "$baseURL/gay-$latest_version.pl",
	);
	$res = $ua->request($req);
	if (!$res->is_success()) {
		Irssi::print("Problem contacting the mothership");
		return;
	}

	my $src = $res->content();

	# check for integrity
	if ($src !~ /(\$VERSION = "$latest_version";)/s) {
		Irssi::print("Version mismatch, aborting");
		return;
	}

	# where should we save this?
	my $script_dir = "$ENV{HOME}/.irssi/scripts";
	if (! -d $script_dir) {
		Irssi::print("Could not determine script dir");
		return;
	}

	# save the shit already
	unless (open(OUT, ">$script_dir/downloaded-gay.pl")) {
		Irssi::print("Couldn't write to $script_dir/gay.pl: $!");
		return;
	}

	print OUT $src;
	close OUT;

	# copy to location
	rename("$script_dir/gay.pl", "$script_dir/gay-$VERSION.pl");
	rename("$script_dir/downloaded-gay.pl", "$script_dir/gay.pl");

	Irssi::print("Updated successfully! '/run gay' to load");
}

sub spookify {
	# add emacs spook text.  if there is previously existing text, it appends
	my $text = shift;
	my $count = Irssi::settings_get_int('spook_words') || return $text;
	my @spook_words;
	for (my $i = 0; $i < $count; $i++) {
		my $word = $spook_lines[int(rand(0) * scalar(@spook_lines))];
		push(@spook_words, $word);
	}
	my $text = join(" ", @spook_words) . " $text";
	return $text;
}

sub wrap {
	# fix that shit
	my $text = shift;
	my $wrap = Irssi::settings_get_int("linewrap") || return $text;
	$Text::Wrap::columns = $wrap;
	my @output;
	foreach my $line (split(/\n/, $text)) {
		if (length($line) > $wrap) {
			($line) = Text::Wrap::wrap(undef, undef, $line);
		}
		$line =~ s/\t/     /g;
		push(@output, $line);
	}

	$text = join("\n", @output);
	return $text;
}

sub leet {
	# leet speak :(
	my $text = shift;
	my @output;
	foreach my $line (split(/\n/, $text)) {
		my $newline;
		for (my $i = 0; $i < length($line); $i++) {
			my $char = lc(substr($line, $i, 1));
			if ($leet_map->{$char}) {
				my @possibles = @{$leet_map->{$char}};
				$char = $possibles[int(rand(0) * scalar(@possibles))];
			}
			$newline .= $char;
		}
		push(@output, $newline);
	}
	return join("\n", @output);
}

sub hug {
	my $text = shift;
	my @text = split(/\n/, $text);
	my $size = Irssi::settings_get_int("hug_size");

	# what is the longest line
	my $length = 0;
	foreach my $line (@text) {
		$length = clean_length($line) if clean_length($line) > $length;
	}


	my @output;
	foreach my $line (@text) {
		$line = ("{" x $size) . ' ' . $line . (' ' x ($length - length($line))) . ' ' . ("}" x $size);
		push(@output, $line);
	}

	return join("\n", @output);
}

# irssi is not friendly to require semantic
# so just use perl's shellwords.pl here
sub shellwords {
	my $text = join('', @_) if @_;
	my (@words, $snippet, $field);

	$text =~ s/^\s+//;
	while ($text ne '') {
		$field = '';
		for (;;) {
			if ($text =~ s/^"(([^"\\]|\\.)*)"//) {
				($snippet = $1) =~ s#\\(.)#$1#g;
			}
			elsif ($text =~ /^"/) {
				Irssi::print("Unmatched double quote");
				return;
			}
			elsif ($text =~ s/^'(([^'\\]|\\.)*)'//) {
				($snippet = $1) =~ s#\\(.)#$1#g;
			}
			elsif ($text =~ /^'/) {
				Irssi::print("Unmatched single quote");
				return;
			}
			elsif ($text =~ s/^\\(.)//) {
				$snippet = $1;
			}
			elsif ($text =~ s/^([^\s\\'"]+)//) {
				$snippet = $1;
			}
			else {
				$text =~ s/^\s+//;
				last;
			}
			$field .= $snippet;
		}
		push(@words, $field);
	}
	return @words;
}

# command bindings
Irssi::command_bind("gay", \&gay);
Irssi::command_bind("colcow", \&colcow);
Irssi::command_bind("gayexec", \&gayexec);
Irssi::command_bind("gaycat", \&gaycat);
Irssi::command_bind("gv", \&gv);


############
# settings #
############

# cowsay
Irssi::settings_add_str($IRSSI{name}, 'cowfile', 'default');
Irssi::settings_add_str($IRSSI{name}, 'cowsay_cmd', 'cowsay');

# figlet
Irssi::settings_add_str($IRSSI{name}, 'figfont', 'standard');
Irssi::settings_add_int($IRSSI{name}, 'linewrap', 50);
Irssi::settings_add_str($IRSSI{name}, 'figlet_cmd', 'figlet');

# rainbow
Irssi::settings_add_int($IRSSI{name}, 'rainbow_offset', 0);
Irssi::settings_add_bool($IRSSI{name}, 'rainbow_keepstate', 1);
Irssi::settings_add_int($IRSSI{name}, 'gay_default_style', 1);

# checkers
Irssi::settings_add_int($IRSSI{name}, 'check_size', 3);
Irssi::settings_add_int($IRSSI{name}, 'check_text', 0);
Irssi::settings_add_str($IRSSI{name}, 'check_colors', "4,2");

# the matrix
Irssi::settings_add_int($IRSSI{name}, "matrix_size", 6);
Irssi::settings_add_int($IRSSI{name}, "matrix_spacing", 2);

# misc
Irssi::settings_add_int($IRSSI{name}, 'colcat_max', 2048);
Irssi::settings_add_str($IRSSI{name}, 'jive_cmd', 'jive');
Irssi::settings_add_int($IRSSI{name}, 'spook_words', 6);
Irssi::settings_add_int($IRSSI{name}, 'hug_size', 5);

###########
# startup #
###########

Irssi::print("$SPLASH.  '/gay help' for usage");