3 use strict; use warnings; use utf8;
6 use File::Basename qw(basename dirname);
7 use File::Temp qw(tempfile);
11 return sprintf('%02x%02x%02x', int(255*$r+0.5), int(255*$g+0.5), int(255*$b+0.5));
14 my ($hue, $sat, $val ) = @_;
15 my $h = int($hue * 6);
16 my $f = $hue * 6 - $h;
17 my $p = $val * (1 - $sat);
18 my $q = $val * ( 1 - $f * $sat);
19 my $t = $val * ( 1 - (1-$f) * $sat);
21 return hexTuple($val, $t, $p) if $h == 0 or $h == 6;
22 return hexTuple($q, $val, $p) if $h == 1;
23 return hexTuple($p, $val, $t) if $h == 2;
24 return hexTuple($p, $q, $val) if $h == 3;
25 return hexTuple($t, $p, $val) if $h == 4;
26 return hexTuple($val, $p, $q) if $h == 5;
31 # https://en.wikipedia.org/wiki/HSL_and_HSV#From_HSL
33 my ($hue, $sat, $lig ) = @_;
36 my $c = (1 - abs(2.0*$lig - 1)) * $sat;
37 my $h_mod_2 = $h - 2.0*int($h/2);
38 my $x = $c * (1 - abs($h_mod_2 - 1));
40 my $m = $lig - $c / 2.0;
42 return hexTuple($c + $m, $x + $m, 0 + $m) if $h < 1 or $h == 6;
43 return hexTuple($x + $m, $c + $m, 0 + $m) if $h < 2;
44 return hexTuple( 0 + $m, $c + $m, $x + $m) if $h < 3;
45 return hexTuple( 0 + $m, $x + $m, $c + $m) if $h < 4;
46 return hexTuple($x + $m, 0 + $m, $c + $m) if $h < 5;
47 return hexTuple($c + $m, 0 + $m, $x + $m) if $h < 6;
52 my @hexDigit = split //, '0123456789abcdef';
54 (lc($hexDigit[$_]) => $_, uc($hexDigit[$_]) => $_ ),
60 for (@_) { $min = $_ if $_ < $min }
68 for (@_) { $max = $_ if $_ > $max }
74 my $hexTriplet = shift;
76 my @d = $hexTriplet =~ /^#?(.)(.)(.)(.)(.)(.)/;
78 return (16 * $hexValue{$d[0]} + $hexValue{$d[1]},
79 16 * $hexValue{$d[2]} + $hexValue{$d[3]},
80 16 * $hexValue{$d[4]} + $hexValue{$d[5]});
84 my $hexTriplet = shift;
86 my ($r,$g,$b) = hexToRGB($hexTriplet);
87 warn "$hexTriplet -> $r:$g:$b";
89 for ($r, $g, $b ) { $_ = $_ / 255.0 }
91 my $M = max($r, $g, $b);
92 my $m = min($r, $g, $b);
109 else { die "$C, $M, $r, $g, $b"; }
112 my $L = ($M + $m) / 2;
114 my $S = ( $L <= 0.5 ) ? $C/(2*$L) : $C / (2-2*$L);
116 return( $H, $S, $L );
119 my $baseColorHSV = [ hexToHSL('#935ff2') ];
120 my $baseColorHue = $baseColorHSV->[0];
121 warn sprintf( 'H:%1.4f S:%1.4f V:%1.4f', @$baseColorHSV );
122 warn sprintf( 'H:%1.4f S:%1.4f L:%1.4f', hexToHSL('#3e148c') );
123 my @target = hexToRGB('#935ff2');
124 my ($best, $min_dist);
125 for (my $s = 0.50; $s < 0.90; $s += 0.001) {
126 for ( my $l = 0.50; $l <= 0.80; $l += 0.001 ) {
127 my $hexColor = hslHex($baseColorHue, $s, $l);
128 my ($r,$g,$b) = hexToRGB( $hexColor );
129 my $dist = abs($r-$target[0])
131 + abs($b-$target[2]);
132 if (not defined($best) or $dist < $min_dist) {
133 $best = [ $s, $l, $hexColor ];
138 warn sprintf( 's%1.3f, l%1.3f -> %s',
141 my $baseTheme = "AppTheme.NoActionBar";
144 # for( my $hue = 0; $hue < 360; $hue += 15 ) {
145 # printf "<style name=\"%s.%d\" parent=\"%s\">\n",
146 # $baseTheme, $hue, $baseTheme;
147 # printf " <item name=\"colorPrimary\">#%s</item>\n",
148 # hsvHex($hue/360.0, 0.61, 0.95);
149 # printf " <item name=\"colorPrimaryDark\">#%s</item>\n",
150 # hsvHex($hue/360.0, 0.86, 0.55);
151 # printf " <item name=\"colorAccent\">#%s</item>\n",
152 # hsvHex(($hue-4)/360.0, 0.72, 0.82);
153 # printf " <item name=\"drawer_background\">#ffffffff</item>\n";
154 # printf " <item name=\"table_row_dark_bg\">#28%s</item>\n",
155 # hsvHex($hue/360.0, 0.65, 0.83);
156 # printf " <item name=\"table_row_light_bg\">#28%s</item>\n",
157 # hsvHex($hue/360.0, 0.20, 1.00);
158 # printf " <item name=\"header_border\">#80%s</item>\n",
159 # hsvHex(($hue+6)/360.0, 0.86, 0.55);
160 # printf "</style>\n";
166 $out->print(hslStyleForHue($baseColorHue));
167 for( my $hue = 0; $hue < 360; $hue += 15 ) {
168 $out->print(hslStyleForHue($hue, $baseTheme));
180 my $yellowL2 = 0.500;
185 # $q == 0 for yellow, 1 for blue
186 my $q = cos(deg2rad(abs($y-180)/2.0));
187 my $l1 = $yellowL + ($blueL - $yellowL) * $q;
188 my $l2 = 0.250 + 0.250 * $q;
195 $result .= sprintf "<style name=\"%s.%d\" parent=\"%s\">\n",
196 $baseTheme, $hue, $baseTheme;
199 $result .= sprintf "<style name=\"%s\">\n",
201 $result .= " <item name=\"windowActionBar\">false</item>\n";
202 $result .= " <item name=\"windowNoTitle\">true</item>\n";
203 $result .= " <item name=\"textColor\">#8a000000</item>\n";
206 $result .= sprintf " <item name=\"colorPrimary\">#%s</item>\n",
207 hslHex($hue, $S, $l1);
208 $result .= sprintf " <item name=\"colorPrimaryTransparent\">#00%s</item>\n",
209 hslHex($hue, $S, $l1);
210 $result .= sprintf " <item name=\"colorAccent\">#%s</item>\n",
211 hslHex($hue, $S, $l2);
212 $result .= " <item name=\"drawer_background\">#ffffffff</item>\n";
213 $result .= sprintf " <item name=\"table_row_dark_bg\">#%s</item>\n",
214 hslHex($hue, $S, $l3);
215 $result .= sprintf " <item name=\"table_row_light_bg\">#%s</item>\n",
216 hslHex($hue, $S, $l4);
217 $result .= "</style>\n";
225 my $start_marker = '<!-- theme list start -->';
226 my $end_marker = '<!-- theme list end -->';
227 my ($fh, $filename) = tempfile(basename($0).'.XXXXXXXX', DIR => dirname($xml));
228 open(my $in, '<', $xml);
229 my $state = 'waiting-for-start-marker';
231 if ( $state eq 'waiting-for-start-marker' ) {
233 $state = 'skipping-styles' if /^\s*\Q$start_marker\E/;
236 if ( $state eq 'skipping-styles' ) {
237 next unless /^\s*\Q$end_marker\E/;
240 $state = 'copying-the-rest';
243 if ( $state eq 'copying-the-rest') {
248 die "Unexpected state '$state'";
254 rename($filename, $xml);
257 outputThemes(\*STDOUT);