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

=head1 NAME

BarnOwl::Module::ZStatus

=head1 DESCRIPTION

I didn't write this. --?
Me neither. --bpchen (2015/10/12)
(hacked together from https://github.com/nelhage/barnowl-zstatus aka
http://web.mit.edu/nelhage/Public/BarnOwl/ZStatus.par)

=cut

package BarnOwl::Module::ZStatus;
use POSIX;

our $VERSION = 0.2.1; # I don't actually know what this does *shrugs*

my $defaultmaxnum = 10; # default length of bars / denominator of stats

# default stat names that you're asked for
my @defaultqueries = ('Sleep-dep', 'Angst', 'Stress', 'Hosage');
# default stat names that are zephyred next to the bars
# (it's your responsibility to make them the same length for alignment)
my @defaultlabels = ('sleepdep', '   angst', '  stress', '  hosage');

my $statusheader = "[Zephyr status dashboard]\n";
my $barchar = "█";
my $barleft = "[";
my $barright = "]";

my @greentored = qw(green yellow red);
my @redtogreen = reverse @greentored;
my @rainbow = qw(red yellow green cyan blue magenta);
my @greentored256 = qw(46 82 118 154 190 226 220 214 208 202 196);
my @redtogreen256 = reverse @greentored256;
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 %schemehash = (
	'--g2r' => \@greentored,
	'--r2g' => \@redtogreen,
	'--rainbow' => \@rainbow,
	'--rbw' => \@rainbow,
	'--g2r256' => \@greentored256,
	'--r2g256' => \@redtogreen256,
	'--rainbow256' => \@rainbow256,
	'--rbw256' => \@rainbow256,
);
my $defaultscheme = \@greentored;

my $next = undef;

sub parse_slash {
	$_ = shift;
	if (m(/)) {
		return split '/', $_, 2;
	} else {
		return ($_, $defaultmaxnum);
	}
}

sub cmd_zstatus {
	my $cmd = shift;
	my $scheme = $defaultscheme;
	my $gradient = '';
	if ($schemehash{$_[0]}) {
		$scheme = $schemehash{$_[0]};
		shift;
	}
	if ($_[0] eq '--grad' or $_[0] eq '--gradient') {
		$gradient = 1;
		shift;
	}
	my $args = join(' ', @_);
	if ($args eq '') {
		BarnOwl::error('Error in zstatus arguments');
	} else {
		query_and_write(\@defaultqueries, \@defaultlabels, 0, $scheme, $gradient, $args);
	}
}

sub query_and_write {
	my $queries = shift;
	my $labels = shift;
	my $curindex = shift;
	my $scheme = shift;
	my $gradient = shift;
	if ($curindex < @$queries) {
		my @pass = @_;
		BarnOwl::start_question("$queries->[$curindex] [0-$defaultmaxnum]? ",
			sub { query_and_write($queries, $labels, $curindex + 1, $scheme, $gradient, @pass, @_); }
		);
	} else {
		my $args = shift;
		my $message = $statusheader;
		foreach (0..$#_) {
			$message .= format_bar($labels->[$_], parse_slash(trim($_[$_])), $scheme, $gradient);
		}
		BarnOwl::zephyr_zwrite($args, $message);
	}
}

sub cmd_zbars {
	my $cmd = shift;
	my $scheme = $defaultscheme;
	my $gradient = '';
	if ($schemehash{$_[0]}) {
		$scheme = $schemehash{$_[0]};
		shift;
	}
	if ($_[0] eq '--grad' or $_[0] eq '--gradient') {
		$gradient = 1;
		shift;
	}
	my $args = join(" ", @_);
	if ($args eq '') {
		BarnOwl::error('Error in zstatus arguments');
	} else {
		BarnOwl::start_question('foo=1;bar=2/3;..? ', sub {got_data($args, @_, $scheme, $gradient)});
	}
}

sub trim {
	my $s = shift;
	$s =~ s/^\s+//;
	$s =~ s/\s+$//;
	return $s;
}

sub got_data {
	my ($args, $data, $scheme, $gradient) = @_;
	my $message = $statusheader;

	my @bars = split(/;/,$data);
	my $padlen = 8;
	for (@bars) {
		next unless /=/;
		my $taglen = length((split('=', $_, 2))[0]);
		# perl doesn't have built-in max?? :(
		if ($padlen < $taglen) { $padlen = $taglen; }
	}
	for (@bars) {
		next unless /=/;
		my ($tag, $val) = split('=', $_, 2);
		my $tag = trim($tag);
		my ($num, $maxnum) = parse_slash(trim($val));
		$message .= format_bar(sprintf("%${padlen}s",$tag), $num, $maxnum, $scheme, $gradient);
	}
	BarnOwl::zephyr_zwrite($args, $message);
}

sub format_bar {
	my ($label, $num, $maxnum, $scheme, $gradient) = @_;
	if (!defined($scheme)) { $scheme = $defaultscheme; }

	my $frac = $num / $maxnum;
	my $bar = "";
	$bar .= "$label $barleft";
	if ($gradient) {
		$bar .= make_gradient($barchar, $num, $maxnum, $scheme) . " " x ($maxnum - $num) . $barright;
	} else {
		$bar .= colorize(($barchar x $num) . (" " x ($maxnum - $num)), $frac, $scheme) . $barright;
	}
	$bar .= colorize(" ($num/$maxnum)", $frac, $scheme);
	$bar .= "\n";
	return $bar;
}

sub make_gradient {
	my $char = shift;
	my $num = shift;
	my $maxnum = shift;
	my $scheme = shift;
	my $ret = '';
	for (1..$num) {
		$ret .= colorize($char, $_/$maxnum, $scheme);
	}
	return $ret;
}

sub colorize {
	my $text = shift;
	my $frac = shift;
	my $scheme = shift;
	my $color = $scheme->[ceil($frac * @$scheme)-1];

	return '@<@color(' . $color . ")$text>";
}

BarnOwl::new_command(zstatus => \&cmd_zstatus, {
		summary => "Zephyr a personal status dashboard",
		usage   => "zstatus [--g2r256|...] [--gradient] [zephyr command-line]",
		description => "Asks you questions about your status, and zephyrs the \n" .
		"result as a colored set of ASCII statusbars to the specified destination\n\n" .
		"Use with a zephyr command line, e.g. :zstatus -c nelhage -i status"
	});

BarnOwl::new_command(zbars => \&cmd_zbars, {
		summary => "Zephyr an arbitrary personal status dashboard",
		usage   => "zbars [--r2g|--rainbow|--g2r256|...] [--gradient] [zephyr command-line]",
	});

sub main_loop {
	if($next) {
		$next->();
		undef $next;
	}
}

$BarnOwl::Hooks::mainLoop->add(\&main_loop);

1;