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'],
36 my @draw = map { [$_, s/\W+\z//] } grep { $_ } split m(/),
37 $get{img} // exists $get{img} && 'compile.png';
40 push @termlist, split /\W+/, $Request || 'default';
42 say "<h1>$_</h1>\n" for $Request ? 'Colour palettes' : 'Terminal colours';
45 if ("@termlist" eq 'default') {
46 say '<span title="ECMA-48">ANSI</span> (VT100, ISO-6429) 16-colour text palette';
47 say 'as implemented by various systems and programs.';
48 say 'Also see <a href="/termcol/legacy">8-bit legacy hardware</a> palettes.';
50 elsif ("@termlist" eq 'legacy') {
51 say 'Colour palettes of various 8-bit legacy systems and retro games.';
52 say 'Also see <a href="/termcol">ANSI console</a> palettes.';
55 say 'Comparison of requested colour palettes.';
61 use Shiar_Sheet::Colour 1.04;
62 use List::Util qw( min max );
65 my $palettes = Data('termcol');
68 my $name = shift // return "<td>\n";
69 my $col = Shiar_Sheet::Colour->new(@_);
70 my $minhex = $col->rgb24;
71 my $css = '#' . $col->rgb48;
72 my $inverse = '#' . sprintf('%X', $col->luminance/255 < .3 ? 12 : 0) x 3;
74 my $sample = [ qw(#000 #FFF) ];
75 ($name, $sample) = @$name if ref $name eq 'ARRAY';
77 my $out = sprintf('<td title="%s" style="%s">%s',
78 join(',', map { int } @$col),
79 "background:$css; color:$inverse",
82 $out .= sprintf('<samp style="%s"><small>%s</small></samp>',
83 "background:$_; color:$css", $minhex
89 my ($palette, $imgfile, $reindex) = @_;
94 my @imgpal = map { Imager::Color->new(ref $_ ? @$_ : $_) } @{$palette};
96 my $img = $imgcache->{$imgfile}
97 //= Imager->new(file => "data/palimage/$imgfile")
98 or die Imager->errstr.$/;
103 make_colors => 'none',
105 translate => 'closest',
109 @{[ $img->getcolors ]} == @imgpal
110 or die "incompatible palette size\n";
111 $img->setcolors(colors => \@imgpal);
114 }->write(data => \my $imgdata, type => 'png');
115 return sprintf '<img src="data:image/png;base64,%s">',
116 MIME::Base64::encode_base64($imgdata);
122 my $info = $palettes->{$term};
124 if (ref $info eq 'ARRAY') {
125 coltable($_) for @{$info};
129 if (ref $info eq 'CODE') {
130 coltable($_) for $info->($palettes);
134 ref $info eq 'HASH' or return;
135 my $order = $get{order} && $get{order}.'order';
136 my $reorder = $info->{$order} // $palettes->{ $info->{parent} }->{$order};
138 my $caption = $info->{name} // $term;
139 $caption = sprintf('<%s %s>%s</%1$s>',
140 $info->{href} ? 'a' : 'span',
142 map { sprintf '%s="%s"', $_, $info->{$_} }
143 grep { defined $info->{$_} }
147 ) if $info->{href} or $info->{title};
149 if ($info->{table} or $info->{rgbmap}) {
150 say '<table class="color mapped">';
151 say sprintf '<caption>%s</caption>', $caption;
153 print coltable_hsv(@{$_}) for $info->{rgbmap} || ();
155 if (my $table = $info->{table}) {
156 $table = [ @{$table}[@{$reorder}] ] if $reorder;
158 for my $row (@$table) {
164 print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row;
168 my $width = scalar @{ $table->[0] };
170 [ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ]
171 } map { @{$_} } @{$table};
173 print "<tr><td colspan=$width>", img_egapal(\@imgpal, @{$_});
181 if (my $palette = $info->{list}) {
182 my $colours = colorder($palette, $reorder);
185 my $columns = ceil(@{$palette} / $rows);
187 say '<table class=color>';
188 say sprintf '<caption>%s</caption>', $caption;
189 for my $row (0 .. $rows - 1) {
191 for my $col (0 .. $columns - 1) {
192 my $num = $row + $col * $rows;
193 my ($rgb, $name) = split /:/, $colours->[$num], 3;
194 $name //= $rgb && $num;
195 $name = [ $name, [] ] if $term =~ /^msx/ and !$name; # no bg for transparency
196 $name = [ $name, ['#333'] ] if $term eq 'xkcd';
197 print colcell($name, $rgb);
202 my $imgpal = colorder($palette,
203 $info->{ansiorder} // $palettes->{ $info->{parent} }->{ansiorder}
205 print "<tr><td colspan=$columns>", img_egapal($imgpal, @{$_});
212 my ($palette, $reorder) = @_;
213 return [ map { $palette->[$_] =~ s/:(?![^:])|$/:$_/r } @{$reorder} ]
219 my ($dim, $rgbval, $greyramp) = @_;
221 my $hmax = 2 * $dim * 3; # each face of the rgb cube
224 $rgbval ||= sub { join('', @_), map { int $_ * 255 / $vmax } @_ };
226 my @greymap = @{$greyramp || []}; # [name, r, g=l, b]
227 my @colmap; # saturation => value => hue => [name, r,g,b]
229 for my $r (0 .. $dim - 1) {
230 for my $g (0 .. $dim - 1) {
231 for my $b (0 .. $dim - 1) {
232 my @rgb = ($r, $g, $b);
234 my ($h, $s, $v) = Shiar_Sheet::Colour->new(@rgb)->hsv;
238 push @greymap, [ $rgbval->(@rgb) ];
242 $h = 1; # greyscale hue
243 $s = $smax - $v + 1; # spread brightness over saturation groups
244 $v &&= $smax # highest saturation
245 or $v = $s = 1; # black at initial column
250 $s = $smax - $s - $v;
252 $colmap[$s][$v][$h] = [ $rgbval->(@rgb) ];
258 $out .= sprintf '<colgroup span=%d>', scalar @{$_} for @colmap;
259 my $huerow = $colmap[0][0]; # first {$_} map { @{$_} } @colmap;
260 for my $h (grep { $huerow->[$_] } 0 .. $#{$huerow}) {
262 $out .= colcell(@$_) for map { $_->[$h] } map { reverse @{$_} } @colmap;
268 my $colbreak = scalar map { @$_ } @colmap; # same width as hue rows
269 for my $cell (sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } @greymap) {
270 $out .= '<tr>' unless $col++ % $colbreak;
271 $out .= colcell(@{$cell});
276 my @palette = map { [ @{$_}[1 .. 3] ] } @greymap, map {@$_} map {@$_} @colmap;
277 my $tablespan = scalar map { @$_ } @colmap;
278 my $imgdata = img_egapal(\@palette, @{ $draw[0] });
279 $out .= "<tr><td colspan=$tablespan>$imgdata";
285 coltable($_) for @termlist;