3 use strict; use warnings; use utf8::all;
6 use File::Basename qw(basename dirname);
7 use File::Temp qw(tempfile);
13 'night!' => \$opt_night,
16 my $DEFAULT_HUE = 261.2245;
20 return sprintf('%02x%02x%02x', int(255*$r+0.5), int(255*$g+0.5), int(255*$b+0.5));
23 my ($hue, $sat, $val ) = @_;
24 my $h = int($hue * 6);
25 my $f = $hue * 6 - $h;
26 my $p = $val * (1 - $sat);
27 my $q = $val * ( 1 - $f * $sat);
28 my $t = $val * ( 1 - (1-$f) * $sat);
30 return hexTuple($val, $t, $p) if $h == 0 or $h == 6;
31 return hexTuple($q, $val, $p) if $h == 1;
32 return hexTuple($p, $val, $t) if $h == 2;
33 return hexTuple($p, $q, $val) if $h == 3;
34 return hexTuple($t, $p, $val) if $h == 4;
35 return hexTuple($val, $p, $q) if $h == 5;
40 # https://en.wikipedia.org/wiki/HSL_and_HSV#From_HSL
42 my ($hue, $sat, $lig ) = @_;
45 my $c = (1 - abs(2.0*$lig - 1)) * $sat;
46 my $h_mod_2 = $h - 2.0*int($h/2);
47 my $x = $c * (1 - abs($h_mod_2 - 1));
49 my $m = $lig - $c / 2.0;
51 return hexTuple($c + $m, $x + $m, 0 + $m) if $h < 1 or $h == 6;
52 return hexTuple($x + $m, $c + $m, 0 + $m) if $h < 2;
53 return hexTuple( 0 + $m, $c + $m, $x + $m) if $h < 3;
54 return hexTuple( 0 + $m, $x + $m, $c + $m) if $h < 4;
55 return hexTuple($x + $m, 0 + $m, $c + $m) if $h < 5;
56 return hexTuple($c + $m, 0 + $m, $x + $m) if $h < 6;
61 my @hexDigit = split //, '0123456789abcdef';
63 (lc($hexDigit[$_]) => $_, uc($hexDigit[$_]) => $_ ),
69 for (@_) { $min = $_ if $_ < $min }
77 for (@_) { $max = $_ if $_ > $max }
83 my $hexTriplet = shift;
85 my @d = $hexTriplet =~ /^#?(.)(.)(.)(.)(.)(.)/;
87 return (16 * $hexValue{$d[0]} + $hexValue{$d[1]},
88 16 * $hexValue{$d[2]} + $hexValue{$d[3]},
89 16 * $hexValue{$d[4]} + $hexValue{$d[5]});
93 my $hexTriplet = shift;
95 my ($r,$g,$b) = hexToRGB($hexTriplet);
96 #warn "$hexTriplet -> $r:$g:$b";
98 for ($r, $g, $b ) { $_ = $_ / 255.0 }
100 my $M = max($r, $g, $b);
101 my $m = min($r, $g, $b);
118 else { die "$C, $M, $r, $g, $b"; }
121 my $L = ($M + $m) / 2;
123 my $S = ( $L <= 0.5 ) ? $C/(2*$L) : $C / (2-2*$L);
125 return( $H, $S, $L );
128 my $baseColor = '#935ff2';
129 my $baseColorHSV = [ hexToHSL($baseColor) ];
130 my $baseColorHue = $baseColorHSV->[0];
131 warn sprintf( '%s → H:%1.4f S:%1.4f V:%1.4f', $baseColor, @$baseColorHSV );
132 my @target = hexToRGB($baseColor);
133 my ($best, $min_dist);
134 for (my $s = 0.50; $s < 0.90; $s += 0.001) {
135 for ( my $l = 0.50; $l <= 0.80; $l += 0.001 ) {
136 my $hexColor = hslHex($baseColorHue, $s, $l);
137 my ($r,$g,$b) = hexToRGB( $hexColor );
138 my $dist = abs($r-$target[0])
140 + abs($b-$target[2]);
141 if (not defined($best) or $dist < $min_dist) {
142 $best = [ $s, $l, $hexColor ];
147 warn sprintf( 's%1.3f, l%1.3f → %s',
150 my $baseTheme = "AppTheme";
152 use constant STEP_DEGREES => 5;
155 # for( my $hue = 0; $hue < 360; $hue += STEP_DEGREES ) {
156 # printf "<style name=\"%s.%03d\" parent=\"%s\">\n",
157 # $baseTheme, $hue, $baseTheme;
158 # printf " <item name=\"colorPrimary\">#%s</item>\n",
159 # hsvHex($hue/360.0, 0.61, 0.95);
160 # printf " <item name=\"colorPrimaryDark\">#%s</item>\n",
161 # hsvHex($hue/360.0, 0.86, 0.55);
162 # printf " <item name=\"colorAccent\">#%s</item>\n",
163 # hsvHex(($hue-4)/360.0, 0.72, 0.82);
164 # printf " <item name=\"table_row_dark_bg\">#28%s</item>\n",
165 # hsvHex($hue/360.0, 0.65, 0.83);
166 # printf " <item name=\"table_row_light_bg\">#28%s</item>\n",
167 # hsvHex($hue/360.0, 0.20, 1.00);
168 # printf " <item name=\"header_border\">#80%s</item>\n",
169 # hsvHex(($hue+6)/360.0, 0.86, 0.55);
170 # printf "</style>\n";
176 my $baseIndent = shift;
178 $out->print(hslStyleForHue($DEFAULT_HUE, $baseTheme, $baseIndent, 'default'));
179 for( my $hue = 0; $hue < 360; $hue += STEP_DEGREES ) {
181 $out->print(hslStyleForHue($hue, $baseTheme, $baseIndent));
188 my $baseIndent = shift // '';
189 my $subTheme = shift // sprintf('%03d', $hue);
193 60 => 0.400, # yellow
194 120 => 0.400, # green
197 300 => 0.505, # magenta
201 my ($x0, $x1, $y0, $y1);
202 $x0 = (int( $hue / 60 ) * 60) % 360;
207 # linear interpolation
208 my $l1 = $y0 + 1.0 * ( $hue - $x0 ) * ( $y1 - $y0 ) / ( $x1 - $x0 );
211 my $l3 = $opt_night ? 0.200 : 0.950;
212 my $l4 = $opt_night ? 0.100 : 0.980;
215 my $indent = "$baseIndent ";
218 $result .= sprintf "$baseIndent<style name=\"%s.%s\" parent=\"%s\">\n",
219 $baseTheme, $subTheme, $baseTheme;
222 $result .= sprintf "$baseIndent<style name=\"%s\">\n",
224 # $result .= "$indent<item name=\"windowActionBar\">false</item>\n";
225 # $result .= "$indent<item name=\"windowNoTitle\">true</item>\n";
226 # $result .= "$indent<item name=\"textColor\">#757575</item>\n";
229 $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
230 'colorPrimary', hslHex( $hue, $S, $l1 );
231 $result .= sprintf "$indent<item name=\"%s\">#00%s</item>\n",
232 'colorPrimaryTransparent', hslHex( $hue, $S, $l1 );
233 $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
234 'colorAccent', hslHex( $hue, $S, $l2 );
235 $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
236 'colorPrimaryDark', hslHex( $hue, $S, $l2 );
237 $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
238 'table_row_dark_bg', hslHex( $hue, $S, $l3 );
239 $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
240 'table_row_light_bg', hslHex( $hue, $S, $l4 );
241 $result .= "$baseIndent</style>\n";
249 my $start_marker = '<!-- theme list start -->';
250 my $end_marker = '<!-- theme list end -->';
251 my ($fh, $filename) = tempfile(basename($0).'.XXXXXXXX', DIR => dirname($xml));
252 $fh->binmode(':utf8');
253 open(my $in, '<', $xml);
254 my $base_indent = '';
255 my $state = 'waiting-for-start-marker';
257 if ( $state eq 'waiting-for-start-marker' ) {
259 $state = 'skipping-styles', $base_indent = $1
260 if /^(\s*)\Q$start_marker\E/;
263 if ( $state eq 'skipping-styles' ) {
264 next unless /^\s*\Q$end_marker\E/;
265 outputThemes($fh, $base_indent);
267 $state = 'copying-the-rest';
270 if ( $state eq 'copying-the-rest') {
275 die "Unexpected state '$state'";
281 rename($filename, $xml);
284 outputThemes(\*STDOUT);