4 title => ($Request ? 'terminal colour' : 'colour palettes') . ' cheat sheet',
6 description => [!$Request ? "Comparison of various colour palettes." : (
7 "Index of all terminal/console colour codes,",
8 "with an example result of various environments.",
11 color colour code terminal console escape table xterm rxvt
12 ansi vt100 8bit 4bit cga ega vga rgb hsv game emulator display
14 data => ['termcol.inc.pl'],
15 stylesheet => [qw'light dark'],
18 my @draw = map { [$_, s/\W+\z//] } grep { $_ } split m(/),
19 $get{img} // exists $get{img} && 'indi.png';
22 push @termlist, split /\W+/, $Request || 'default';
24 say "<h1>$_</h1>\n" for $Request ? 'Colour palettes' : 'Terminal colours';
27 if ("@termlist" eq 'default') {
28 say '<span title="ECMA-48">ANSI</span> (VT100, ISO-6429) 16-colour text palette';
29 say 'as implemented by various systems and programs.';
30 say 'Also see <a href="/termcol/legacy">8-bit legacy hardware</a> palettes.';
32 elsif ("@termlist" eq 'legacy') {
33 say 'Colour palettes of various 8-bit legacy systems and retro games.';
34 say 'Also see <a href="/termcol">ANSI console</a> palettes.';
37 say 'Comparison of requested colour palettes.';
43 use Shiar_Sheet::Colour 1.04;
44 use List::Util qw( min max );
47 my $palettes = do 'termcol.inc.pl';
48 die "Cannot open palette data: $_\n" for $@ || $! || ();
49 my $more = do 'termcol-xcolor.inc.pl' || {};
50 $palettes = {%$palettes, %$more};
53 my $name = shift // return "<td>\n";
54 my $col = Shiar_Sheet::Colour->new(@_);
55 my $minhex = $col->rgb24;
56 my $css = '#' . $col->rgb48;
57 my $inverse = '#' . sprintf('%X', $col->luminance/255 < .3 ? 12 : 0) x 3;
59 my $sample = [ qw(#000 #FFF) ];
60 ($name, $sample) = @$name if ref $name eq 'ARRAY';
62 my $out = sprintf('<td title="%s" style="%s">%s',
63 join(',', map { int } @$col),
64 "background:$css; color:$inverse",
67 $out .= sprintf('<samp style="%s"><small>%s</small></samp>',
68 "background:$_; color:$css", $minhex
74 my ($palette, $imgfile, $reindex) = @_;
79 my @imgpal = map { Imager::Color->new(ref $_ ? @$_ : $_) } @{$palette};
81 my $img = $imgcache->{$imgfile}
82 //= Imager->new(file => "data/palimage/$imgfile")
83 or die Imager->errstr.$/;
88 make_colors => 'none',
90 translate => 'closest',
94 @{[ $img->getcolors ]} == @imgpal
95 or die "incompatible palette size\n";
96 $img->setcolors(colors => \@imgpal);
99 }->write(data => \my $imgdata, type => 'png');
100 return sprintf '<img src="data:image/png;base64,%s">',
101 MIME::Base64::encode_base64($imgdata);
107 my $info = $palettes->{$term};
109 if (ref $info eq 'ARRAY') {
110 coltable($_) for @{$info};
113 ref $info eq 'HASH' or return;
115 my $caption = $info->{name} // $term;
116 $caption = sprintf('<%s %s>%s</%1$s>',
117 $info->{href} ? 'a' : 'span',
119 map { sprintf '%s="%s"', $_, $info->{$_} }
120 grep { defined $info->{$_} }
124 ) if $info->{href} or $info->{title};
126 if (my $mapinfo = $info->{rgbmap}) {
127 say '<table class="color mapped">';
128 say sprintf '<caption>%s</caption>', $caption;
129 print coltable_hsv(@{$mapinfo});
133 if (my $table = $info->{table}) {
134 say '<table class="color mapped">';
135 say sprintf '<caption>%s</caption>', $caption;
136 for my $row (@$table) {
142 print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row;
146 my $width = scalar @{ $table->[0] };
148 [ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ]
149 } map { @{$_} } @{$table};
151 print "<tr><td colspan=$width>", img_egapal(\@imgpal, @{$_});
157 if (my $palette = $info->{list}) {
158 my $order = $get{order} && $get{order}.'order';
159 my $colours = colorder($palette,
160 $info->{$order} // $palettes->{ $info->{parent} }->{$order}
164 my $columns = ceil(@{$palette} / $rows);
166 say '<table class=color>';
167 say sprintf '<caption>%s</caption>', $caption;
168 for my $row (0 .. $rows - 1) {
170 for my $col (0 .. $columns - 1) {
171 my $num = $row + $col * $rows;
172 my ($rgb, $name) = split /:/, $colours->[$num], 3;
173 $name //= $rgb && $num;
174 $name = [ $name, [] ] if $term =~ /^msx/ and !$num;
175 $name = [ $name, ['#333'] ] if $term eq 'xkcd';
176 print colcell($name, $rgb);
181 my $imgpal = colorder($palette,
182 $info->{ansiorder} // $palettes->{ $info->{parent} }->{ansiorder}
184 print "<tr><td colspan=$columns>", img_egapal($imgpal, @{$_});
191 my ($palette, $reorder) = @_;
192 return [ map { $palette->[$_] =~ s/:(?![^:])|$/:$_/r } @{$reorder} ]
198 my ($dim, $rgbval, $greyramp) = @_;
200 my $hmax = 2 * $dim * 3; # each face of the rgb cube
203 $rgbval ||= sub { join('', @_), map { int $_ * 255 / $vmax } @_ };
205 my @greymap = @{$greyramp || []}; # [name, r, g=l, b]
206 my @colmap; # saturation => value => hue => [name, r,g,b]
208 for my $r (0 .. $dim - 1) {
209 for my $g (0 .. $dim - 1) {
210 for my $b (0 .. $dim - 1) {
211 my @rgb = ($r, $g, $b);
213 my ($h, $s, $v) = Shiar_Sheet::Colour->new(@rgb)->hsv;
217 push @greymap, [ $rgbval->(@rgb) ];
221 $h = 1; # greyscale hue
222 $s = $smax - $v + 1; # spread brightness over saturation groups
223 $v &&= $smax # highest saturation
224 or $v = $s = 1; # black at initial column
229 $s = $smax - $s - $v;
231 $colmap[$s][$v][$h] = [ $rgbval->(@rgb) ];
237 $out .= sprintf '<colgroup span=%d>', scalar @{$_} for @colmap;
238 my $huerow = $colmap[0][0]; # first {$_} map { @{$_} } @colmap;
239 for my $h (grep { $huerow->[$_] } 0 .. $#{$huerow}) {
241 $out .= colcell(@$_) for map { $_->[$h] } map { reverse @{$_} } @colmap;
247 my $colbreak = scalar map { @$_ } @colmap; # same width as hue rows
248 for my $cell (sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } @greymap) {
249 $out .= '<tr>' unless $col++ % $colbreak;
250 $out .= colcell(@{$cell});
255 my @palette = map { [ @{$_}[1 .. 3] ] } @greymap, map {@$_} map {@$_} @colmap;
256 my $tablespan = scalar map { @$_ } @colmap;
257 my $imgdata = img_egapal(\@palette, @{ $draw[0] });
258 $out .= "<tr><td colspan=$tablespan>$imgdata";
264 coltable($_) for @termlist;