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} && 'compile.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 Abort("Cannot open palette data", 501, $_) for $@ || $! || ();
51 my $name = shift // return "<td>\n";
52 my $col = Shiar_Sheet::Colour->new(@_);
53 my $minhex = $col->rgb24;
54 my $css = '#' . $col->rgb48;
55 my $inverse = '#' . sprintf('%X', $col->luminance/255 < .3 ? 12 : 0) x 3;
57 my $sample = [ qw(#000 #FFF) ];
58 ($name, $sample) = @$name if ref $name eq 'ARRAY';
60 my $out = sprintf('<td title="%s" style="%s">%s',
61 join(',', map { int } @$col),
62 "background:$css; color:$inverse",
65 $out .= sprintf('<samp style="%s"><small>%s</small></samp>',
66 "background:$_; color:$css", $minhex
72 my ($palette, $imgfile, $reindex) = @_;
77 my @imgpal = map { Imager::Color->new(ref $_ ? @$_ : $_) } @{$palette};
79 my $img = $imgcache->{$imgfile}
80 //= Imager->new(file => "data/palimage/$imgfile")
81 or die Imager->errstr.$/;
86 make_colors => 'none',
88 translate => 'closest',
92 @{[ $img->getcolors ]} == @imgpal
93 or die "incompatible palette size\n";
94 $img->setcolors(colors => \@imgpal);
97 }->write(data => \my $imgdata, type => 'png');
98 return sprintf '<img src="data:image/png;base64,%s">',
99 MIME::Base64::encode_base64($imgdata);
105 my $info = $palettes->{$term};
107 if (ref $info eq 'ARRAY') {
108 coltable($_) for @{$info};
112 if (ref $info eq 'CODE') {
113 coltable($_) for $info->($palettes);
117 ref $info eq 'HASH' or return;
118 my $order = $get{order} && $get{order}.'order';
119 my $reorder = $info->{$order} // $palettes->{ $info->{parent} }->{$order};
121 my $caption = $info->{name} // $term;
122 $caption = sprintf('<%s %s>%s</%1$s>',
123 $info->{href} ? 'a' : 'span',
125 map { sprintf '%s="%s"', $_, $info->{$_} }
126 grep { defined $info->{$_} }
130 ) if $info->{href} or $info->{title};
132 if ($info->{table} or $info->{rgbmap}) {
133 say '<table class="color mapped">';
134 say sprintf '<caption>%s</caption>', $caption;
136 print coltable_hsv(@{$_}) for $info->{rgbmap} || ();
138 if (my $table = $info->{table}) {
139 $table = [ @{$table}[@{$reorder}] ] if $reorder;
141 for my $row (@$table) {
147 print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row;
151 my $width = scalar @{ $table->[0] };
153 [ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ]
154 } map { @{$_} } @{$table};
156 print "<tr><td colspan=$width>", img_egapal(\@imgpal, @{$_});
164 if (my $palette = $info->{list}) {
165 my $colours = colorder($palette, $reorder);
168 my $columns = ceil(@{$palette} / $rows);
170 say '<table class=color>';
171 say sprintf '<caption>%s</caption>', $caption;
172 for my $row (0 .. $rows - 1) {
174 for my $col (0 .. $columns - 1) {
175 my $num = $row + $col * $rows;
176 my ($rgb, $name) = split /:/, $colours->[$num], 3;
177 $name //= $rgb && $num;
178 $name = [ $name, [] ] if $term =~ /^msx/ and !$name; # no bg for transparency
179 $name = [ $name, ['#333'] ] if $term eq 'xkcd';
180 print colcell($name, $rgb);
185 my $imgpal = colorder($palette,
186 $info->{ansiorder} // $palettes->{ $info->{parent} }->{ansiorder}
188 print "<tr><td colspan=$columns>", img_egapal($imgpal, @{$_});
195 my ($palette, $reorder) = @_;
196 return [ map { $palette->[$_] =~ s/:(?![^:])|$/:$_/r } @{$reorder} ]
202 my ($dim, $rgbval, $greyramp) = @_;
204 my $hmax = 2 * $dim * 3; # each face of the rgb cube
207 $rgbval ||= sub { join('', @_), map { int $_ * 255 / $vmax } @_ };
209 my @greymap = @{$greyramp || []}; # [name, r, g=l, b]
210 my @colmap; # saturation => value => hue => [name, r,g,b]
212 for my $r (0 .. $dim - 1) {
213 for my $g (0 .. $dim - 1) {
214 for my $b (0 .. $dim - 1) {
215 my @rgb = ($r, $g, $b);
217 my ($h, $s, $v) = Shiar_Sheet::Colour->new(@rgb)->hsv;
221 push @greymap, [ $rgbval->(@rgb) ];
225 $h = 1; # greyscale hue
226 $s = $smax - $v + 1; # spread brightness over saturation groups
227 $v &&= $smax # highest saturation
228 or $v = $s = 1; # black at initial column
233 $s = $smax - $s - $v;
235 $colmap[$s][$v][$h] = [ $rgbval->(@rgb) ];
241 $out .= sprintf '<colgroup span=%d>', scalar @{$_} for @colmap;
242 my $huerow = $colmap[0][0]; # first {$_} map { @{$_} } @colmap;
243 for my $h (grep { $huerow->[$_] } 0 .. $#{$huerow}) {
245 $out .= colcell(@$_) for map { $_->[$h] } map { reverse @{$_} } @colmap;
251 my $colbreak = scalar map { @$_ } @colmap; # same width as hue rows
252 for my $cell (sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } @greymap) {
253 $out .= '<tr>' unless $col++ % $colbreak;
254 $out .= colcell(@{$cell});
259 my @palette = map { [ @{$_}[1 .. 3] ] } @greymap, map {@$_} map {@$_} @colmap;
260 my $tablespan = scalar map { @$_ } @colmap;
261 my $imgdata = img_egapal(\@palette, @{ $draw[0] });
262 $out .= "<tr><td colspan=$tablespan>$imgdata";
268 coltable($_) for @termlist;