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 $@ || $! || ();
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;
119 my $caption = $info->{name} // $term;
120 $caption = sprintf('<%s %s>%s</%1$s>',
121 $info->{href} ? 'a' : 'span',
123 map { sprintf '%s="%s"', $_, $info->{$_} }
124 grep { defined $info->{$_} }
128 ) if $info->{href} or $info->{title};
130 if (my $mapinfo = $info->{rgbmap}) {
131 say '<table class="color mapped">';
132 say sprintf '<caption>%s</caption>', $caption;
133 print coltable_hsv(@{$mapinfo});
137 if (my $table = $info->{table}) {
138 say '<table class="color mapped">';
139 say sprintf '<caption>%s</caption>', $caption;
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, @{$_});
161 if (my $palette = $info->{list}) {
162 my $order = $get{order} && $get{order}.'order';
163 my $colours = colorder($palette,
164 $info->{$order} // $palettes->{ $info->{parent} }->{$order}
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 !$num;
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;