X-Git-Url: http://git.shiar.nl/barcat.git/blobdiff_plain/1c54c0c39802740c0a5da001199f669497045a30..e1677f5ff98c942aa9758da02b7d4336b3dfe46b:/barcat

diff --git a/barcat b/barcat
index b3d9ce9..bf38f12 100755
--- a/barcat
+++ b/barcat
@@ -90,6 +90,7 @@ GetOptions(\%opt,
 		};
 	},
 	'stat|s!',
+	'report=s',
 	'signal-stat=s',
 	'unmodified|u!',
 	'width|w=i',
@@ -115,13 +116,18 @@ $opt{width} ||= $ENV{COLUMNS} || qx(tput cols) || 80 unless $opt{spark};
 $opt{color} //= $ENV{NO_COLOR} ? 0 : -t *STDOUT;  # enable on tty
 $opt{'graph-format'} //= '-';
 $opt{trim}   *= $opt{width} / 100 if $opt{trimpct};
-$opt{units}   = [split //, ' kMGTPEZYyzafpn'.($opt{ascii} ? 'u' : 'μ').'m']
+$opt{units}   = [split //, ' kMGTPEZYRQqryzafpn'.($opt{ascii} ? 'u' : 'μ').'m']
 	if $opt{'human-readable'};
 $opt{anchor} //= qr/\A/;
 $opt{'value-length'} = 4 if $opt{units};
 $opt{'value-length'} = 1 if $opt{unmodified};
 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
 $opt{markers} //= '=avg >31.73v <68.27v +50v |0';
+$opt{report} //= join(', ',
+	'${min; color(31)} min',
+	'${avg; $opt{reformat} or $_ = sprintf "%0.2f", $_; color(36)} avg',
+	'${max; color(32)} max',
+);
 $opt{palette} //= $opt{color} && [31, 90, 32];
 $opt{indicators} = [split //, $opt{indicators} ||
 	($opt{ascii} ? ' .oO' : $opt{spark} ? ' ▁▂▃▄▅▆▇█' : ' ▏▎▍▌▋▊▉█')
@@ -174,9 +180,8 @@ if (defined $opt{interval}) {
 	} or warn $@, "Expect slowdown with large datasets!\n";
 }
 
-my $valmatch = qr<
-	$opt{anchor} ( \h* -? [0-9]* [.]? [0-9]+ (?: e[+-]?[0-9]+ )? |)
->x;
+my $float = qr<[0-9]* [.]? [0-9]+ (?: e[+-]?[0-9]+ )?>; # positive numberish
+my $valmatch = qr< $opt{anchor} ( \h* -? $float |) >x;
 while (defined ($_ = $opt{input} ? shift @{ $opt{input} } : readline)) {
 	s/\r?\n\z//;
 	s/\A\h*// unless $opt{unmodified};
@@ -231,19 +236,19 @@ my $maxval = $opt{maxval} // (
 ) // 0;
 my $minval = $opt{minval} // min $order[-1] // (), 0;
 my $range = $maxval - $minval;
-$range &&= log $maxval if $opt{log};
+$range &&= log $range if $opt{log};
 my $lenval = $opt{'value-length'} // max map { length } @order;
 my $len    = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
-	max map { length $values[$_] && length $lines[$_] }
-		0 .. min $#lines, $opt{hidemax} || ();  # left padding
+	max(map { length $values[$_] && length $lines[$_] } $nr .. $limit)
+	// 0;  # left padding
 my $size   = defined $opt{width} && $range &&
-	($opt{width} - $lenval - $len - !!$opt{indicators}) / $range;  # bar multiplication
+	($opt{width} - $lenval - $len - !!$opt{indicators});  # bar multiplication
 
 my @barmark;
 if ($opt{markers} and $size > 0) {
 	for my $markspec (split /\h/, $opt{markers}) {
 		my ($char, $func) = split //, $markspec, 2;
-		my $pos = eval {
+		my @pos = eval {
 			if ($func eq 'avg') {
 				return sum(@order) / @order;
 			}
@@ -257,18 +262,28 @@ if ($opt{markers} and $size > 0) {
 			elsif ($func =~ /\A-?[0-9.]+\z/) {
 				return $func;
 			}
+			elsif ($func =~ /\A\/($float)\z/) {
+				my @range = my $multiple = my $next = $1;
+				while ($next < $maxval) {
+					$multiple *= 10 if $opt{log};
+					push @range, $next += $multiple;
+				}
+				return @range;
+			}
 			else {
 				die "Unknown marker $char: $func\n";
 			}
 		};
-		defined $pos or do {
+		@pos or do {
 			warn $@ if $@;
 			next;
 		};
-		$pos -= $minval;
-		$pos &&= log $pos if $opt{log};
-		$pos >= 0 or next;
-		color(36) for $barmark[$pos * $size] = $char;
+		for my $pos (@pos) {
+			$pos -= $minval;
+			$pos &&= log $pos if $opt{log};
+			$pos >= 0 or next;
+			color(36) for $barmark[$pos / $range * $size] = $char;
+		}
 	}
 
 	state $lastmax = $maxval;
@@ -276,10 +291,10 @@ if ($opt{markers} and $size > 0) {
 		print ' ' x ($lenval + $len);
 		printf color(90);
 		printf '%-*s',
-			($lastmax - $minval) * $size + .5,
-			'-' x (($values[$nr - 1] - $minval) * $size);
+			($lastmax - $minval) * $size / $range + .5,
+			'-' x (($values[$nr - 1] - $minval) * $size / $range);
 		print color(92);
-		say '+' x (($range - $lastmax) * $size + .5);
+		say '+' x (($range - $lastmax) * $size / $range + .5);
 		print color(0);
 		$lastmax = $maxval;
 	}
@@ -288,14 +303,19 @@ if ($opt{markers} and $size > 0) {
 say(
 	color(31), sprintf('%*s', $lenval, $minval),
 	color(90), '-', color(36), '+',
-	color(32), sprintf('%*s', $size * $range - 3, $maxval),
+	color(32), sprintf('%*s', $size - 3, $maxval),
 	color(90), '-', color(36), '+',
 	color(0),
 ) if $opt{header};
 
 while ($nr <= $limit) {
 	my $val = $values[$nr];
-	my $rel = length $val && $range && min(1, ($val - $minval) / $range);
+	my $rel;
+	if (length $val) {
+		$rel = $val - $minval;
+		$rel &&= log $rel if $opt{log};
+		$rel = min(1, $rel / $range) if $range; # 0..1
+	}
 	my $color = !length $val || !$opt{palette} ? undef :
 		$val == $order[0] ? $opt{palette}->[-1] : # max
 		$val == $order[-1] ? $opt{palette}->[0] : # min
@@ -326,10 +346,10 @@ while ($nr <= $limit) {
 		next;
 	}
 	printf '%-*s', $len + length($val), $line;
-	my $barlen = $values[$nr] || 0;
-	$barlen &&= log $barlen if $opt{log};
-	print $barmark[$_] // $opt{'graph-format'}
-		for 1 .. $size && ($barlen - $minval) * $size + .5;
+	if ($rel and $size) {
+		print $barmark[$_] // $opt{'graph-format'}
+			for 1 .. $rel * $size + .5;
+	}
 	say '';
 }
 continue {
@@ -348,25 +368,51 @@ sub show_stat {
 			$linemin += @lines;
 			$linemax = @lines - $linemax;
 		}
-		printf '%.8g of ', $opt{'value-format'}->(
-			sum(grep {length} @values[$linemin .. $linemax]) // 0
-		);
+		print varfmt('${sum+} of ', {
+			lines => $linemax - $linemin + 1,
+			sum => sum(0, grep {length} @values[$linemin .. $linemax]),
+		});
 	}
 	if (@order) {
 		my $total = sum @order;
-		printf '%s total', color(1) . $opt{'value-format'}->($total) . color(0);
-		printf ' in %d values', scalar @order;
-		printf ' over %d lines', scalar @lines if @order != @lines;
-		printf(' (%s min, %s avg, %s max)',
-			color(31) . ($opt{reformat} ? $opt{'value-format'} : sub {$_[0]})->($order[-1]) . color(0),
-			color(36) . ($opt{reformat} ? $opt{'value-format'} : $opt{'calc-format'})->($total / @order) . color(0),
-			color(32) . ($opt{reformat} ? $opt{'value-format'} : sub {$_[0]})->($order[0]) . color(0),
-		);
+		my $fmt = '${sum+;color(1)} total in ${count#} values';
+		$fmt .= ' over ${lines#} lines' if @order != @lines;
+		$fmt .= " ($_)" for $opt{report} || ();
+		print varfmt($fmt, {
+			sum => $total,
+			count => int @order,
+			lines => int @lines,
+			min => $order[-1],
+			max => $order[0],
+			avg => $total / @order,
+		});
 	}
 	say '';
 	return 1;
 }
 
+sub varfmt {
+	my ($fmt, $vars) = @_;
+	$fmt =~ s[\$\{ \h*+ ((?: [^{}]++ | \{(?1)\} )+) \}]{
+		my ($name, $cmd) = split /\s*;/, $1, 2;
+		my $format = $name =~ s/\+// || $name !~ s/\#// && $opt{reformat};
+		local $_ = $vars->{$name};
+		if (defined) {
+			$_ = $opt{'value-format'}->($_) if $format;
+			if ($cmd) {
+				eval $cmd;
+				warn "Error in \$$name report: $@" if $@;
+			}
+			$_;
+		}
+		else {
+			warn "Unknown variable \$$name in report\n";
+			"\$$name";
+		}
+	}eg;
+	return $fmt;
+}
+
 sub show_exit {
 	show_lines();
 	show_stat() if $opt{stat};
@@ -529,7 +575,12 @@ A single indicator glyph precedes each position:
 Exact value to match on the axis.
 A vertical bar at the zero crossing is displayed by I<|0>
 for negative values.
-For example I<:3.14> would show a colon at pi.
+For example I<π3.14> would locate pi.
+
+=item I</><interval>
+
+Repeated at every multiple of a number.
+For example I<:/1> for a grid at every integer.
 
 =item <percentage>I<v>
 
@@ -704,7 +755,7 @@ Total population history in XML from the World Bank:
 
     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
     xmlstarlet sel -t -m '*/*' -v wb:date -o ' ' -v wb:value -n |
-    barcat -f1 -H
+    barcat -f1 -H --markers=+/1e9
 
 Population and other information for all countries: