#!/usr/bin/perl -w
use strict;

my $esc="\e";
my $lab=0;
my @args=[];
my $rv=0;
my $perm=0;
my $scheme;

my $USAGE=<<END;
Usage:
  vtgamma \e[30;1m[-e] [-r]\e[0m \e[1m<palette>\e[0m [<gamma>...]
  vtgamma \e[30;1m[-e] [-r] [-l]\e[0m \e[1m<gamma>\e[0m
  vtgamma \e[30;1m[-e] [-r]\e[0m \e[31;1m<\e[0;31mred gamma\e[1m>\e[0m \e[32;1m<\e[0;32mgreen gamma\e[1m>\e[0m \e[1;34m<\e[0;34mblue gamma\e[1m>\e[0m
END
$USAGE=~s/\e\[[0-9;]*m//g unless -t STDERR;

my $PIO_CMAP=0x4B71; # Linux

my %palette =
(
    "vga"=>
        [0x000000, 0xaa0000, 0x00aa00, 0xaa5500, 0x0000aa, 0xaa00aa, 0x00aaaa, 0xaaaaaa,
         0x555555, 0xff5555, 0x55ff55, 0xeedd00, 0x5555ff, 0xff55ff, 0x55ffff, 0xffffff],
    "ubuntu"=>
        [0x010101, 0xde382b, 0x39b54a, 0xffc706, 0x006fb8, 0x762671, 0x2cb5e9, 0xcccccc,
         0x808080, 0xff0000, 0x00ff00, 0xffff00, 0x0000ff, 0xff00ff, 0x00ffff, 0xffffff],
    "gruvbox"=>
        [0x282828, 0xcc241d, 0x98971a, 0xd79921, 0x458588, 0xb16286, 0x689d6a, 0xa89984,
         0x928374, 0xfb4934, 0xb8bb26, 0xfabd2f, 0x83a598, 0xd3869b, 0x8ec07c, 0xebdbb2],
    "gruvbox-light"=>
        [0xfbf1c7, 0xcc241d, 0x98971a, 0xd79921, 0x458588, 0xb16286, 0x689d6a, 0x7c6f64,
         0x928374, 0x9d0006, 0x79740e, 0xb57614, 0x076678, 0x8f3f71, 0x427b58, 0x3c3836],
    "monokai"=>
        [0x272822, 0xf92672, 0xa6e22e, 0xf4bf75, 0x66d9ef, 0xae81ff, 0xa1efe4, 0xf8f8f2,
         0x75715e, 0xf92672, 0xa6e22e, 0xf4bf75, 0x66d9ef, 0xae81ff, 0xa1efe4, 0xf9f8f5],
);

while(@ARGV)
{
    $_=shift;
    if (/^-e|--escape$/)
    {
        $esc='\e';
    }
    elsif (/^-l|--lab|--Lab|--lchab|--LCHab$/)
    {
        $lab=1;
        require Graphics::ColorObject;
    }
    elsif (/^-r|--reverse$/)
    {
        $rv=1;
    }
    elsif (/^(\d*\.?\d+)$/)
    {
        push @args, $1;
    }
    elsif (/^[^-]/)
    {
        $scheme=$_;
    }
    elsif (/^-p|--permanent$/)
    {
        $^O eq "linux" or die "PIO_CMAP supported only on Linux.\n";
        $perm=1;
    }
    else
    {
        die "Invalid argument: \"$_\"\n$USAGE";
    }
}

my ($r,$g,$b)=
    ($#args==0)? $scheme ? (1,1,1) : die "$USAGE":
    ($#args==1)? ($args[1],$args[1],$args[1]):
    ($#args==2)? die "Only 2 gammas given, 1 or 3 required.\n":
    ($#args==3)? $lab ? die "Can't give RGB gamma in LCHab mode.\n":
                        ($args[1],$args[2],$args[3]):
    die "Too many gammas given.\n$USAGE";

my %reverse=(0=>15, 15=>0, 7=>8, 8=>7);

my $pal;
$scheme//="vga";
if ($rv && $palette{"$scheme-light"})
{
    $pal=$palette{$scheme.="-light"};
    %reverse=();
}
elsif (!($pal=$palette{$scheme}))
{
    die "Unknown palette: ｢$scheme｣\n";
}

sub gamma($$)
{
    my ($x,$k)=@_;
    return 0 if $x<=0;
    return ($x>=1)?1:0 if $k<=0;
    return exp(log($x)/$k);
}

sub unp($)
{
    my $c=$_[0];
    return ($c>>16, $c>>8 & 0xff, $c & 0xff);
}

sub rgb($)
{
    my ($c)=@_;

    $c=$reverse{$c} if $rv && exists $reverse{$c};

    # basic 16 colors
    return unp($$pal[$c]) if $pal && $c < 16;

    # 6x6x6 color cube
    if ($c < 232)
    {
        $c -= 16;
        use integer;
        my ($r,$g,$b) = ($c / 36, $c / 6 % 6, $c % 6);
        return ($r ? $r*0x28+0x37:0, $g ? $g*0x28+0x37:0, $b ? $b*0x28+0x37:0);
    }

    # grayscale ramp
    $c = $c*10-2312;
    return ($c, $c, $c);
}

my $setcolor;
my $ncolors=15;
my $out="";
if ($perm)
{
    $setcolor = sub { shift; $out .= sprintf("%c%c%c", @_); };
}
elsif ($ENV{"TERM"}=~/^linux/)
{
    $setcolor = sub { printf "%s]P%1X%02X%02X%02X", $esc, @_; };
}
elsif ($ENV{"TERM"}=~/^hurd/)
{
    # Neither supports nor cleanly ignores.
    die "Hurd console doesn't support palette control, sorry.\n";
}
else
{
    $setcolor = sub { printf "%s]4;%d;rgb:%02x/%02x/%02x%s", $esc, @_,
        $esc eq '\e' ? '\e\\' : "\e\\"; };
    $ncolors=255;
}

for(0..$ncolors)
{
    my @rgb = rgb $_;
    if ($lab)
    {
        my $c=Graphics::ColorObject->new_RGB255(\@rgb);
        my @lab=@{$c->as_LCHab()};
        $lab[0]=100*gamma($lab[0]/100, $r);
        @rgb=@{Graphics::ColorObject->new_LCHab(\@lab)->as_RGB255()};
    }
    else
    {
        $rgb[0]=255*gamma $rgb[0]/255, $r;
        $rgb[1]=255*gamma $rgb[1]/255, $g;
        $rgb[2]=255*gamma $rgb[2]/255, $b;
    }
    $setcolor->($_, @rgb);
}

if ($perm)
{
    ioctl(STDOUT,$PIO_CMAP,$out)
        or die "$0: PIO_CMAP failed: $^E\n";
}
else
{
    print "\n" if $esc ne "\e";
}
