176 lines
3.5 KiB
Perl
176 lines
3.5 KiB
Perl
#!/usr/bin/env perl
|
|
# colorscheme.pl
|
|
#
|
|
# Written in 2020 by Lucas
|
|
#
|
|
# To the extent possible under law, the author(s) have dedicated all
|
|
# copyright and related and neighboring rights to this software to the
|
|
# public domain worldwide. This software is distributed without any
|
|
# warranty.
|
|
#
|
|
# You should have received a copy of the CC0 Public Domain Dedication
|
|
# along with this software. If not, see
|
|
# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
|
|
use v5.12;
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Getopt::Std;
|
|
use POSIX qw(fmod);
|
|
|
|
use constant {
|
|
LENGTH => 50,
|
|
};
|
|
|
|
my $progname = $0;
|
|
$progname =~ s@.*/@@;
|
|
|
|
sub err (@)
|
|
{
|
|
say STDERR "$progname: @_";
|
|
exit 1;
|
|
}
|
|
|
|
sub usage ()
|
|
{
|
|
say STDERR "Usage: $progname [-i]";
|
|
exit 1;
|
|
}
|
|
|
|
sub validhsv ($$$)
|
|
{
|
|
my ($h, $s, $v) = @_;
|
|
return $h >= 0.0 && $h <= 360.0 && $s >= 0.0 && $s <= 1.0 &&
|
|
$v >= 0.0 && $v <= 1.0;
|
|
}
|
|
|
|
sub validhsl ($$$)
|
|
{
|
|
my ($h, $s, $l) = @_;
|
|
return $h >= 0.0 && $h <= 360.0 && $s >= 0.0 && $s <= 1.0 &&
|
|
$l >= 0.0 && $l <= 1.0;
|
|
}
|
|
|
|
sub validrgb ($$$)
|
|
{
|
|
my ($r, $g, $b) = @_;
|
|
return $r >= 0 && $r <= 255 && $g >= 0 && $g <= 255 &&
|
|
$b >= 0 && $b <= 255;
|
|
}
|
|
|
|
sub validrgbhex ($$$)
|
|
{
|
|
my ($r, $g, $b) = @_;
|
|
return $r =~ /^[0-9A-Fa-f]{2}$/ && $g =~ /^[0-9A-Fa-f]{2}$/ &&
|
|
$b =~ /^[0-9A-Fa-f]{2}$/;
|
|
}
|
|
|
|
sub hsvtorgb ($$$)
|
|
{
|
|
my ($h, $s, $v) = @_;
|
|
|
|
my $c = $s * $v;
|
|
my $hh = $h == 360.0 ? 0.0 : $h / 60.0;
|
|
my $x = $c * (1.0 - abs(fmod($hh, 2.0) - 1.0));
|
|
|
|
my ($r, $g, $b);
|
|
for (int($hh)) {
|
|
($r, $g, $b) = ($c, $x, 0) if $_ == 0;
|
|
($r, $g, $b) = ($x, $c, 0) if $_ == 1;
|
|
($r, $g, $b) = (0, $c, $x) if $_ == 2;
|
|
($r, $g, $b) = (0, $x, $c) if $_ == 3;
|
|
($r, $g, $b) = ($x, 0, $c) if $_ == 4;
|
|
($r, $g, $b) = ($c, 0, $x) if $_ == 5;
|
|
}
|
|
|
|
my $m = $v - $c;
|
|
return map {255 * ($_ + $m)} $r, $g, $b;
|
|
}
|
|
|
|
sub hsltorgb ($$$)
|
|
{
|
|
my ($h, $s, $l) = @_;
|
|
|
|
my $c = (1.0 - abs(2.0 * $l - 1.0)) * $s;
|
|
my $hh = $h == 360.0 ? 0.0 : $h / 60.0;
|
|
my $x = $c * (1.0 - abs(fmod($hh, 2.0) - 1.0));
|
|
|
|
my ($r, $g, $b);
|
|
for (int($hh)) {
|
|
($r, $g, $b) = ($c, $x, 0) if $_ == 0;
|
|
($r, $g, $b) = ($x, $c, 0) if $_ == 1;
|
|
($r, $g, $b) = (0, $c, $x) if $_ == 2;
|
|
($r, $g, $b) = (0, $x, $c) if $_ == 3;
|
|
($r, $g, $b) = ($x, 0, $c) if $_ == 4;
|
|
($r, $g, $b) = ($c, 0, $x) if $_ == 5;
|
|
}
|
|
|
|
my $m = $l - $c / 2.0;
|
|
return map {255 * ($_ + $m)} $r, $g, $b;
|
|
}
|
|
|
|
sub parseinput ()
|
|
{
|
|
my @colors;
|
|
|
|
while (my $line = <STDIN>) {
|
|
chomp $line;
|
|
next if $line =~ /^#|^$/;
|
|
my ($t, $x, $y, $z, undef) = split(/\s+/, $line, 5);
|
|
|
|
my @v;
|
|
if ($t eq "hsv") {
|
|
die "invalid input: $line" unless validhsv($x, $y, $z);
|
|
@v = map {int} hsvtorgb($x, $y, $z);
|
|
} elsif ($t eq "hsl") {
|
|
die "invalid input: $line" unless validhsl($x, $y, $z);
|
|
@v = map {int} hsltorgb($x, $y, $z);
|
|
} elsif ($t eq "rgb") {
|
|
die "invalid input: $line" unless validrgb($x, $y, $z);
|
|
@v = map {int} ($x, $y, $z);
|
|
} elsif ($t eq "rgbhex") {
|
|
die "invalid input: $line"
|
|
unless validrgbhex($x, $y, $z);
|
|
@v = map {hex} ($x, $y, $z);
|
|
} else {
|
|
die "invalid input: $line";
|
|
}
|
|
push(@colors, \@v);
|
|
}
|
|
|
|
return @colors;
|
|
}
|
|
|
|
sub main ()
|
|
{
|
|
my %opts;
|
|
|
|
getopts("i", \%opts) or usage;
|
|
|
|
my @colors = parseinput();
|
|
|
|
if (defined($opts{"i"})) {
|
|
err "Colorscheme doesn't have 18 colors"
|
|
if scalar(@colors) != 18;
|
|
|
|
printf "P6\n%u %u 255\n", 9 * LENGTH, 2 * LENGTH;
|
|
for (0..LENGTH - 1) {
|
|
for (0..8) {
|
|
print pack("CCC", @{$colors[$_]}) x LENGTH;
|
|
}
|
|
}
|
|
for (0..LENGTH - 1) {
|
|
for (9..17) {
|
|
print pack("CCC", @{$colors[$_]}) x LENGTH;
|
|
}
|
|
}
|
|
} else {
|
|
foreach (@colors) {
|
|
say "#", (map {sprintf "%02x", $_} @$_);
|
|
}
|
|
}
|
|
}
|
|
|
|
main();
|