#
# wanna say? wamma say!
#
# 2009-01-28: initial version by jorma teräs
# 2009-04-30: frank drebin donated utf-8 support, capital letters and a few special characters
# 2009-05-07: tuned letters s, w and t.
#
use strict;
use Irssi;

use vars qw/$VERSION %IRSSI/;

$VERSION = '2009-04-30';

%IRSSI = (
  name => 'wsay',
  authors => 'Jorma Teräs & Frank Drebin',
  contact => 'hanski@gmail.com',
  url => 'http://www.wamma.fi',
  license => 'Public Domain',
  description => 'wanna say? wamma say!'
);

my $g_font_data = <<FONT_DATA;
 ###
#   #
#####
#   #
#   #

####
#   #
####
#   #
####

 ###
#   #
#
#   #
 ###

####
#   #
#   #
#   #
####

#####
#
#####
#
#####

#####
#
####
#
#

 ###
#   
#  ##
#   #
 ###

#   #
#   #
#####
#   #
#   #

###
 #
 #
 #
###

   #
   #
   #
#  #
 ##

#  #
# #
##
# #
#  #

#
#
#
#
####

#   #
## ##
# # #
# # #
#   #

#   #
##  #
# # #
#  ##
#   #

 ###
#   #
#   #
#   #
 ###

####
#   #
####
#
#

 ###
#   #
# # #
#  ##
 ###

####
#   #
####
# #
#  #

 ###
#   
 ###
    #
 ###

#####
  #
  #
  #
  #

#   #
#   #
#   #
#   #
 ###

#   #
#   #
#   #
 # #
  #

#   #
#   #
# # #
## ##
#   #

#   #
 # #
  #
 # #
#   #

#   #
 # #
  #
  #
  #

#####
   #
  #
 #
#####

 ###
  #
 # #
# # #
#   #

 # #
  #
 # #
# # #
#   #

#   #
 ###
#   #
#   #
 ###

 ##
   #
 ###
#  #
 ###

# 
#
###
#  #
###

 __
 ##
#
# 
 ##

   #
   #
 ###
#  #
 ###

 ##
#  #
###
#  
 ##

  ##
 #
###
 #
 #

 ###
#  #
 ###
   #
 ##

# 
# 
###
#  #
#  #

 #
__
##
 #
 #

  #
  _
  #
# #
 ##

#
#  #
###
#  #
#  #

 #
 #
#
#
##

__
## #
# # #
# # #
# # #

_  _
###
#  #
#  #
#  #

 ___
 ###
#   #
#   #
 ###

___
###
#  #
###
#

 ___
 ###
#  #
 ###
   #

___
###
#  #
#
#

 __ 
 ###
##
  ##
####

 #
###
 #
 #
 ##

_  _
#  #
#  #
#  #
 ##

__  _
#   #
#   #
 # #
  #

__
#     #
#  #  #
 ## ##
 #   #

_   _
#  #
 ##
 # #
#   #

_   _
#   #
 # # 
  #
  #

 __
####
  ##
 ##
####

 ##
 __
 ###
#  #
####

#  #
 ##
   #
#  #
 ###

_  _
#  #
 ##
#  #
 ##

 ##
#  #
#  #
#  #
 ##
 
 #
##
 #
 #
 #

 ###
#   #
  ##
 #
#####
 
 ###
#   #
   #
#   #
 ###

  ##
 # #
####
   #
   #
   
####
#
####
    #
####

 ###
#
####
#   #
 ###

####
   #
 ##
  #
  #
  
 ###
#   #
 ###
#   #
 ###
 
 ###
#   #
 ####
    #
 ###

  #
 #
#
 #
  #

#
 #
  #
 #
#

___
###
___
###
___

 # #
#####
 # #
#####
 # #

    #
   #
  #
 #
#

#
 #
  #
   #
    # 

#
#
#
_
#

 ##
#  #
  #
  _
  #

_
_
###
_
_

_
_
_
_
#

.
FONT_DATA

# character->face hash, font face data, maximum width of each font face
my (%g_charmap, @g_font_faces, @g_face_max_width);

sub init
{
	# create character -> font face mapping
	my $i = 0;
	for my $char (qw/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 Å Ä Ö 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 < > = # \/ \ ! ? - ./)
	{
		$g_charmap{$char} = $i++;
	}
	
	# import the font faces from the flow of FONT_DATA trash above
	my $lines = [];
	my $width = 0;
	for my $line (split(/\n/, $g_font_data))
	{
		chomp $line;
		$line =~ s/\s+$//g;
		if ($line eq "")
		{
			push @g_font_faces, $lines;
			push @g_face_max_width, $width;
			$lines = [];
			$width = 0;
		}
		else
		{
			push @$lines, $line;
			$width = length $line if (length $line > $width);
		}
	}
	
	# colorize per letter by default
	Irssi::settings_add_bool('wsay', 'wsay_colorize_all', 0);
}

sub shuffle {
	my (@set) = @_;
	
	for (my $i = 0; $i < scalar(@set); $i++)
	{
		my $idx = int(rand(scalar @set));
		push(@set, splice(@set, $idx, 1));
	}
	
	return @set;
}

sub cmd_wsay
{
	my ($input, $server, $witem) = @_;

	if (length($input) < 1)
	{
		Irssi::print("yo dawg i herd u liek short messages so i giev u long message so u can write short message while u read long message");
		return;
	}
	
	# create a permutation of the color set (should display ok both in irssi and mirc by default)
	my @colors = ( 0, 2, 3, 4, 6, 7, 9, 10, 12, 13 );
	@colors = shuffle(@colors);
	
	my $colorize_all = Irssi::settings_get_bool('wsay_colorize_all');
	
	# render the text in horizontal order. for each character retrieve
	# the face and append it on the appropriate row list.
	my $color_idx = 0;
	my @output_rows = ( [], [], [], [], [] );
	my @inputarray = split(//, $input);
	for (my $ii = 0; ($ii < @inputarray); ++$ii)
	{
		my $char = $inputarray[$ii];
		# Auto-mangle UTF-8.
		if(ord($char) == 195)
		{
			$char = $char . $inputarray[++$ii];
		}
		
		# 
		if ($char eq ' ')
		{
			for (my $row = 0; $row < 5; $row++)
			{
				push @{$output_rows[$row]}, "   ";
			}
			next;
		}
		elsif (!exists($g_charmap{$char}))
		{
			print "wsay: unknown char: " . ord($char);
			next;
		}
		
		my $color;
		if ($colorize_all) {
			@colors = shuffle(@colors);
		}
		else {
			$color = sprintf("\003,%d", $colors[++$color_idx % scalar(@colors)]);
		}
		
		# render from the font face table
		my $face_idx = $g_charmap{$char};
		for (my $row = 0; $row < 5; $row++)
		{
			my $line = $g_font_faces[$face_idx]->[$row];
			$line .= ' ' x ($g_face_max_width[$face_idx] - length($line));
			
			if ($colorize_all) {
				my @tmp = ();
				my $color_on = 0;
				for my $c (split(//, $line)) {
					if ($c eq '#') {
						push(@tmp, sprintf("\0030,%d ", $colors[++$color_idx % scalar(@colors)]));
						$color_on = 1;
					}
					elsif ($c eq ' ' && $color_on) {
						push(@tmp, "\003 ");
						$color_on = 0;
					}
					else {
						push(@tmp, " ");
					}
				}
				push(@tmp, "\003");
				$line = join('', @tmp);
			}
			else {
				$line =~ s/(^| )#/$1$color#/g;
				$line =~ s/#($| )/#\003$1/g;
				$line =~ s/[#_]/ /g;
			}
			push @{$output_rows[$row]}, $line;
		}
	}
	
	# finally throw the message out there.
	for my $row (@output_rows)
	{
		my $msg = join(" ", @{$row});
		if ($witem && ($witem->{type} eq "QUERY" || $witem->{type} eq "CHANNEL"))
		{
			$witem->command("MSG ".$witem->{name}." ".$msg);
		}
		else
		{
			print $msg;
		}
	}
}

init();
Irssi::command_bind('wsay', 'cmd_wsay');