]> git.ktnx.net Git - mobile-ledger.git/blob - tools/gen-styles
typo in method name
[mobile-ledger.git] / tools / gen-styles
1 #!/usr/bin/perl
2
3 use strict; use warnings; use utf8::all;
4 use autodie;
5 use Carp;
6
7 use Type::Tiny;
8 use Types::Standard qw(StrictNum);
9 my $colorValue = Type::Tiny->new(
10     parent     => StrictNum,
11     constraint => '($_ >= 0) and ($_ <= 1)'
12 );
13
14 package Color::HSL;
15 use Moo;
16 use namespace::clean;
17
18 has h => ( is => 'ro', isa => $colorValue );
19 has s => ( is => 'ro', isa => $colorValue );
20 has l => ( is => 'ro', isa => $colorValue );
21
22 package Color::sRGB;
23 use Moo;
24 use Types::Standard qw(StrictNum);
25 use List::MoreUtils qw(minmax);
26
27 use namespace::clean;
28
29 use overload '""' => 'hexTuple';
30
31 has r => ( is => 'ro', isa => $colorValue );
32 has g => ( is => 'ro', isa => $colorValue );
33 has b => ( is => 'ro', isa => $colorValue );
34
35 sub hexTuple {
36     my $self = shift;
37     return sprintf( '%02x%02x%02x',
38         int( $self->r * 255 + 0.5 ),
39         int( $self->g * 255 + 0.5 ),
40         int( $self->b * 255 + 0.5 ) );
41 }
42
43 # https://www.w3.org/TR/2008/REC-WCAG20-20081211/#relativeluminancedef
44 sub _norm {
45     return $_[0] / 12.92 if $_[0] <= 0.03928;
46     return ( ( $_[0] + 0.055 ) / 1.055 )**2.4;
47 }
48
49 sub relativeLuminance {
50     my $self = shift;
51
52     return 0.2126 * _norm( $self->r ) + 0.7152 * _norm( $self->g )
53         + 0.0722 * _norm( $self->b );
54 }
55
56 sub BLACK {
57     shift->new( r => 0, g => 0, b => 0 );
58 }
59
60 sub WHITE {
61     shift->new( r => 1, g => 1, b => 1 );
62 }
63
64 my @hexDigit = split //, '0123456789abcdef';
65 my %hexValue =
66     map( ( lc( $hexDigit[$_] ) => $_, uc( $hexDigit[$_] ) => $_ ), 0 .. 15 );
67
68 sub fromHexTriplet {
69     my ( $class, $triplet ) = @_;
70
71     my @d = $triplet =~ /^#?(.)(.)(.)(.)(.)(.)$/
72         or die "'$triplet' is not a valid colour triplet";
73
74     return $class->new(
75         r => ( 16 * $hexValue{ $d[0] } + $hexValue{ $d[1] } ) / 255.0,
76         g => ( 16 * $hexValue{ $d[2] } + $hexValue{ $d[3] } ) / 255.0,
77         b => ( 16 * $hexValue{ $d[4] } + $hexValue{ $d[5] } ) / 255.0
78     );
79 }
80
81 # https://en.wikipedia.org/wiki/HSL_and_HSV#From_HSL
82 sub fromHSL {
83     my ( $class, $hsl ) = @_;
84     my $hue = $hsl->h;
85     my $sat = $hsl->s;
86     my $lig = $hsl->l;
87
88     my $h       = ( $hue * 6.0 );
89     my $c       = ( 1 - abs( 2.0 * $lig - 1 ) ) * $sat;
90     my $h_mod_2 = $h - 2.0 * int( $h / 2 );
91     my $x       = $c * ( 1 - abs( $h_mod_2 - 1 ) );
92     my ( $r, $g, $b );
93     my $m = $lig - $c / 2.0;
94
95     return $class->new( r => $c + $m, g => $x + $m, b => 0 + $m )
96         if $h < 1 or $h == 6;
97     return $class->new( r => $x + $m, g => $c + $m, b => 0 + $m )  if $h < 2;
98     return $class->new( r => 0 + $m,  g => $c + $m, b => $x + $m ) if $h < 3;
99     return $class->new( r => 0 + $m,  g => $x + $m, b => $c + $m ) if $h < 4;
100     return $class->new( r => $x + $m, g => 0 + $m,  b => $c + $m ) if $h < 5;
101     return $class->new( r => $c + $m, g => 0 + $m,  b => $x + $m ) if $h < 6;
102
103     die $h;
104 }
105
106 sub toHSL {
107     my $self = shift;
108
109     my ( $m, $M ) = minmax( $self->r, $self->g, $self->b );
110
111     my $C = $M - $m;
112
113     my $h;
114     if ( $C == 0 ) {
115         $h = 0;
116     }
117     elsif ( $self->r == $M ) {
118         $h = ( $self->g - $self->b ) / $C;
119         $h -= 6 * int( $h / 6.0 );
120     }
121     elsif ( $self->g == $M ) {
122         $h = ( $self->b - $self->r ) / $C + 2;
123     }
124     elsif ( $self->b == $M ) {
125         $h = ( $self->r - $self->g ) / $C + 4;
126     }
127     else { die "$C, $M, $self"; }
128
129     my $H = 60 * $h;
130     my $L = ( $M + $m ) / 2;
131
132     my $S = ( $L <= 0.5 ) ? $C / ( 2 * $L ) : $C / ( 2 - 2 * $L );
133
134     return Color::HSL->new( h => $H/360.0, s => $S, l => $L );
135 }
136
137 sub contrastWith {
138     my ( $self, $ref ) = @_;
139
140     my $myL = $self->relativeLuminance;
141     my $refL = $ref->relativeLuminance;
142
143     my $ratio = ( $myL + 0.05 ) / ( $refL + 0.05 );
144     $ratio = 1 / $ratio if $ratio < 1;
145     return $ratio;
146 }
147
148 package MAIN;
149
150 use Math::Trig;
151 use File::Basename qw(basename dirname);
152 use File::Temp qw(tempfile);
153 use Getopt::Long;
154
155 my $opt_night;
156
157 GetOptions(
158     'night!'    => \$opt_night,
159 ) or exit 1;
160
161 my $DEFAULT_HUE = 261.2245;
162
163 sub hexTuple {
164         my ($r, $g, $b) = @_;
165         return sprintf('%02x%02x%02x', int(255*$r+0.5), int(255*$g+0.5), int(255*$b+0.5));
166 }
167 sub hsvHex {
168         my ($hue, $sat, $val ) = @_;
169         my $h = int($hue * 6);
170         my $f = $hue * 6 - $h;
171         my $p = $val * (1 - $sat);
172         my $q = $val * ( 1 - $f * $sat);
173         my $t = $val * ( 1 - (1-$f) * $sat);
174
175         return hexTuple($val, $t, $p) if $h == 0 or $h == 6;
176         return hexTuple($q, $val, $p) if $h == 1;
177         return hexTuple($p, $val, $t) if $h == 2;
178         return hexTuple($p, $q, $val) if $h == 3;
179         return hexTuple($t, $p, $val) if $h == 4;
180         return hexTuple($val, $p, $q) if $h == 5;
181
182         die $h;
183 }
184
185 sub hslHex {
186     my ( $h, $s, $l ) = @_;
187     return Color::sRGB->fromHSL(
188         Color::HSL->new( { h => $h / 360.0, s => $s, l => $l } ) )->hexTuple;
189 }
190
191 warn sprintf("%s: %2.1f\n", 'white', Color::sRGB->WHITE->relativeLuminance);
192 warn sprintf("%s: %2.1f\n", 'black', Color::sRGB->BLACK->relativeLuminance);
193 warn sprintf( "%s: %2.1f\n",
194     '50% gray',
195     Color::sRGB->new( r => 0.5, g => 0.5, b => 0.5 )->relativeLuminance );
196
197 my $baseColor = '#935ff2';
198 my $baseColorRGB = Color::sRGB->fromHexTriplet($baseColor);
199 my $baseColorHSL = $baseColorRGB->toHSL;
200 my $baseColorHue = $baseColorHSL->h;
201 warn sprintf(
202     '%s → H:%1.4f S:%1.4f L:%1.4f (luminance: %1.4f; cW: %1.4f, cB: %1.4f)',
203     $baseColor,
204     360 * $baseColorHSL->h,
205     $baseColorHSL->s,
206     $baseColorHSL->l,
207     $baseColorRGB->relativeLuminance,
208     $baseColorRGB->contrastWith( Color::sRGB->WHITE ),
209     $baseColorRGB->contrastWith( Color::sRGB->BLACK ),
210 );
211 # # find best saturation/lightness for the desired color
212 # # test if the above is correct
213 # my ($best, $min_dist);
214 # for (my $s = 0.50; $s < 0.90; $s += 0.001) {
215 #     for ( my $l = 0.50; $l <= 0.80; $l += 0.001 ) {
216 #         my $color = Color::sRGB->fromHSL(
217 #             Color::HSL->new( h => $baseColorHue, s => $s, l => $l ) );
218 #         my $dist =
219 #               abs( $color->r - $baseColorRGB->r )
220 #             + abs( $color->g - $baseColorRGB->g )
221 #             + abs( $color->b - $baseColorRGB->b );
222 #         if ( not defined($best) or $dist < $min_dist ) {
223 #             $best     = [ $s, $l, $color ];
224 #             $min_dist = $dist;
225 #         }
226 #     }
227 # }
228 # warn sprintf( 's%1.3f, l%1.3f → %s', @$best );
229
230 my $baseTheme = "AppTheme";
231
232 use constant STEP_DEGREES => 5;
233
234 sub outputThemes {
235     my $out        = shift;
236     my $baseIndent = shift;
237     $out->print("\n");
238     $out->print(
239         hslStyleForHue( $DEFAULT_HUE, $baseTheme, $baseIndent, 'default' ) );
240     for ( my $hue = 0; $hue < 360; $hue += STEP_DEGREES ) {
241         $out->print("\n");
242         $out->print( hslStyleForHue( $hue, $baseTheme, $baseIndent ) );
243     }
244 }
245
246 sub bestLightnessForHue {
247     my ( $h, $s ) = @_;
248     my $targetContrast = $opt_night ? 5.16 : 4.07;
249     my $white = $opt_night ? Color::sRGB->BLACK : Color::sRGB->WHITE;
250     my $bestLightness;
251     my $bestContrast;
252     for ( my $l = 0; $l < 1; $l += 0.002 ) {
253         my $contrast = Color::sRGB->fromHSL(
254             Color::HSL->new( { h => $h, s => $s, l => $l } ) )
255             ->contrastWith($white);
256
257         if ( defined $bestLightness ) {
258             if (abs( $contrast - $targetContrast ) <
259                 abs( $bestContrast - $targetContrast ) )
260             {
261                 $bestLightness = $l;
262                 $bestContrast  = $contrast;
263             }
264         }
265         else {
266             $bestLightness = $l;
267             $bestContrast = $contrast;
268         }
269     }
270
271     warn sprintf(
272         "Found best lightness for hue %1.4f: %1.4f (contrast %1.4f)\n",
273         360 * $h, $bestLightness, $bestContrast );
274     return $bestLightness;
275 }
276
277 sub hslStyleForHue {
278         my $hue = shift;
279         my $base = shift;
280         my $baseIndent = shift // '';
281         my $subTheme = shift // sprintf('%03d', $hue);
282
283         my %lQ = (
284                 0   => 0.550,   # red
285                 60  => 0.250,   # yellow
286                 120 => 0.290,   # green
287                 180 => 0.300,   # cyan
288                 240 => 0.680,   # blue
289                 300 => 0.450,   # magenta
290         );
291         $lQ{360} = $lQ{0};
292
293         my ($x0, $x1, $y0, $y1);
294         $x0 = (int( $hue / 60 ) * 60) % 360;
295         $x1 = $x0 + 60;
296         $y0 = $lQ{$x0};
297         $y1 = $lQ{$x1};
298
299         my $S = 0.8497;
300
301         # linear interpolation
302         #my $l1 = $y0 + 1.0 * ( $hue - $x0 ) * ( $y1 - $y0 ) / ( $x1 - $x0 );
303         my $l1 = bestLightnessForHue( $hue / 360.0, $S );
304         #$l1 += ( 1 - $l1 ) * 0.20 if $opt_night;
305
306         #my $l2 = $opt_night ? ( $l1 + ( 1 - $l1 ) * 0.15 ) : $l1 * 0.85;
307         my $l2 = $l1 * 0.80;
308         my $l3 = $opt_night ? 0.150                        : 0.950;
309         my $l4 = $opt_night ? 0.100                        : 0.980;
310
311         my $result = "";
312         my $indent = "$baseIndent    ";
313
314         if ($base) {
315                 $result .= sprintf "$baseIndent<style name=\"%s.%s\" parent=\"%s\">\n",
316                         $baseTheme, $subTheme, $baseTheme;
317         }
318         else {
319                 $result .= sprintf "$baseIndent<style name=\"%s\">\n",
320                         $baseTheme;
321 #                $result .= "$indent<item name=\"windowActionBar\">false</item>\n";
322 #                $result .= "$indent<item name=\"windowNoTitle\">true</item>\n";
323 #                $result .= "$indent<item name=\"textColor\">#757575</item>\n";
324         }
325
326         $result .= sprintf "$indent<!-- h: %1.4f s:%1.4f l:%1.4f -->\n", $hue,
327             $S, $l1 if 0;
328         $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
329             'colorPrimary', hslHex( $hue, $S, $l1 );
330         $result .= sprintf "$indent<item name=\"%s\">#00%s</item>\n",
331             'colorPrimaryTransparent', hslHex( $hue, $S, $l1 );
332         $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
333             'colorSecondary', hslHex( $hue, $S, $l1 );
334         $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
335             'colorPrimaryDark', hslHex( $hue, $S*0.8, $l2 );
336         $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
337             'table_row_dark_bg', hslHex( $hue, $S, $l3 );
338         $result .= sprintf "$indent<item name=\"%s\">#%s</item>\n",
339             'table_row_light_bg', hslHex( $hue, $S, $l4 );
340         $result .= "$baseIndent</style>\n";
341
342         return $result;
343 }
344
345 my $xml = shift;
346
347 if ($xml) {
348         my $start_marker = '<!-- theme list start -->';
349         my $end_marker = '<!-- theme list end -->';
350         my ($fh, $filename) = tempfile(basename($0).'.XXXXXXXX', DIR => dirname($xml));
351         $fh->binmode(':utf8');
352         open(my $in, '<', $xml);
353         my $base_indent = '';
354         my $state = 'waiting-for-start-marker';
355         while (<$in>) {
356                 if ( $state eq 'waiting-for-start-marker' ) {
357                         print $fh $_;
358                         $state = 'skipping-styles', $base_indent = $1
359                                 if /^(\s*)\Q$start_marker\E/;
360                         next;
361                 }
362                 if ( $state eq 'skipping-styles' ) {
363                         next unless /^\s*\Q$end_marker\E/;
364                         outputThemes($fh, $base_indent);
365                         print $fh $_;
366                         $state = 'copying-the-rest';
367                         next;
368                 }
369                 if ( $state eq 'copying-the-rest') {
370                         print $fh $_;
371                         next;
372                 }
373
374                 die "Unexpected state '$state'";
375         }
376
377         close($fh);
378         close($in);
379
380         rename($filename, $xml);
381 }
382 else {
383         outputThemes(\*STDOUT);
384 }