]> git.ktnx.net Git - mobile-ledger.git/blob - tools/gen-styles
ignore request to update the last update date when there is no current profile
[mobile-ledger.git] / tools / gen-styles
1 #!/usr/bin/perl
2
3 use strict; use warnings; use utf8;
4 use autodie;
5 use Math::Trig;
6 use File::Basename qw(basename dirname);
7 use File::Temp qw(tempfile);
8
9 sub hexTuple {
10         my ($r, $g, $b) = @_;
11         return sprintf('%02x%02x%02x', int(255*$r+0.5), int(255*$g+0.5), int(255*$b+0.5));
12 }
13 sub hsvHex {
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);
20
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;
27
28         die $h;
29 }
30
31 # https://en.wikipedia.org/wiki/HSL_and_HSV#From_HSL
32 sub hslHex {
33         my ($hue, $sat, $lig ) = @_;
34         $hue = $hue / 360.0;
35         my $h = ($hue * 6.0);
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));
39         my ($r, $g, $b);
40         my $m = $lig - $c / 2.0;
41
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;
48
49         die $h;
50 }
51
52 my @hexDigit = split //, '0123456789abcdef';
53 my %hexValue = map(
54         (lc($hexDigit[$_]) => $_, uc($hexDigit[$_]) => $_ ),
55         0..15 );
56
57 sub min {
58         my $min = shift;
59
60         for (@_) { $min = $_ if $_ < $min }
61
62         return $min;
63 }
64
65 sub max {
66         my $max = shift;
67
68         for (@_) { $max = $_ if $_ > $max }
69
70         return $max;
71 }
72
73 sub hexToRGB {
74         my $hexTriplet = shift;
75
76         my @d = $hexTriplet =~ /^#?(.)(.)(.)(.)(.)(.)/;
77
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]});
81 }
82
83 sub hexToHSL {
84         my $hexTriplet = shift;
85
86         my ($r,$g,$b) = hexToRGB($hexTriplet);
87         warn "$hexTriplet -> $r:$g:$b";
88
89         for ($r, $g, $b ) { $_ = $_ / 255.0 }
90
91         my $M = max($r, $g, $b);
92         my $m = min($r, $g, $b);
93         my $C = $M - $m;
94
95         my $h;
96         if ($C == 0) {
97                 $h = 0;
98         }
99         elsif ( $r == $M ) {
100                 $h = ($g-$b)/$C;
101                 $h -= 6*int($h/6.0);
102         }
103         elsif ( $g == $M ) {
104                 $h = ($b-$r)/$C + 2;
105         }
106         elsif ( $b == $M ) {
107                 $h = ($r-$g)/$C + 4;
108         }
109         else { die "$C, $M, $r, $g, $b"; }
110
111         my $H = 60 * $h;
112         my $L = ($M + $m) / 2;
113
114         my $S = ( $L <= 0.5 ) ? $C/(2*$L) : $C / (2-2*$L);
115
116         return( $H, $S, $L );
117 }
118
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])
130                          + abs($g-$target[1])
131                          + abs($b-$target[2]);
132                 if (not defined($best) or $dist < $min_dist) {
133                         $best = [ $s, $l, $hexColor ];
134                         $min_dist = $dist;
135                 }
136         }
137 }
138 warn sprintf( 's%1.3f, l%1.3f -> %s',
139         @$best );
140
141 my $baseTheme = "AppTheme.NoActionBar";
142
143 # # hsb
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";
161 # }
162
163 # HSL
164 sub outputThemes {
165         my $out = shift;
166         $out->print(hslStyleForHue($baseColorHue));
167         for( my $hue = 0; $hue < 360; $hue += 15 ) {
168                 $out->print(hslStyleForHue($hue, $baseTheme));
169         }
170 }
171
172 sub hslStyleForHue {
173         my $hue = shift;
174         my $base = shift;
175
176         my $blueL = 0.665;
177         my $yellowL = 0.350;
178
179         my $blueL2 = 0.350;
180         my $yellowL2 = 0.500;
181
182         # $y == 0 for yellow
183         my $y = $hue - 60;
184         $y += 360 if $y < 0;
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;
189         my $l3 = 0.950;
190         my $l4 = 0.980;
191
192         my $result = "";
193
194         if ($base) {
195                 $result .= sprintf "<style name=\"%s.%d\" parent=\"%s\">\n",
196                         $baseTheme, $hue, $baseTheme;
197         }
198         else {
199                 $result .= sprintf "<style name=\"%s\">\n",
200                         $baseTheme;
201                 $result .= "  <item name=\"windowActionBar\">false</item>\n";
202                 $result .= "  <item name=\"windowNoTitle\">true</item>\n";
203                 $result .= "  <item name=\"textColor\">#8a000000</item>\n";
204         }
205         my $S = 0.845;
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";
218
219         return $result;
220 }
221
222 my $xml = shift;
223
224 if ($xml) {
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';
230         while (<$in>) {
231                 if ( $state eq 'waiting-for-start-marker' ) {
232                         print $fh $_;
233                         $state = 'skipping-styles' if /^\s*\Q$start_marker\E/;
234                         next;
235                 }
236                 if ( $state eq 'skipping-styles' ) {
237                         next unless /^\s*\Q$end_marker\E/;
238                         outputThemes($fh);
239                         print $fh $_;
240                         $state = 'copying-the-rest';
241                         next;
242                 }
243                 if ( $state eq 'copying-the-rest') {
244                         print $fh $_;
245                         next;
246                 }
247
248                 die "Unexpected state '$state'";
249         }
250
251         close($fh);
252         close($in);
253
254         rename($filename, $xml);
255 }
256 else {
257         outputThemes(\*STDOUT);
258 }