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 = Data('termcol');
50 my $name = shift // return "<td>\n";
51 my $col = Shiar_Sheet::Colour->new(@_);
52 my $minhex = $col->rgb24;
53 my $css = '#' . $col->rgb48;
54 my $inverse = '#' . sprintf('%X', $col->luminance/255 < .3 ? 12 : 0) x 3;
56 my $sample = [ qw(#000 #FFF) ];
57 ($name, $sample) = @$name if ref $name eq 'ARRAY';
59 my $out = sprintf('<td title="%s" style="%s">%s',
60 join(',', map { int } @$col),
61 "background:$css; color:$inverse",
64 $out .= sprintf('<samp style="%s"><small>%s</small></samp>',
65 "background:$_; color:$css", $minhex
71 my ($palette, $imgfile, $reindex) = @_;
76 my @imgpal = map { Imager::Color->new(ref $_ ? @$_ : $_) } @{$palette};
78 my $img = $imgcache->{$imgfile}
79 //= Imager->new(file => "data/palimage/$imgfile")
80 or die Imager->errstr.$/;
85 make_colors => 'none',
87 translate => 'closest',
91 @{[ $img->getcolors ]} == @imgpal
92 or die "incompatible palette size\n";
93 $img->setcolors(colors => \@imgpal);
96 }->write(data => \my $imgdata, type => 'png');
97 return sprintf '<img src="data:image/png;base64,%s">',
98 MIME::Base64::encode_base64($imgdata);
104 my $info = $palettes->{$term};
106 if (ref $info eq 'ARRAY') {
107 coltable($_) for @{$info};
111 if (ref $info eq 'CODE') {
112 coltable($_) for $info->($palettes);
116 ref $info eq 'HASH' or return;
117 my $order = $get{order} && $get{order}.'order';
118 my $reorder = $info->{$order} // $palettes->{ $info->{parent} }->{$order};
120 my $caption = $info->{name} // $term;
121 $caption = sprintf('<%s %s>%s</%1$s>',
122 $info->{href} ? 'a' : 'span',
124 map { sprintf '%s="%s"', $_, $info->{$_} }
125 grep { defined $info->{$_} }
129 ) if $info->{href} or $info->{title};
131 if ($info->{table} or $info->{rgbmap}) {
132 say '<table class="color mapped">';
133 say sprintf '<caption>%s</caption>', $caption;
135 print coltable_hsv(@{$_}) for $info->{rgbmap} || ();
137 if (my $table = $info->{table}) {
138 $table = [ @{$table}[@{$reorder}] ] if $reorder;
140 for my $row (@$table) {
146 print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row;
150 my $width = scalar @{ $table->[0] };
152 [ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ]
153 } map { @{$_} } @{$table};
155 print "<tr><td colspan=$width>", img_egapal(\@imgpal, @{$_});
163 if (my $palette = $info->{list}) {
164 my $colours = colorder($palette, $reorder);
167 my $columns = ceil(@{$palette} / $rows);
169 say '<table class=color>';
170 say sprintf '<caption>%s</caption>', $caption;
171 for my $row (0 .. $rows - 1) {
173 for my $col (0 .. $columns - 1) {
174 my $num = $row + $col * $rows;
175 my ($rgb, $name) = split /:/, $colours->[$num], 3;
176 $name //= $rgb && $num;
177 $name = [ $name, [] ] if $term =~ /^msx/ and !$name; # no bg for transparency
178 $name = [ $name, ['#333'] ] if $term eq 'xkcd';
179 print colcell($name, $rgb);
184 my $imgpal = colorder($palette,
185 $info->{ansiorder} // $palettes->{ $info->{parent} }->{ansiorder}
187 print "<tr><td colspan=$columns>", img_egapal($imgpal, @{$_});
194 my ($palette, $reorder) = @_;
195 return [ map { $palette->[$_] =~ s/:(?![^:])|$/:$_/r } @{$reorder} ]
201 my ($dim, $rgbval, $greyramp) = @_;
203 my $hmax = 2 * $dim * 3; # each face of the rgb cube
206 $rgbval ||= sub { join('', @_), map { int $_ * 255 / $vmax } @_ };
208 my @greymap = @{$greyramp || []}; # [name, r, g=l, b]
209 my @colmap; # saturation => value => hue => [name, r,g,b]
211 for my $r (0 .. $dim - 1) {
212 for my $g (0 .. $dim - 1) {
213 for my $b (0 .. $dim - 1) {
214 my @rgb = ($r, $g, $b);
216 my ($h, $s, $v) = Shiar_Sheet::Colour->new(@rgb)->hsv;
220 push @greymap, [ $rgbval->(@rgb) ];
224 $h = 1; # greyscale hue
225 $s = $smax - $v + 1; # spread brightness over saturation groups
226 $v &&= $smax # highest saturation
227 or $v = $s = 1; # black at initial column
232 $s = $smax - $s - $v;
234 $colmap[$s][$v][$h] = [ $rgbval->(@rgb) ];
240 $out .= sprintf '<colgroup span=%d>', scalar @{$_} for @colmap;
241 my $huerow = $colmap[0][0]; # first {$_} map { @{$_} } @colmap;
242 for my $h (grep { $huerow->[$_] } 0 .. $#{$huerow}) {
244 $out .= colcell(@$_) for map { $_->[$h] } map { reverse @{$_} } @colmap;
250 my $colbreak = scalar map { @$_ } @colmap; # same width as hue rows
251 for my $cell (sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } @greymap) {
252 $out .= '<tr>' unless $col++ % $colbreak;
253 $out .= colcell(@{$cell});
258 my @palette = map { [ @{$_}[1 .. 3] ] } @greymap, map {@$_} map {@$_} @colmap;
259 my $tablespan = scalar map { @$_ } @colmap;
260 my $imgdata = img_egapal(\@palette, @{ $draw[0] });
261 $out .= "<tr><td colspan=$tablespan>$imgdata";
267 coltable($_) for @termlist;