#!/usr/bin/env perl use 5.014; use Shiar_Sheet::Colour 1.05; say 'use strict;'; say '+{'; my @names; my %seen; for my $path (@ARGV) { open my $theme, '<', $path or do { warn "could not open $path: $!\n"; next; }; (my $name = $path) =~ s{.*/}{}; # basename my (%pal, @pal); while (readline $theme) { m{ (?: (foreground | background) | color(\d+) ) \h* : \h* (?: \#(\S+) | rgb:(\S+) ) }x or next; my ($name, $idx, $val) = ($1, $2, uc $+); $name or $idx < 16 or next; $val =~ s/[^0-9A-F]//g; ($name ? $pal{$name} : $pal[$idx]) = $val; } my $huesum = 0; for my $hue ( sort map { $_->hue } grep { ($_->hsv)[1] > 32 } # ignore unsaturated map { Shiar_Sheet::Colour->new($_) } @pal ) { state $lasthue; $huesum += abs($lasthue - $hue) > .02 if defined $lasthue; $lasthue = $hue; } $huesum > 3 or next; # require number of significant hue changes #TODO tweak to include good-pants, exclude cheesecake-* if ($seen{"@pal"}++) { warn "ignore duplicate palette $name\n"; next; } say qq("$name" => {); say qq(\ttitle => '$name',); say qq(\tparent => 'cga',); say qq(\tlist => [qw(@pal)],); say qq(\t$_ => '$pal{$_}',) for keys %pal; say qq(},); push @names, $name; } say 'xcolor => [', join(', ', map {"'$_'"} @names), '],'; say '}';