3 if (my ($name) = $Request =~ /(.+)\.gpl\z/) {
4 my $palettes = Data('termcol');
5 my $palette = $palettes->{$name}
6 or Abort("Palette '$name' not found", 404);
7 ref $palette ne 'ARRAY'
8 or Abort("Group contains multiple palettes: ".join(', ', @{$palette}));
10 $header{content_type} = 'text/x-gimp-gpl';
12 say 'Name: ', $palette->{name} // $name;
15 for (@{ $palette->{list} }) {
16 my ($rgb, $name) = split /:/, $_, 3;
17 say join ' ', unpack('C*', pack 'H6', $rgb), $name;
23 title => ($Request ? 'terminal colour' : 'colour palettes') . ' cheat sheet',
25 description => [!$Request ? "Comparison of various colour palettes." : (
26 "Index of all terminal/console colour codes,",
27 "with an example result of various environments.",
30 color colour code terminal console escape table xterm rxvt
31 ansi vt100 8bit 4bit cga ega vga rgb hsv game emulator display
33 data => ['termcol.inc.pl'],
34 stylesheet => [qw'light dark'],
37 my @draw = map { [$_, s/\W+\z//] } grep { $_ } split m(/),
38 $get{img} // exists $get{img} && 'compile.png';
41 push @termlist, split /\W+/, $Request || 'default';
43 say "<h1>$_</h1>\n" for $Request ? 'Colour palettes' : 'Terminal colours';
46 if ("@termlist" eq 'default') {
47 say '<span title="ECMA-48">ANSI</span> (VT100, ISO-6429) 16-colour text palette';
48 say 'as implemented by various systems and programs.';
49 say 'Also see <a href="/termcol/legacy">8-bit legacy hardware</a> palettes.';
51 elsif ("@termlist" eq 'legacy') {
52 say 'Colour palettes of various 8-bit legacy systems and retro games.';
53 say 'Also see <a href="/termcol">ANSI console</a> palettes.';
56 say 'Comparison of requested colour palettes.';
62 use Shiar_Sheet::Colour 1.04;
63 use List::Util qw( min max );
66 my $palettes = Data('termcol');
69 my $name = shift // return "<td>\n";
70 my $col = Shiar_Sheet::Colour->new(@_);
71 my $minhex = $col->rgb24;
72 my $css = '#' . $col->rgb48;
73 my $inverse = '#' . sprintf('%X', $col->luminance/255 < .3 ? 12 : 0) x 3;
75 my $sample = [ qw(#000 #FFF) ];
76 ($name, $sample) = @$name if ref $name eq 'ARRAY';
78 my $out = sprintf('<td title="%s" style="%s">%s',
79 join(',', map { int } @$col),
80 "background:$css; color:$inverse",
83 $out .= sprintf('<samp style="%s"><small>%s</small></samp>',
84 "background:$_; color:$css", $minhex
90 my ($palette, $imgfile, $reindex) = @_;
95 my @imgpal = map { Imager::Color->new(ref $_ ? @$_ : $_) } @{$palette};
97 my $img = $imgcache->{$imgfile}
98 //= Imager->new(file => "data/palimage/$imgfile")
99 or die Imager->errstr.$/;
104 make_colors => 'none',
106 translate => 'closest',
110 @{[ $img->getcolors ]} == @imgpal
111 or die "incompatible palette size\n";
112 $img->setcolors(colors => \@imgpal);
115 }->write(data => \my $imgdata, type => 'png');
116 return sprintf '<img src="data:image/png;base64,%s">',
117 MIME::Base64::encode_base64($imgdata);
123 my $info = $palettes->{$term};
125 if (ref $info eq 'ARRAY') {
126 coltable($_) for @{$info};
130 if (ref $info eq 'CODE') {
131 coltable($_) for $info->($palettes);
135 ref $info eq 'HASH' or return;
136 my $order = $get{order} && $get{order}.'order';
137 my $reorder = $info->{$order} // $palettes->{ $info->{parent} }->{$order};
139 my $caption = $info->{name} // $term;
140 $caption = sprintf('<%s %s>%s</%1$s>',
141 $info->{href} ? 'a' : 'span',
143 map { sprintf '%s="%s"', $_, $info->{$_} }
144 grep { defined $info->{$_} }
148 ) if $info->{href} or $info->{title};
150 if ($info->{table} or $info->{rgbmap}) {
151 say '<table class="color mapped">';
152 say sprintf '<caption>%s</caption>', $caption;
154 print coltable_hsv(@{$_}) for $info->{rgbmap} || ();
156 if (my $table = $info->{table}) {
157 $table = [ @{$table}[@{$reorder}] ] if $reorder;
159 for my $row (@$table) {
165 print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row;
169 my $width = scalar @{ $table->[0] };
171 [ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ]
172 } map { @{$_} } @{$table};
174 print "<tr><td colspan=$width>", img_egapal(\@imgpal, @{$_});
182 if (my $palette = $info->{list}) {
183 my $colours = colorder($palette, $reorder);
186 my $columns = ceil(@{$palette} / $rows);
188 say '<table class=color>';
189 say sprintf '<caption>%s</caption>', $caption;
190 for my $row (0 .. $rows - 1) {
192 for my $col (0 .. $columns - 1) {
193 my $num = $row + $col * $rows;
194 my ($rgb, $name) = split /:/, $colours->[$num], 3;
195 $name //= $rgb && $num;
196 $name = [ $name, [] ] if $term =~ /^msx/ and !$name; # no bg for transparency
197 $name = [ $name, ['#333'] ] if $term eq 'xkcd';
198 print colcell($name, $rgb);
203 my $imgpal = colorder($palette,
204 $info->{ansiorder} // $palettes->{ $info->{parent} }->{ansiorder}
206 print "<tr><td colspan=$columns>", img_egapal($imgpal, @{$_});
213 my ($palette, $reorder) = @_;
214 return [ map { $palette->[$_] =~ s/:(?![^:])|$/:$_/r } @{$reorder} ]
220 my ($dim, $rgbval, $greyramp) = @_;
222 my $hmax = 2 * $dim * 3; # each face of the rgb cube
225 $rgbval ||= sub { join('', @_), map { int $_ * 255 / $vmax } @_ };
227 my @greymap = @{$greyramp || []}; # [name, r, g=l, b]
228 my @colmap; # saturation => value => hue => [name, r,g,b]
230 for my $r (0 .. $dim - 1) {
231 for my $g (0 .. $dim - 1) {
232 for my $b (0 .. $dim - 1) {
233 my @rgb = ($r, $g, $b);
235 my ($h, $s, $v) = Shiar_Sheet::Colour->new(@rgb)->hsv;
239 push @greymap, [ $rgbval->(@rgb) ];
243 $h = 1; # greyscale hue
244 $s = $smax - $v + 1; # spread brightness over saturation groups
245 $v &&= $smax # highest saturation
246 or $v = $s = 1; # black at initial column
251 $s = $smax - $s - $v;
253 $colmap[$s][$v][$h] = [ $rgbval->(@rgb) ];
259 $out .= sprintf '<colgroup span=%d>', scalar @{$_} for @colmap;
260 my $huerow = $colmap[0][0]; # first {$_} map { @{$_} } @colmap;
261 for my $h (grep { $huerow->[$_] } 0 .. $#{$huerow}) {
263 $out .= colcell(@$_) for map { $_->[$h] } map { reverse @{$_} } @colmap;
269 my $colbreak = scalar map { @$_ } @colmap; # same width as hue rows
270 for my $cell (sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } @greymap) {
271 $out .= '<tr>' unless $col++ % $colbreak;
272 $out .= colcell(@{$cell});
277 my @palette = map { [ @{$_}[1 .. 3] ] } @greymap, map {@$_} map {@$_} @colmap;
278 my $tablespan = scalar map { @$_ } @colmap;
279 my $imgdata = img_egapal(\@palette, @{ $draw[0] });
280 $out .= "<tr><td colspan=$tablespan>$imgdata";
286 coltable($_) for @termlist;