#!/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.NoActionBar"; # # hsb # for( my $hue = 0; $hue < 360; $hue += 15 ) { # printf "\n"; # } # HSL sub outputThemes { my $out = shift; $out->print(hslStyleForHue($baseColorHue)); for( my $hue = 0; $hue < 360; $hue += 15 ) { $out->print(hslStyleForHue($hue, $baseTheme)); } } sub hslStyleForHue { my $hue = shift; my $base = shift; my $blueL = 0.665; my $yellowL = 0.350; my $y = $hue - 60; $y += 360 if $y < 0; my $q = cos(deg2rad(abs($y-180)/2.0)); my $l1 = $yellowL + ($blueL - $yellowL) * $q; my $l2 = 0.150 + 0.350 * $q; my $l3 = 0.950; my $l4 = 0.980; my $result = ""; if ($base) { $result .= sprintf "\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 $state = 'waiting-for-start-marker'; while (<$in>) { if ( $state eq 'waiting-for-start-marker' ) { print $fh $_; $state = 'skipping-styles' if /^\s*\Q$start_marker\E/; next; } if ( $state eq 'skipping-styles' ) { next unless /^\s*\Q$end_marker\E/; outputThemes($fh); 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); }