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) {
138 print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row;
142 my $width = scalar @{ $table->[0] };
144 [ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ]
145 } map { @{$_} } @{$table};
147 print "<tr><td colspan=$width>", img_egapal(\@imgpal, @{$_});
153 if (my $palette = $info->{list}) {
154 my $order = $get{order} && $get{order}.'order';
155 my $colours = colorder($palette,
156 $info->{$order} // $palettes->{ $info->{parent} }->{$order}
160 my $columns = ceil(@{$palette} / $rows);
162 say '<table class=color>';
163 say sprintf '<caption>%s</caption>', $caption;
164 for my $row (0 .. $rows - 1) {
166 for my $col (0 .. $columns - 1) {
167 my $num = $row + $col * $rows;
168 my ($rgb, $name) = split /:/, $colours->[$num], 3;
169 $name //= $rgb && $num;
170 $name = [ $name, [] ] if $term =~ /^msx/ and !$num;
171 $name = [ $name, ['#333'] ] if $term eq 'xkcd';
172 print colcell($name, $rgb);
177 my $imgpal = colorder($palette,
178 $info->{ansiorder} // $palettes->{ $info->{parent} }->{ansiorder}
180 print "<tr><td colspan=$columns>", img_egapal($imgpal, @{$_});
187 my ($palette, $reorder) = @_;
188 return [ map { $palette->[$_] =~ s/:(?![^:])|$/:$_/r } @{$reorder} ]
194 my ($dim, $rgbval, $greyramp) = @_;
196 my $hmax = 2 * $dim * 3; # each face of the rgb cube
199 $rgbval ||= sub { join('', @_), map { int $_ * 255 / $vmax } @_ };
201 my @greymap = @{$greyramp || []}; # [name, r, g=l, b]
202 my @colmap; # saturation => value => hue => [name, r,g,b]
204 for my $r (0 .. $dim - 1) {
205 for my $g (0 .. $dim - 1) {
206 for my $b (0 .. $dim - 1) {
207 my @rgb = ($r, $g, $b);
209 my ($h, $s, $v) = Shiar_Sheet::Colour->new(@rgb)->hsv;
213 push @greymap, [ $rgbval->(@rgb) ];
217 $h = 1; # greyscale hue
218 $s = $smax - $v + 1; # spread brightness over saturation groups
219 $v &&= $smax # highest saturation
220 or $v = $s = 1; # black at initial column
225 $s = $smax - $s - $v;
227 $colmap[$s][$v][$h] = [ $rgbval->(@rgb) ];
233 $out .= sprintf '<colgroup span=%d>', scalar @{$_} for @colmap;
234 my $huerow = $colmap[0][0]; # first {$_} map { @{$_} } @colmap;
235 for my $h (grep { $huerow->[$_] } 0 .. $#{$huerow}) {
237 $out .= colcell(@$_) for map { $_->[$h] } map { reverse @{$_} } @colmap;
243 my $colbreak = scalar map { @$_ } @colmap; # same width as hue rows
244 for my $cell (sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } @greymap) {
245 $out .= '<tr>' unless $col++ % $colbreak;
246 $out .= colcell(@{$cell});
251 my @palette = map { [ @{$_}[1 .. 3] ] } @greymap, map {@$_} map {@$_} @colmap;
252 my $tablespan = scalar map { @$_ } @colmap;
253 my $imgdata = img_egapal(\@palette, @{ $draw[0] });
254 $out .= "<tr><td colspan=$tablespan>$imgdata";
260 coltable($_) for @termlist;