# This somehow goes in ~/.owl/modules/ZStatus/lib/BarnOwl/Module.
# Run :reload-module ZStatus after hacking.
# Don't be a dumb typo-maker like me and run :reload-modules and get confused.
use warnings;
use strict;
use utf8;

=head1 NAME

BarnOwl::Module::ZStatus

=head1 DESCRIPTION

I didn't write this. --?
Me neither. --bpchen (2015/10/12--15)
(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.3.1.3; # I don't actually know what this does *shrugs*

# 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 $default_instance = 'zstatus';
my $default_max = 10;
# status components {{{
my $default_header = '[Zephyr status dashboard]';
my $default_char = '█';
my $default_prefix = '[';
my $default_suffix = ']';
my $default_overflow= '▒';
my $barlimitchar = '∞';
my $limit = 128;
# }}}
# color schemes {{{
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,
	'--good' => \@redtogreen,
	'--rainbow' => \@rainbow,
	'--rbw' => \@rainbow,
	'--g2r256' => \@greentored256,
	'--r2g256' => \@redtogreen256,
	'--rainbow256' => \@rainbow256,
	'--rbw256' => \@rainbow256,
);
my $defaultscheme = \@greentored;
# }}}
# string-handling utilities: trim, parse_slash {{{
sub trim {
	$_ = shift;
	s/^\s+//;
	s/\s+$//;
	return $_;
}
sub parse_slash {
	$_ = shift;
	if (m(/)) {
		return split '/', $_, 2;
	} else {
		return ($_, BarnOwl::getvar('zstatus:max'));
	}
}
# }}}
# formatting, bar-coloring utilities {{{
sub get_header {
	my $message = BarnOwl::getvar('zstatus:header');
	if ($message eq '') {
		return '';
	} else {
		return "$message\n";
	}
}

sub colorize {
	$_ = shift;
	s/@/@@/g;

	my $frac = shift;
	my $scheme = shift;
	my $index = ceil($frac * @$scheme) - 1;
	if ($index < 0) { $index = 0; }
	if ($index > $#$scheme) { $index = $#$scheme; }
	my $color = $scheme->[$index];

	if (!/\}/) {
		return '@{@color{' . $color . "}$_}";
	} elsif (!/>/) {
		return '@<@color<' . $color . ">$_>";
	} elsif (!/\]/) {
		return '@[@color[' . $color . "]$_]";
	} else { # give up
		return '@(@color(' . $color . ")$_)";
	}
}

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 format_bar {
	my ($label, $num, $maxnum, $scheme, $gradient) = @_;
	if (!defined($scheme)) { $scheme = $defaultscheme; }

	my $frac = $maxnum == 0 ? 0.5 : $num / $maxnum;
	my $dnum = $num;

	my $bar = "$label " . BarnOwl::getvar('zstatus:prefix');
	my $baroverflowchar = BarnOwl::getvar('zstatus:overflow');
	if ($baroverflowchar eq '') {
		$baroverflowchar = $default_overflow;
	} else {
		$baroverflowchar = substr($baroverflowchar, 0, 1);
	}
	if ($num < 0) {
		# Weird overflow condition that should not happen if you use this like
		# a normal person.
		# But you can't help that. We're all mad here.
		$frac = 0;
		if ($num < -length($bar)) {
			$bar = colorize($barlimitchar . ($baroverflowchar x (length($bar)-1)), $frac, $scheme);
		} else {
			# perl is so weird that you can do this
			substr($bar, length($bar) + $num) = colorize($baroverflowchar x -$num, $frac, $scheme);
		}
		$num = 0;
	}

	my $suffix = BarnOwl::getvar('zstatus:suffix');
	if ($num > $maxnum) {
		# Weird overflow condition part deux.
		$frac = 1;
		my $excess = $num - $maxnum;
		if ($excess > $limit) {
			$suffix = colorize($baroverflowchar x $limit . $barlimitchar, $frac, $scheme);
		} else {
			substr($suffix, 0, $excess) = colorize($baroverflowchar x $excess, $frac, $scheme);
		}
		$num = $maxnum;
	}

	# by the time we get here we should have 0 <= $num <= $maxnum
	my $barchar = BarnOwl::getvar('zstatus:char');
	if ($barchar eq '') {
		$barchar = $default_char;
	} else {
		$barchar = substr($barchar, 0, 1);
	}
	if ($gradient) {
		$bar .= make_gradient($barchar, $num, $maxnum, $scheme) . " " x ($maxnum - $num);
	} else {
		$bar .= colorize(($barchar x $num) . (" " x ($maxnum - $num)), $frac, $scheme);
	}
	$bar .= $suffix;
	$bar .= colorize(" ($dnum/$maxnum)", $frac, $scheme);
	$bar .= "\n";
	return $bar;
}
# }}}
# utility for passing arguments to zwrite {{{
sub pack_or_default_args {
	if (@_) {
		return (BarnOwl::quote(@_), '');
	} else {
		my $args = BarnOwl::quote(
			'-c',
			BarnOwl::getvar('zstatus:class'),
			'-i',
			BarnOwl::getvar('zstatus:instance')
		);
		return ($args, "(Assuming $args)\n");
	}
}
# }}}
# cmd_zstatus and helper {{{
sub cmd_zstatus {
	my $cmd = shift;
	my $scheme = $defaultscheme;
	my $gradient = (BarnOwl::getvar('zstatus:gradient') eq 'on');
	if ($schemehash{$_[0]}) {
		$scheme = $schemehash{$_[0]};
		shift;
	}
	if ($_[0] eq '--grad' || $_[0] eq '--gradient') {
		$gradient = 1;
		shift;
	}
	if ($_[0] eq '--no-grad' || $_[0] eq '--no-gradient') {
		$gradient = '';
		shift;
	}
	my ($args, $msg) = pack_or_default_args(@_);
	query_and_write($msg, \@defaultqueries, \@defaultlabels, 0, $scheme, $gradient, $args);
}

sub query_and_write {
	my $msg = shift;
	my $queries = shift;
	my $labels = shift;
	my $curindex = shift;
	my $scheme = shift;
	my $gradient = shift;
	if ($curindex < @$queries) {
		my @pass = @_;
		my $maxnum = BarnOwl::getvar('zstatus:max');
		BarnOwl::start_question("$msg$queries->[$curindex] [0-$maxnum]? ",
			sub { query_and_write($msg, $queries, $labels, $curindex + 1, $scheme, $gradient, @pass, @_); }
		);
	} else {
		my $args = shift;
		my $message = get_header();
		foreach (0..$#_) {
			$message .= format_bar($labels->[$_], parse_slash(trim($_[$_])), $scheme, $gradient);
		}
		BarnOwl::zephyr_zwrite($args, $message);
	}
}
# }}}
# cmd_zbars and helper {{{
sub cmd_zbars {
	my $cmd = shift;
	my $scheme = $defaultscheme;
	my $gradient = (BarnOwl::getvar('zstatus:gradient') eq 'on');
	if ($schemehash{$_[0]}) {
		$scheme = $schemehash{$_[0]};
		shift;
	}
	if ($_[0] eq '--gg') {
		$scheme = \@redtogreen;
		$gradient = 1;
		shift;
	} elsif ($schemehash{$_[0]}) {
		$scheme = $schemehash{$_[0]};
		shift;
	}
	if ($_[0] eq '--grad' || $_[0] eq '--gradient') {
		$gradient = 1;
		shift;
	}
	if ($_[0] eq '--no-grad' || $_[0] eq '--no-gradient') {
		$gradient = '';
		shift;
	}
	my ($args, $msg) = pack_or_default_args(@_);
	BarnOwl::start_question("${msg}foo=1;bar=2/3;..? ", sub {got_data($args, @_, $scheme, $gradient)});
}

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

	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);
}
# }}}
# hooking into BarnOwl {{{
# declaring BarnOwl variables {{{
BarnOwl::new_variable_string('zstatus:class', {
		default => $ENV{USER}, # ??? copied from Twitter module
		summary => "Default class that zstatus sends messages to",
		description => "Default class that zstatus sends messages to"
	});
BarnOwl::new_variable_string('zstatus:instance', {
		default => $default_instance,
		summary => "Default instance that zstatus sends messages to",
		description => "Default instance that zstatus sends messages to"
	});
BarnOwl::new_variable_string('zstatus:header', {
		default => $default_header,
		summary => "Header for zstatus zephyrs",
		description => "Header for zstatus zephyrs"
	});
BarnOwl::new_variable_string('zstatus:char', {
		default => $default_char,
		summary => "Character for filling zstatus bars",
		description => "Character for filling zstatus bars"
	});
BarnOwl::new_variable_string('zstatus:prefix', {
		default => $default_prefix,
		summary => "String at start of zstatus bars",
		description => "String at start of zstatus bars"
	});
BarnOwl::new_variable_string('zstatus:suffix', {
		default => $default_suffix,
		summary => "String at end of zstatus bars",
		description => "String at end of zstatus bars"
	});
BarnOwl::new_variable_string('zstatus:overflow', {
		default => $default_overflow,
		summary => "Character for over/underflowing status bars",
		description => "Character for over/underflowing status bars"
	});
BarnOwl::new_variable_int('zstatus:max', {
		default => $default_max,
		summary => "Default length of bars or denominator of stats",
		description => "Default length of bars or denominator of stats"
	});
BarnOwl::new_variable_bool('zstatus:gradient', {
		default => 'off',
		summary => "Whether zstatus uses a gradient by default",
		description => "Whether zstatus uses a gradient by default"
	});
sub reset_format_variables {
	BarnOwl::set('zstatus:header', $default_header);
	BarnOwl::set('zstatus:char', $default_char);
	BarnOwl::set('zstatus:prefix', $default_prefix);
	BarnOwl::set('zstatus:suffix', $default_suffix);
	BarnOwl::set('zstatus:overflow', $default_overflow);
	BarnOwl::set('zstatus:gradient', 'off');
}
sub reset_zephyr_variables {
	BarnOwl::set('zstatus:class', $ENV{USER});
	BarnOwl::set('zstatus:instance', $default_instance);
}
sub reset_variables {
	reset_format_variables();
	reset_zephyr_variables();
	BarnOwl::set('zstatus:max', 10);
}
# }}}
# declaring BarnOwl commands {{{
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]",
	});

BarnOwl::new_command('zstatus:reset-format' => \&reset_format_variables, {
		summary => "Reset zstatus variables related to formatting",
		description => "Reset zstatus variables related to formatting",
		usage   => "zstatus:reset-format",
	});

BarnOwl::new_command('zstatus:reset-zephyr' => \&reset_zephyr_variables, {
		summary => "Reset where zstatus sends zephyrs by default",
		description => "Reset where zstatus sends zephyrs by default",
		usage   => "zstatus:reset-zephyr",
	});

BarnOwl::new_command('zstatus:reset' => \&reset_variables, {
		summary => "Reset all zstatus variables",
		description => "Reset all zstatus variables",
		usage   => "zstatus:reset",
	});
# }}}
# }}}
1;
# vim:set fdm=marker: