#!/usr/bin/perl
use strict; use warnings; use utf8;
use autodie;
use Math::Trig;
use File::Basename qw(basename dirname);
use File::Temp qw(tempfile);
sub hexTuple {
my ($r, $g, $b) = @_;
return sprintf('%02x%02x%02x', int(255*$r+0.5), int(255*$g+0.5), int(255*$b+0.5));
}
sub hsvHex {
my ($hue, $sat, $val ) = @_;
my $h = int($hue * 6);
my $f = $hue * 6 - $h;
my $p = $val * (1 - $sat);
my $q = $val * ( 1 - $f * $sat);
my $t = $val * ( 1 - (1-$f) * $sat);
return hexTuple($val, $t, $p) if $h == 0 or $h == 6;
return hexTuple($q, $val, $p) if $h == 1;
return hexTuple($p, $val, $t) if $h == 2;
return hexTuple($p, $q, $val) if $h == 3;
return hexTuple($t, $p, $val) if $h == 4;
return hexTuple($val, $p, $q) if $h == 5;
die $h;
}
# https://en.wikipedia.org/wiki/HSL_and_HSV#From_HSL
sub hslHex {
my ($hue, $sat, $lig ) = @_;
$hue = $hue / 360.0;
my $h = ($hue * 6.0);
my $c = (1 - abs(2.0*$lig - 1)) * $sat;
my $h_mod_2 = $h - 2.0*int($h/2);
my $x = $c * (1 - abs($h_mod_2 - 1));
my ($r, $g, $b);
my $m = $lig - $c / 2.0;
return hexTuple($c + $m, $x + $m, 0 + $m) if $h < 1 or $h == 6;
return hexTuple($x + $m, $c + $m, 0 + $m) if $h < 2;
return hexTuple( 0 + $m, $c + $m, $x + $m) if $h < 3;
return hexTuple( 0 + $m, $x + $m, $c + $m) if $h < 4;
return hexTuple($x + $m, 0 + $m, $c + $m) if $h < 5;
return hexTuple($c + $m, 0 + $m, $x + $m) if $h < 6;
die $h;
}
my @hexDigit = split //, '0123456789abcdef';
my %hexValue = map(
(lc($hexDigit[$_]) => $_, uc($hexDigit[$_]) => $_ ),
0..15 );
sub min {
my $min = shift;
for (@_) { $min = $_ if $_ < $min }
return $min;
}
sub max {
my $max = shift;
for (@_) { $max = $_ if $_ > $max }
return $max;
}
sub hexToRGB {
my $hexTriplet = shift;
my @d = $hexTriplet =~ /^#?(.)(.)(.)(.)(.)(.)/;
return (16 * $hexValue{$d[0]} + $hexValue{$d[1]},
16 * $hexValue{$d[2]} + $hexValue{$d[3]},
16 * $hexValue{$d[4]} + $hexValue{$d[5]});
}
sub hexToHSL {
my $hexTriplet = shift;
my ($r,$g,$b) = hexToRGB($hexTriplet);
warn "$hexTriplet -> $r:$g:$b";
for ($r, $g, $b ) { $_ = $_ / 255.0 }
my $M = max($r, $g, $b);
my $m = min($r, $g, $b);
my $C = $M - $m;
my $h;
if ($C == 0) {
$h = 0;
}
elsif ( $r == $M ) {
$h = ($g-$b)/$C;
$h -= 6*int($h/6.0);
}
elsif ( $g == $M ) {
$h = ($b-$r)/$C + 2;
}
elsif ( $b == $M ) {
$h = ($r-$g)/$C + 4;
}
else { die "$C, $M, $r, $g, $b"; }
my $H = 60 * $h;
my $L = ($M + $m) / 2;
my $S = ( $L <= 0.5 ) ? $C/(2*$L) : $C / (2-2*$L);
return( $H, $S, $L );
}
my $baseColorHSV = [ hexToHSL('#935ff2') ];
my $baseColorHue = $baseColorHSV->[0];
warn sprintf( 'H:%1.4f S:%1.4f V:%1.4f', @$baseColorHSV );
warn sprintf( 'H:%1.4f S:%1.4f L:%1.4f', hexToHSL('#3e148c') );
my @target = hexToRGB('#935ff2');
my ($best, $min_dist);
for (my $s = 0.50; $s < 0.90; $s += 0.001) {
for ( my $l = 0.50; $l <= 0.80; $l += 0.001 ) {
my $hexColor = hslHex($baseColorHue, $s, $l);
my ($r,$g,$b) = hexToRGB( $hexColor );
my $dist = abs($r-$target[0])
+ abs($g-$target[1])
+ abs($b-$target[2]);
if (not defined($best) or $dist < $min_dist) {
$best = [ $s, $l, $hexColor ];
$min_dist = $dist;
}
}
}
warn sprintf( 's%1.3f, l%1.3f -> %s',
@$best );
my $baseTheme = "AppTheme";
use constant STEP_DEGREES => 5;
# # hsb
# for( my $hue = 0; $hue < 360; $hue += STEP_DEGREES ) {
# printf "\n";
# }
# HSL
sub outputThemes {
my $out = shift;
my $baseIndent = shift;
for( my $hue = 0; $hue < 360; $hue += STEP_DEGREES ) {
$out->print("\n");
$out->print(hslStyleForHue($hue, $baseTheme, $baseIndent));
}
}
sub hslStyleForHue {
my $hue = shift;
my $base = shift;
my $baseIndent = shift // '';
my %lQ = (
0 => 0.450, # red
60 => 0.400, # yellow
120 => 0.400, # green
180 => 0.400, # cyan
240 => 0.750, # blue
300 => 0.500, # magenta
);
$lQ{360} = $lQ{0};
my ($x0, $x1, $y0, $y1);
$x0 = (int( $hue / 60 ) * 60) % 360;
$x1 = $x0 + 60;
$y0 = $lQ{$x0};
$y1 = $lQ{$x1};
# linear interpolation
my $l1 = $y0 + 1.0 * ( $hue - $x0 ) * ( $y1 - $y0 ) / ( $x1 - $x0 );
my $l2 = $l1 * 0.80;
my $l3 = 0.950;
my $l4 = 0.980;
my $result = "";
my $indent = "$baseIndent ";
if ($base) {
$result .= sprintf "$baseIndent\n";
return $result;
}
my $xml = shift;
if ($xml) {
my $start_marker = '';
my $end_marker = '';
my ($fh, $filename) = tempfile(basename($0).'.XXXXXXXX', DIR => dirname($xml));
open(my $in, '<', $xml);
my $base_indent = '';
my $state = 'waiting-for-start-marker';
while (<$in>) {
if ( $state eq 'waiting-for-start-marker' ) {
print $fh $_;
$state = 'skipping-styles', $base_indent = $1
if /^(\s*)\Q$start_marker\E/;
next;
}
if ( $state eq 'skipping-styles' ) {
next unless /^\s*\Q$end_marker\E/;
outputThemes($fh, $base_indent);
print $fh $_;
$state = 'copying-the-rest';
next;
}
if ( $state eq 'copying-the-rest') {
print $fh $_;
next;
}
die "Unexpected state '$state'";
}
close($fh);
close($in);
rename($filename, $xml);
}
else {
outputThemes(\*STDOUT);
}