Script to help choosing a palette for colorized ascii-art or ansi-art for modern terminals

vtnearpal.pl

#!/usr/bin/env perl
# vtnearpal.pl [+256 | +88] [-selector] colors [...]
# Find the optimal elements of terminal palette to represent given set
# of colors.  Assumes either 256- or 88-color mode and allows limiting
# the set of terminal colors to given selection (perl slice indices).
use strict;
use Graphics::ColorObject 'RGB_to_Lab';
use Algorithm::Munkres 'assign';

# (id,rgb) -> [id, r, g, b, L, a, b]
sub mkcs { return [shift, @_, @{RGB_to_Lab([ map { $_/255 } @_ ])}] }

# (c0,c1..cn) -> (d1..dn) squared distances to c0
sub distcs {
  my $x = shift;
  return map { my $s=0; for my$i(4..6) {$s+=($x->[$i]-$_->[$i])**2}; $s } @_;
}

my $ncvt = 256; # Use 256 or 88 colors
my $selector = '0..$ncvt-1';
my @palette = (); # requested colors

# Read arguments
foreach (@ARGV) {
  if (m/^[+-]/) {
    $ncvt = int$1, next if m/^\+(256|88)$/;
    $selector = $1, next if m/^-([0-9.,]+)$/;
    die "Invalid option $_";
  }
  else {
    my @rgb = map hex,
      m~([0-9a-f]{2})[/]?([0-9a-f]{2})[/]?([0-9a-f]{2})~i;
    die "Invalid color $_" unless $#rgb == 2;
    push @palette, mkcs sprintf('%02x/%02x/%02x',@rgb), @rgb;
  }
}

# Basic colors
my @colors = (
  mkcs( 0, 0x00, 0x00, 0x00),
  mkcs( 1, 0xcd, 0x00, 0x00),
  mkcs( 2, 0x00, 0xcd, 0x00),
  mkcs( 3, 0xcd, 0xcd, 0x00),
  mkcs( 4, 0x00, 0x00, 0xee),
  mkcs( 5, 0xcd, 0x00, 0xcd),
  mkcs( 6, 0x00, 0xcd, 0xcd),
  mkcs( 7, 0xe5, 0xe5, 0xe5),
  mkcs( 8, 0x7f, 0x7f, 0x7f),
  mkcs( 9, 0xff, 0x00, 0x00),
  mkcs(10, 0x00, 0xff, 0x00),
  mkcs(11, 0xff, 0xff, 0x00),
  mkcs(12, 0x5c, 0x5c, 0xff),
  mkcs(13, 0xff, 0x00, 0xff),
  mkcs(14, 0x00, 0xff, 0xff),
  mkcs(15, 0xff, 0xff, 0xff)
);
# 256 extended colors
if ($ncvt == 256) {
  for my$r (0..5) {
  for my$g (0..5) {
  for my$b (0..5) {
    my $i = 16+$r*36+$g*6+$b;
    $colors[$i] = mkcs $i, map { $_ && $_*40+55 } $r, $g, $b;
  }}}
  for my$g (0..23) {
    my $i = 232+$g;
    $colors[$i] = mkcs $i, ($g*10+8) x 3;
  }
}
# 88 color mode
if ($ncvt == 88) {
  for my$r (0..3) {
  for my$g (0..3) {
  for my$b (0..3) {
    my $i = 16+$r*16+$g*4+$b;
    $colors[$i] = mkcs $i, map {(0, 0x8b, 0xcd, 0xff)[$_]} $r, $g, $b;
  }}}
  for my$g (0..7) {
    my $i = 80+$g;
    $colors[$i] = mkcs $i,
      ((0x2e, 0x5c, 0x73, 0x8b, 0xa2, 0xb9, 0xd0, 0xe7)[$g]) x 3;
  }
}

# Subset selection
@colors = grep defined, eval "\@colors[$selector]";
die "Too many colors for given selection." if $#colors < $#palette;

# Solve assignment problem to choose palette entries
# that minimize sum of squared distances, yet ensure
# separate palette entry for each of requested colors.
my @M = ();
my @out;
push @M, [distcs $_, @colors] for @palette;
assign \@M, \@out;

# redefine to ensure nice looking display
my @k = ();
my $k = 16;
my %used = ();
$used{$_} = 1 for map {$colors[$_]->[0]} @out[0..$#palette];
print "\033]4";
for my$i (0..$#palette) {
  $k++ while $used{$k};
  $used{$k} = 1;
  warn "Displayed colors will not be accurate (too many colors)", $k=16 if $k > $ncvt;
  push @k, $k;
  printf ";%d;rgb:%02x/%02x/%02x", $k, @{$palette[$i]}[1..3];
  printf ";%d;rgb:%02x/%02x/%02x", @{$colors[$out[$i]]}[0..3];
}
print "\033\\";

# show results, will look really nice if terminal supports
# redefinitions, crap otherwise but still informative
for my$i (0..$#palette) {
  printf "\033[48;5;%d;%dm %s \033[0m",
    $k[$i], $palette[$i]->[4] > 50 ? 30 : 37, $palette[$i]->[0];
  printf "\033[48;5;%d;%dm %3s %02x/%02x/%02x \033[0m ",
    $colors[$out[$i]]->[0],
    $colors[$out[$i]]->[4] > 50 ? 30 : 37, $colors[$out[$i]]->[0],
    @{$colors[$out[$i]]}[1..3];
  printf "\033[38;5;%dm@\033[38;5;%dm@\033[0m ",
    $k[$i], $colors[$out[$i]]->[0];
  printf "ΔE%6.2f\n", sqrt($M[$i][$out[$i]]);
}

exit;