# This somehow goes in ~/.owl/modules/ZDecor/lib/BarnOwl/Module.
# Run :reload-module ZDecor after hacking.
use warnings;
use strict;
use utf8;

=head1 NAME

BarnOwl::Module::ZDecor

=head1 DESCRIPTION

Pretty colors! Pretty boxes! Pretty colors in boxes!

=cut

package BarnOwl::Module::ZDecor;
use POSIX;

our $VERSION = '0.2.3';
# 0.2.1: fixed zwrite personals?? --bpchen 2016/3/16
# 0.2.2: reply
# 0.2.3: better bold and italic patterns

my @rainbow = qw(red yellow green cyan blue magenta);
my @rainbow256 = qw(196 202 208 214 220 226 190 154 118 82 46 47 48 49 50 51 45 39 33 27 21 57 93 129 165 201 200 199 198 197);
my @rainbow15 = qw(196 208 220 190 118 46 48 50 45 33 21 93 165 200 198);
my @rainbow10 = qw(196 214 190 82 48 51 33 57 165 199);
my @fire = qw(196 202 208 214 220 226 220 214 208 202);
my @rgb = qw(red green blue);
my @rwb = qw(red white blue);

sub colorize {
	my $color = shift;
	my $_ = shift;
	s/@/@@/g;
	if (!$color) {
		return $_;
	} elsif (!/\}/) {
		return '@{@color{' . $color . "}$_}";
	} elsif (!/>/) {
		return '@<@color<' . $color . ">$_>";
	} elsif (!/\]/) {
		return '@[@color[' . $color . "]$_]";
	} else { # give up
		return '@(@color(' . $color . ")$_)";
	}
}

sub apply_bold_or_italic_to_formatted {
	my $format = shift;
	my $_ = shift;
	# NOTE no s/@/@@/
	if (!$format) {
		return $_;
	} elsif (!/\}/) {
		return '@' . $format . '{' . $_ . '}';
	} elsif (!/>/) {
		return '@' . $format . '<' . $_ . '>';
	} elsif (!/\]/) {
		return '@' . $format . '[' . $_ . ']';
	} else { # give up
		return '@' . $format . '(' . $_ . ')';
	}
}

sub rainbowify_line {
	my $scheme = shift;
	my $excludepat = shift;
	my $boldpat = shift;
	my $italicpat = shift;
	my $c = shift;
	my @chars = split //, shift;
	my $ret = '';
	for (@chars) {
		if ($_ eq ' ') {
			$ret .= ' ';
		} else {
			my $str = $_;
			if ($excludepat && /$excludepat/) {
				# just bold or italicize
				$str =~ s/@/@@/g;
				if ($boldpat && /$boldpat/) {
					$str = apply_bold_or_italic_to_formatted('b', $str);
				}
				if ($italicpat && /$italicpat/) {
					$str = apply_bold_or_italic_to_formatted('i', $str);
				}
			} else {
				$str = colorize($scheme->[$c % @$scheme], $_);
				if ($boldpat && /$boldpat/) {
					$str = apply_bold_or_italic_to_formatted('b', $str);
				}
				if ($italicpat && /$italicpat/) {
					$str = apply_bold_or_italic_to_formatted('i', $str);
				}
			}
			$ret .= $str;
		}
		$c += 1;
	}
	return $ret;
}

sub rainbowify {
	my $scheme     = shift;
	my $excludepat = shift;
	my $boldpat    = shift;
	my $italicpat  = shift;
	my $r = 0;
	if (!$scheme) {
		return shift;
	}
	my @lines = split "\n", shift;
	my $ret = '';
	for (@lines) {
		$ret .= rainbowify_line($scheme, $excludepat, $boldpat, $italicpat, $r, $_) . "\n";
		$r += 1;
	}
	return $ret;
}

sub replace_newlines {
	$_ = shift;
	s!\@\\!\n!g;
	return $_;
}

sub replace_rainbows {
	$_ = shift;
	s/\@(?:rainbow|rbw)\(([^)]+)\)/rainbowify_line(\@rainbow, '', '', '', 0, $1)/ge;
	s/\@(?:rainbow|rbw)256\(([^)]+)\)/rainbowify_line(\@rainbow256, '', '', '', 0, $1)/ge;
	s/\@(?:rainbow|rbw)30\(([^)]+)\)/rainbowify_line(\@rainbow256, '', '', '', 0, $1)/ge;
	s/\@(?:rainbow|rbw)15\(([^)]+)\)/rainbowify_line(\@rainbow15, '', '', '', 0, $1)/ge;
	s/\@(?:rainbow|rbw)10\(([^)]+)\)/rainbowify_line(\@rainbow10, '', '', '', 0, $1)/ge;
	s/\@rgb\(([^)]+)\)/rainbowify_line(\@rgb,   '', '', '', 0, $1)/ge;
	s/\@rwb\(([^)]+)\)/rainbowify_line(\@rwb,   '', '', '', 0, $1)/ge;
	s/\@fire\(([^)]+)\)/rainbowify_line(\@fire, '', '', '', 0, $1)/ge;
	return $_;
}

sub max_length {
	# takes a list of strings, returns max length of them
	my $maxlen = 0;
	for (@_) {
		my $curlen = length $_;
		if ($maxlen < $curlen) { $maxlen = $curlen; }
	}
	return $maxlen;
}

sub right_pad {
	my @lines = split "\n", shift;
	my $len = max_length(@lines);
	my $ret = '';
	for (@lines) {
		my $padded = ' ' x ($len - length($_)) . $_;
		$ret .= "$padded\n";
	}
	return $ret;
}

sub center_pad {
	my @lines = split "\n", shift;
	my $len = max_length(@lines);
	my $ret = '';
	for (@lines) {
		my $padded = ' ' x (($len - length($_))/2) . $_;
		$ret .= "$padded\n";
	}
	return $ret;
}

sub plus_two_pad {
	# takes a string, pads it with spaces into a rectangle and adds one space
	# to the left and right
	my @lines = split "\n", shift;
	my $len = max_length(@lines);
	my $ret = '';
	for (@lines) {
		my $padded = $_ . ' ' x ($len - length $_);
		$ret .= " $padded \n";
	}
	if (wantarray) {
		return ($ret, $len + 2);
	} else {
		return $ret;
	}
}

sub decorate {
	my $decoration = shift;
	if (!$decoration) { return shift; }
	my ($c1, $c2, $c3, $c4, $h1, $h2, $v1, $v2) = @$decoration;
	my @lines = split "\n", shift;
	my $len = shift;
	if (!defined($len)) {
		$len = max_length(@lines);
	}
	my $color = shift;
	my $ret = '';
	my $ret = '';
	if ($c1 || $h1 || $c2) {
		my $h1p = $h1 x $len;
		$ret .= colorize($color, "$c1$h1p$c2") . "\n";
	}
	for (@lines) {
		$ret .=
			colorize($color, $v1) . $_ .
			colorize($color, $v2) . "\n";
	}
	if ($c3 || $h2 || $c4) {
		my $h2p = $h2 x $len;
		$ret .= colorize($color, "$c3$h2p$c4") . "\n";
	}
	my $h2p = $h2 x $len;
	if (wantarray) {
		return ($ret, $len + 2);
	} else {
		return $ret;
	}
};

my %schemehash = (
	'--rbw' => \@rainbow,
	'--rainbow' => \@rainbow,
	'--rbw256' => \@rainbow256,
	'--rainbow256' => \@rainbow256,
	'--256' => \@rainbow256,
	'--rbw30' => \@rainbow256,
	'--rainbow30' => \@rainbow256,
	'--30' => \@rainbow256,
	'--rbw15' => \@rainbow15,
	'--rainbow15' => \@rainbow15,
	'--15' => \@rainbow15,
	'--rbw10' => \@rainbow10,
	'--rainbow10' => \@rainbow10,
	'--10' => \@rainbow10,
	'--rgb' => \@rgb,
	'--rwb' => \@rwb,
	'--fire' => \@fire,
);
my $defaultscheme = \@rainbow;

my $lrpad_decoration = ['', '', '', '', '', '', ' ', ' '];

my %decorationhash = (
	'--box' => [qw(+ + + + - - | |)],
	'--lrpad' => $lrpad_decoration,
	'--atbox' => [('@') x 8],
	'--hashbox' => [('#') x 8],
	'--tribox' => [('▲') x 8],
	'--astbox' => [('*') x 8],
	'--dotbox' => [('·') x 8],
	'--starbox' => [('★') x 8],
	'--heartbox' => [('♥') x 8],
	'--<3box' => [('♥') x 8],
	'--fbbox' => [('█') x 8],
	'--mbbox' => [('▒') x 8],
	'--obbox' => [qw(█ █ █ █ ▀ ▄ ▌ ▐)],
	'--ibbox' => [qw(█ █ █ █ ▄ ▀ ▐ ▌)],
	'--ubox' => [qw(┌ ┐ └ ┘ ─ ─ │ │)],
	'--hubox' => [qw(┏ ┓ ┗ ┛ ━ ━ ┃ ┃)],
	'--dubox' => [qw(╔ ╗ ╚ ╝ ═ ═ ║ ║)],
);

sub cmd_zdecor {
	my $cmd = shift;
	my $scheme = '';
	my @decorations = ();
	my $ispost = '';
	my $align = 'left'; # this value is not actually used
	my @postdecorations = ();
	my @postdeccolors = ();
	my $curpostdeccolor = '';
	my $excludepat = '';
	my $boldpat = '';
	my $italicpat = '';
	my $message = '';
	my $hasmessage = '';

	my @passthru = ();

	while (@_) {
		if ($schemehash{$_[0]}) {
			$scheme = $schemehash{$_[0]};
			shift;
		} elsif ($decorationhash{$_[0]}) {
			if ($ispost) {
				push @postdecorations, $decorationhash{$_[0]};
				push @postdeccolors, $curpostdeccolor;
			} else {
				push @decorations, $decorationhash{$_[0]};
			}
			shift;
		} elsif ($_[0] eq '--center') {
			$align = 'center';
			shift;
		} elsif ($_[0] eq '--right') {
			$align = 'right';
			shift;
		} elsif ($_[0] eq '--post') {
			$ispost = 1;
			shift;
		} elsif ($_[0] eq '--post-color' || $_[0] eq '--pc') {
			$ispost = 1;
			shift;
			$curpostdeccolor = shift;
		} elsif ($_[0] eq '--post-seq') {
			$ispost = 1;
			shift;

			my @seqscheme = @{$schemehash{shift}};
			my $seqdec = $decorationhash{shift};
			for (@seqscheme) {
				push @postdeccolors, $_;
				push @postdecorations, $seqdec;
			}
		} elsif ($_[0] eq '--post-pad-seq') {
			$ispost = 1;
			shift;

			my @seqscheme = @{$schemehash{(shift)}};
			my $seqdec = $decorationhash{(shift)};
			for (@seqscheme) {
				push @postdeccolors, $_;
				push @postdecorations, $seqdec;
				push @postdeccolors, '';
				push @postdecorations, $lrpad_decoration;
			}
		} elsif ($_[0] eq '--excludepat' || $_[0] eq '--ep') {
			shift;
			$excludepat = shift;
		} elsif ($_[0] eq '--boldpat' || $_[0] eq '--bp') {
			shift;
			$boldpat = shift;
		} elsif ($_[0] eq '--italicpat' || $_[0] eq '--ip') {
			shift;
			$italicpat = shift;
		} elsif ($_[0] eq '--message' || $_[0] eq '--msg') {
			shift;
			$message = shift;
			$hasmessage = 1;
		} else {
			push @passthru, shift;
		}
	}

	if (!@passthru) {
		BarnOwl::error('Error in zdecor, empty arguments');
	} else {
		my @bad_dashes = grep(/^--/, @passthru);
		if (@bad_dashes) {
			BarnOwl::error("Error in zdecor, stray double-hyphen argument after parsing: " . BarnOwl::quote(@bad_dashes));
		} else {
			my $args = BarnOwl::quote('zwrite', @passthru);
			my $final_zwriter = sub {
				my $text = shift;
				my $len = -1;
				$text = replace_newlines($text);
				if ($align eq 'center') {
					$text = center_pad($text);
				} elsif ($align eq 'right') {
					$text = right_pad($text);
				}
				if (@decorations || @postdecorations) {
					($text, $len) = plus_two_pad($text);
				}
				for (@decorations) {
					($text, $len) = decorate($_, $text, $len);
				}
				if ($scheme) {
					$text = rainbowify($scheme, $excludepat, $boldpat, $italicpat, $text);
				} else {
					$text = replace_rainbows($text);
				}
				for (@postdecorations) {
					($text, $len) = decorate($_, $text, $len, shift @postdeccolors);
				}
				BarnOwl::zephyr_zwrite($args, $text);
			};
			if ($hasmessage) {
				&$final_zwriter($message);
			} else {
				BarnOwl::start_edit_win("Enter text to (zdecor) $args", $final_zwriter);
			}
		}
	}
}

sub make_zdecor_reply {
	my $z = BarnOwl::getcurmsg();

	my ($class, $instance, $to, $cc);

	return unless $z->is_zephyr;

	$class = $z->class;
	$instance = $z->instance;
	$to = $z->recipient;
	$cc = $z->zephyr_cc();
	if($to eq '*' || $to eq '') {
		$to = '';
	} elsif($to !~ /^@/) {
		$to = $z->sender;
	}

	my $cmd = 'zdecor';

	if (lc $class eq 'message') {
		$cmd .= " -i " . BarnOwl::quote($instance);
	} else {
		$cmd .= " -c " . BarnOwl::quote($class);
		if (lc $instance ne 'personal') {
			$cmd .= " -i " . BarnOwl::quote($instance);
		}
	}

	if ($to ne '') {
		$to = BarnOwl::Message::Zephyr::strip_realm($to);
		if(BarnOwl::getvar('smartstrip') eq 'on') {
			$to = BarnOwl::zephyr_smartstrip_user($to);
		}
		$cmd .= " $to";
	}
	return $cmd;
}

sub start_zdecor_reply { BarnOwl::command("start-command " . make_zdecor_reply()); }

BarnOwl::new_command(zdecor => \&cmd_zdecor, {
		summary => "Zephyr a decorated piece of text",
		usage   => "zdecor [--256|...] [zephyr command-line]",
		description => "Asks you for some text and zephyrs it in boxes, with rainbow colors, or both.\n" .
		"Use with a zephyr command line, e.g. :zdecor -c bpchen -i status"
	});
BarnOwl::new_command('start-zdecor-reply' => \&start_zdecor_reply, {
		summary => "like reply -e, but uses zdecor instead",
	});

1;