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 ($info->{table} or $info->{rgbmap}) {
131 say '<table class="color mapped">';
132 say sprintf '<caption>%s</caption>', $caption;
134 print coltable_hsv(@{$_}) for $info->{rgbmap} || ();
136 if (my $table = $info->{table}) {
137 for my $row (@$table) {
143 print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row;
147 my $width = scalar @{ $table->[0] };
149 [ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ]
150 } map { @{$_} } @{$table};
152 print "<tr><td colspan=$width>", img_egapal(\@imgpal, @{$_});
160 if (my $palette = $info->{list}) {
161 my $order = $get{order} && $get{order}.'order';
162 my $colours = colorder($palette,
163 $info->{$order} // $palettes->{ $info->{parent} }->{$order}
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 !$num;
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;