Source of termcol.plp

<(common.inc.plp)><:

Html({
	title => 'terminal colour cheat sheet',
	version => '1.1',
	description => [
		"Index of all terminal/console colour codes,",
		"with an example result of various environments.",
	],
	keywords => [qw'
		color code terminal console escape table xterm rxvt
	'],
	data => ['termcol.inc.pl'],
	stylesheet => [qw'light dark'],
});

my @draw = map { [$_, s/\W+\z//] } grep { $_ } split m(/),
	$get{img} // exists $get{img} && 'indi.png';

my @termlist;
push @termlist, split /\W+/, $ENV{PATH_INFO} || 'default';

:>
<h1>Terminal colours</h1>

<p>
<span title="ECMA-48">ANSI</span> (VT100, ISO-6429) 16-colour text palette
as implemented by various systems and programs.
<:
print
	"@termlist" ne 'default' ? 'Additional palettes are included as specified.' :
	'Also see <a href="/termcol/more">8-bit legacy hardware</a> palettes.';
:>
</p>

<div class="section">
<:
use 5.010;
use Shiar_Sheet::Colour 1.04;
use List::Util qw( min max );
use POSIX qw( ceil );

my $palettes = do 'termcol.inc.pl';
die "Cannot open palette data: $_\n" for $@ || $! || ();
my $more = do 'termcol-xcolor.inc.pl' || {};
$palettes = {%$palettes, %$more};

sub colcell {
	my $name = shift // return "<td>\n";
	my $col = Shiar_Sheet::Colour->new(@_);
	my $minhex = $col->rgb24;
	my $css     = '#' . $col->rgb48;
	my $inverse = '#' . sprintf('%X', $col->luminance/255 < .3 ? 12 : 0) x 3;

	my $sample = [ qw(#000 #FFF) ];
	($name, $sample) = @$name if ref $name eq 'ARRAY';

	my $out = sprintf('<td title="%s" style="%s">%s',
		join(',', map { int } @$col),
		"background:$css; color:$inverse",
		$name,
	);
	$out .= sprintf('<samp style="%s"><small>%s</small></samp>',
		"background:$_; color:$css", $minhex
	) for @$sample;
	return "$out\n";
}

sub img_egapal {
	my ($palette, $imgfile, $reindex) = @_;
	return eval {
		require Imager;
		require MIME::Base64;

		my @imgpal = map { Imager::Color->new(ref $_ ? @$_ : $_) } @{$palette};
		state $imgcache = {};
		my $img = $imgcache->{$imgfile}
			//= Imager->new(file => "data/palimage/$imgfile")
			or die Imager->errstr.$/;

		do {
			if ($reindex) {
				$img->to_paletted({
					make_colors => 'none',
					colors => \@imgpal,
					translate => 'closest',
				});
			}
			else {
				@{[ $img->getcolors ]} == @imgpal
					or die "incompatible palette size\n";
				$img->setcolors(colors => \@imgpal);
				$img;
			}
		}->write(data => \my $imgdata, type => 'png');
		return sprintf '<img src="data:image/png;base64,%s">',
			MIME::Base64::encode_base64($imgdata);
	} || $@;
}

sub coltable {
	my ($term) = @_;
	my $info = $palettes->{$term};

	if (ref $info eq 'ARRAY') {
		coltable($_) for @{$info};
	}

	ref $info eq 'HASH' or next;

	my $caption = $info->{name} // $term;
	$caption = sprintf('<%s %s>%s</%1$s>',
		$info->{href} ? 'a' : 'span',
		join(' ',
			map { sprintf '%s="%s"', $_, $info->{$_} }
			grep { defined $info->{$_} }
			qw( href title )
		),
		$caption,
	) if $info->{href} or $info->{title};

	if (my $mapinfo = $info->{rgbmap}) {
		print '<table class="color mapped">'."\n";
		printf "<caption>%s</caption>\n", $caption;
		print coltable_hsv(@{$mapinfo});
		print "</table>\n\n";
	}

	if (my $table = $info->{table}) {
		print '<table class="color mapped">'."\n";
		printf "<caption>%s</caption>\n", $caption;
		for my $row (@$table) {
			print '<tr>';
			print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row;
		}

	if (@draw) {
		my $width = scalar @{ $table->[0] };
		my @imgpal = map {
			[ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ]
		} map { @{$_} } @{$table};
		for (@draw) {
			print "<tr><td colspan=$width>", img_egapal(\@imgpal, @{$_});
		}
	}
		print "</table>\n\n";
	}

	if (my $palette = $info->{list}) {
		my $order = $get{order} && $get{order}.'order';
		my $colours = colorder($palette,
			$info->{$order} // $palettes->{ $info->{parent} }->{$order}
		);

		my $rows = 8;
		my $columns = ceil(@{$palette} / $rows);

		print '<table class=color>', "\n";
		printf "<caption>%s</caption>\n", $caption;
		for my $row (0 .. $rows - 1) {
			print '<tr>';
			for my $col (0 .. $columns - 1) {
				my $num = $row + $col * $rows;
				my ($rgb, $name) = split /:/, $colours->[$num], 3;
				$name //= $rgb && $num;
				$name = [ $name, [] ] if $term =~ /^msx/ and !$num;
				$name = [ $name, ['#333'] ] if $term eq 'xkcd';
				print colcell($name, $rgb);
			}
		}

		for (@draw) {
			my $imgpal = colorder($palette,
				$info->{ansiorder} // $palettes->{ $info->{parent} }->{ansiorder}
			);
			print "<tr><td colspan=$columns>", img_egapal($imgpal, @{$_});
		}
		print "</table>\n\n";
	}
}

sub colorder {
	my ($palette, $reorder) = @_;
	return [ map { $palette->[$_] =~ s/:(?![^:])|$/:$_/r } @{$reorder} ]
		if $reorder;
	return $palette;
}

sub coltable_hsv {
	my ($dim, $rgbval, $greyramp) = @_;

	my $hmax = 2 * $dim * 3;  # each face of the rgb cube
	my $vmax = $dim - 1;
	my $smax = $dim - 1;
	$rgbval ||= sub { join('', @_), map { int $_ * 255 / $vmax } @_ };

	my @greymap = @{$greyramp || []};  # [name, r, g=l, b]
	my @colmap;  # saturation => value => hue => [name, r,g,b]

	for my $r (0 .. $dim - 1) {
		for my $g (0 .. $dim - 1) {
			for my $b (0 .. $dim - 1) {
				my @rgb = ($r, $g, $b);

				my ($h, $s, $v) = Shiar_Sheet::Colour->new(@rgb)->hsv;

				if (!$s) {
					if (@greymap) {
						push @greymap, [ $rgbval->(@rgb) ];
						next;
					}

					$h = 1;  # greyscale hue
					$s = $smax - $v + 1;  # spread brightness over saturation groups
					$v &&= $smax  # highest saturation
						or $v = $s = 1;  # black at initial column
				}

				$h *= $hmax;
				$v = $vmax - $v;
				$s = $smax - $s - $v;

				$colmap[$s][$v][$h] = [ $rgbval->(@rgb) ];
			}
		}
	}

	my $out = '';
	$out .= sprintf '<colgroup span=%d>', scalar @{$_} for @colmap;
	my $huerow = $colmap[0][0]; # first {$_} map { @{$_} } @colmap;
	for my $h (grep { $huerow->[$_] } 0 .. $#{$huerow}) {
		$out .= '<tr>';
		$out .= colcell(@$_) for map { $_->[$h] } map { reverse @{$_} } @colmap;
	}

	if (@greymap) {
		$out .= '<tbody>';
		my $col = 0;
		my $colbreak = scalar map { @$_ } @colmap;  # same width as hue rows
		for my $cell (sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } @greymap) {
			$out .= '<tr>' unless $col++ % $colbreak;
			$out .= colcell(@{$cell});
		}
	}

	if (@draw) {
		my @palette = map { [ @{$_}[1 .. 3] ] } @greymap, map {@$_} map {@$_} @colmap;
		my $tablespan = scalar map { @$_ } @colmap;
		my $imgdata = img_egapal(\@palette, @{ $draw[0] });
		$out .= "<tr><td colspan=$tablespan>$imgdata";
	}

	return $out;
}

coltable($_) for @termlist;
:></div>
<hr>