X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/f0cd021d19083c1a3b5e88523148579231c7e26b..HEAD:/termcol.plp diff --git a/termcol.plp b/termcol.plp index 267d5a7..f76e293 100644 --- a/termcol.plp +++ b/termcol.plp @@ -1,55 +1,69 @@ <(common.inc.plp)><: +if (my ($name) = $Request =~ /(.+)\.gpl\z/) { + my $palettes = Data('termcol'); + my $palette = $palettes->{$name} + or Abort("Palette '$name' not found", 404); + ref $palette ne 'ARRAY' + or Abort("Group contains multiple palettes: ".join(', ', @{$palette})); + + $header{content_type} = 'text/x-gimp-gpl'; + say 'GIMP Palette'; + say 'Name: ', $palette->{name} // $name; + say 'Columns: 8'; + say '#'; + for (@{ $palette->{list} }) { + my ($rgb, $name) = split /:/, $_, 3; + say join ' ', unpack('C*', pack 'H6', $rgb), $name; + } + exit; +} + Html({ - title => 'terminal colour cheat sheet', - version => '1.0', - description => [ + title => ($Request ? 'terminal colour' : 'colour palettes') . ' cheat sheet', + version => '1.4', + description => [!$Request ? "Comparison of various colour palettes." : ( "Index of all terminal/console colour codes,", "with an example result of various environments.", - ], + )], keywords => [qw' - color code terminal console escape table xterm rxvt + color colour code terminal console escape table xterm rxvt + ansi vt100 8bit 4bit cga ega vga rgb hsv game emulator display '], data => ['termcol.inc.pl'], stylesheet => [qw'light dark'], }); -my $imgfile = $get{img} // exists $get{img} && 'indi.png'; +my @draw = map { [$_, s/\W+\z//] } grep { $_ } split m(/), + $get{img} // exists $get{img} && 'compile.png'; my @termlist; -push @termlist, split /\W+/, $ENV{PATH_INFO} || 'default'; - -my %termgroup = ( - default => [qw( ansi xkcd ansi88 )], - more => [qw( ansi mirc legacy ansi256 )], - msx => [qw( msx1 msx2 arnejmp )], - ansi => [qw( cga xterm tango app html )], - legacy => [qw( c64 msx2 mac2 risc arnegame cpc )], -); -@{$_} = map { $termgroup{$_} ? @{ $termgroup{$_} } : $_ } @{$_} - for values %termgroup, \@termlist; +push @termlist, split /\W+/, $Request || 'default'; -:> -

Terminal colours

+say "

$_

\n" for $Request ? 'Colour palettes' : 'Terminal colours'; -

-ANSI (VT100, ISO-6429) 16-colour text palette -as implemented by various systems and programs. -<: -print - "@termlist" ne "@{ $termgroup{default} }" ? 'Additional palettes are included as specified.' : - 'Also see 8-bit legacy hardware palettes.'; +say '

'; +if ("@termlist" eq 'default') { + say 'ANSI (VT100, ISO-6429) 16-colour text palette'; + say 'as implemented by various systems and programs.'; + say 'Also see 8-bit legacy hardware palettes.'; +} +elsif ("@termlist" eq 'legacy') { + say 'Colour palettes of various 8-bit legacy systems and retro games.'; + say 'Also see ANSI console palettes.'; +} +else { + say 'Comparison of requested colour palettes.'; +} :> -

<: -use 5.010; -use Shiar_Sheet::Colour '1.03'; +use Shiar_Sheet::Colour 1.04; use List::Util qw( min max ); +use POSIX qw( ceil ); -my $palettes = do 'termcol.inc.pl'; -die "Cannot open palette data: $_\n" for $@ || $! || (); +my $palettes = Data('termcol'); sub colcell { my $name = shift // return "\n"; @@ -73,15 +87,17 @@ sub colcell { } sub img_egapal { - my ($palette) = @_; + my ($palette, $imgfile, $reindex) = @_; return eval { require Imager; require MIME::Base64; my @imgpal = map { Imager::Color->new(ref $_ ? @$_ : $_) } @{$palette}; - state $reindex = $imgfile =~ s/!$//; - state $img = Imager->new(file => "data/palimage/$imgfile") + state $imgcache = {}; + my $img = $imgcache->{$imgfile} + //= Imager->new(file => "data/palimage/$imgfile") or die Imager->errstr.$/; + do { if ($reindex) { $img->to_paletted({ @@ -102,9 +118,24 @@ sub img_egapal { } || $@; } -for my $term (@termlist) { +sub coltable { + my ($term) = @_; my $info = $palettes->{$term}; - ref $info eq 'HASH' or next; + + if (ref $info eq 'ARRAY') { + coltable($_) for @{$info}; + return; + } + + if (ref $info eq 'CODE') { + coltable($_) for $info->($palettes); + return; + } + + ref $info eq 'HASH' or return; + my $order = $get{order} && $get{order}.'order'; + my $reorder = $info->{$order} // $palettes->{ $info->{parent} }->{$order}; + my $caption = $info->{name} // $term; $caption = sprintf('<%s %s>%s', $info->{href} ? 'a' : 'span', @@ -116,33 +147,75 @@ for my $term (@termlist) { $caption, ) if $info->{href} or $info->{title}; - if (my $mapinfo = $info->{rgbmap}) { - print ''."\n"; - printf "\n", $caption; - print coltable_hsv(@{$mapinfo}); - print "
%s
\n\n"; - } + if ($info->{table} or $info->{rgbmap}) { + say ''; + say sprintf '', $caption; + + print coltable_hsv(@{$_}) for $info->{rgbmap} || (); - if (my $colours = $info->{list}) { - if (my $reorder = $info->{ansiorder} and $get{v}) { - $colours = [ map { $colours->[$_] =~ s/:|$/:$_/r } @{$reorder} ]; + if (my $table = $info->{table}) { + $table = [ @{$table}[@{$reorder}] ] if $reorder; + + for my $row (@$table) { + if (!$row) { + say ''; + next; + } + print ''; + print colcell(ref $_ ? @$_ : $_ ? reverse split /:/ : undef) for @$row; + } + + if (@draw) { + my $width = scalar @{ $table->[0] }; + my @imgpal = map { + [ ref $_ ? @{$_}[1 .. 3] : map {hex} /(..)(..)(..)/ ] + } map { @{$_} } @{$table}; + for (@draw) { + print "
%s
", img_egapal(\@imgpal, @{$_}); + } + } } - print '', "\n"; - printf "\n", $caption; - for my $num (0 .. $#{$colours}) { - my ($rgb, $name) = split /:/, $colours->[$num], 3; - $name ||= $num; - $name = [ $name, [] ] if $term =~ /^msx/ and !$num; - $name = [ $name, ['#333'] ] if $term eq 'xkcd'; - print '', colcell($name, $rgb); + say "
%s
\n"; + } + + if (my $palette = $info->{list}) { + my $colours = colorder($palette, $reorder); + + my $rows = 8; + my $columns = ceil(@{$palette} / $rows); + + say ''; + say sprintf '', $caption; + for my $row (0 .. $rows - 1) { + print ''; + for my $col (0 .. $columns - 1) { + my $num = $row + $col * $rows; + my ($rgb, $name) = split /:/, $colours->[$num], 3; + $name //= $rgb && $num; + $name = [ $name, [] ] if $term =~ /^msx/ and !$name; # no bg for transparency + $name = [ $name, ['#333'] ] if $term eq 'xkcd'; + print colcell($name, $rgb); + } } - print '
%s
', img_egapal(\@{$colours}) if $imgfile; - print "
\n\n"; + for (@draw) { + my $imgpal = colorder($palette, + $info->{ansiorder} // $palettes->{ $info->{parent} }->{ansiorder} + ); + print "
", img_egapal($imgpal, @{$_}); + } + say "
\n"; } } +sub colorder { + my ($palette, $reorder) = @_; + return [ map { $palette->[$_] =~ s/:(?![^:])|$/:$_/r } @{$reorder} ] + if $reorder; + return $palette; +} + sub coltable_hsv { my ($dim, $rgbval, $greyramp) = @_; @@ -159,9 +232,7 @@ sub coltable_hsv { for my $b (0 .. $dim - 1) { my @rgb = ($r, $g, $b); - my $h = Shiar_Sheet::Colour->new(@rgb)->hue * $hmax; - my $v = max(@rgb); - my $s = abs(min(@rgb) - max(@rgb)); + my ($h, $s, $v) = Shiar_Sheet::Colour->new(@rgb)->hsv; if (!$s) { if (@greymap) { @@ -169,11 +240,13 @@ sub coltable_hsv { next; } - $h = $hmax; # greyscale hue - $s = 1; # lowest saturation for other hues - $v = $s = $vmax if !$v; # black at full saturation + $h = 1; # greyscale hue + $s = $smax - $v + 1; # spread brightness over saturation groups + $v &&= $smax # highest saturation + or $v = $s = 1; # black at initial column } + $h *= $hmax; $v = $vmax - $v; $s = $smax - $s - $v; @@ -187,7 +260,7 @@ sub coltable_hsv { my $huerow = $colmap[0][0]; # first {$_} map { @{$_} } @colmap; for my $h (grep { $huerow->[$_] } 0 .. $#{$huerow}) { $out .= ''; - $out .= colcell(@$_) for map { $_->[$h] } map { @{$_} } @colmap; + $out .= colcell(@$_) for map { $_->[$h] } map { reverse @{$_} } @colmap; } if (@greymap) { @@ -200,16 +273,17 @@ sub coltable_hsv { } } - if ($imgfile) { + if (@draw) { my @palette = map { [ @{$_}[1 .. 3] ] } @greymap, map {@$_} map {@$_} @colmap; - my $imgdata = img_egapal(\@palette); my $tablespan = scalar map { @$_ } @colmap; + my $imgdata = img_egapal(\@palette, @{ $draw[0] }); $out .= "$imgdata"; } return $out; } +coltable($_) for @termlist; :>