3 use strict; use warnings; use utf8::all;
8 use Types::Standard qw(StrictNum);
9 my $colorValue = Type::Tiny->new(
11 constraint => '($_ >= 0) and ($_ <= 1)'
18 has h => ( is => 'ro', isa => $colorValue );
19 has s => ( is => 'ro', isa => $colorValue );
20 has l => ( is => 'ro', isa => $colorValue );
24 use Types::Standard qw(StrictNum);
25 use List::MoreUtils qw(minmax);
29 use overload '""' => 'hexTuple';
31 has r => ( is => 'ro', isa => $colorValue );
32 has g => ( is => 'ro', isa => $colorValue );
33 has b => ( is => 'ro', isa => $colorValue );
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 ) );
43 # https://www.w3.org/TR/2008/REC-WCAG20-20081211/#relativeluminancedef
45 return $_[0] / 12.92 if $_[0] <= 0.03928;
46 return ( ( $_[0] + 0.055 ) / 1.055 )**2.4;
49 sub relativeLuminance {
52 return 0.2126 * _norm( $self->r ) + 0.7152 * _norm( $self->g )
53 + 0.0722 * _norm( $self->b );
57 shift->new( r => 0, g => 0, b => 0 );
61 shift->new( r => 1, g => 1, b => 1 );
64 my @hexDigit = split //, '0123456789abcdef';
66 map( ( lc( $hexDigit[$_] ) => $_, uc( $hexDigit[$_] ) => $_ ), 0 .. 15 );
69 my ( $class, $triplet ) = @_;
71 my @d = $triplet =~ /^#?(.)(.)(.)(.)(.)(.)$/
72 or die "'$triplet' is not a valid colour triplet";
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
81 # https://en.wikipedia.org/wiki/HSL_and_HSV#From_HSL
83 my ( $class, $hsl ) = @_;
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 ) );
93 my $m = $lig - $c / 2.0;
95 return $class->new( r => $c + $m, g => $x + $m, b => 0 + $m )
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;
109 my ( $m, $M ) = minmax( $self->r, $self->g, $self->b );
117 elsif ( $self->r == $M ) {
118 $h = ( $self->g - $self->b ) / $C;
119 $h -= 6 * int( $h / 6.0 );
121 elsif ( $self->g == $M ) {
122 $h = ( $self->b - $self->r ) / $C + 2;
124 elsif ( $self->b == $M ) {
125 $h = ( $self->r - $self->g ) / $C + 4;
127 else { die "$C, $M, $self"; }
130 my $L = ( $M + $m ) / 2;
132 my $S = ( $L <= 0.5 ) ? $C / ( 2 * $L ) : $C / ( 2 - 2 * $L );
134 return Color::HSL->new( h => $H/360.0, s => $S, l => $L );
138 my ( $self, $ref ) = @_;
140 my $myL = $self->relativeLuminance;
141 my $refL = $ref->relativeLuminance;
143 my $ratio = ( $myL + 0.05 ) / ( $refL + 0.05 );
144 $ratio = 1 / $ratio if $ratio < 1;
151 use File::Basename qw(basename dirname);
152 use File::Temp qw(tempfile);
158 'night!' => \$opt_night,
161 my $DEFAULT_HUE = 261.2245;
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));
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);
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;
186 my ( $h, $s, $l ) = @_;
187 return Color::sRGB->fromHSL(
188 Color::HSL->new( { h => $h / 360.0, s => $s, l => $l } ) )->hexTuple;
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",
195 Color::sRGB->new( r => 0.5, g => 0.5, b => 0.5 )->relativeLuminance );
197 my $baseColor = '#935ff2';
198 my $baseColorRGB = Color::sRGB->fromHexTriplet($baseColor);
199 my $baseColorHSL = $baseColorRGB->toHSL;
200 my $baseColorHue = $baseColorHSL->h;
202 '%s → H:%1.4f S:%1.4f L:%1.4f (luminance: %1.4f; cW: %1.4f, cB: %1.4f)',
204 360 * $baseColorHSL->h,
207 $baseColorRGB->relativeLuminance,
208 $baseColorRGB->contrastWith( Color::sRGB->WHITE ),
209 $baseColorRGB->contrastWith( Color::sRGB->BLACK ),
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 ) );
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 ];
228 # warn sprintf( 's%1.3f, l%1.3f → %s', @$best );
230 my $baseTheme = "AppTheme";
232 use constant STEP_DEGREES => 5;
236 my $baseIndent = shift;
239 hslStyleForHue( $DEFAULT_HUE, $baseTheme, $baseIndent, 'default' ) );
240 for ( my $hue = 0; $hue < 360; $hue += STEP_DEGREES ) {
242 $out->print( hslStyleForHue( $hue, $baseTheme, $baseIndent ) );
246 sub bestLightnessForHue {
248 my $targetContrast = $opt_night ? 5.16 : 4.07;
249 my $white = $opt_night ? Color::sRGB->BLACK : Color::sRGB->WHITE;
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);
257 if ( defined $bestLightness ) {
258 if (abs( $contrast - $targetContrast ) <
259 abs( $bestContrast - $targetContrast ) )
262 $bestContrast = $contrast;
267 $bestContrast = $contrast;
272 "Found best lightness for hue %1.4f: %1.4f (contrast %1.4f)\n",
273 360 * $h, $bestLightness, $bestContrast );
274 return $bestLightness;
280 my $baseIndent = shift // '';
281 my $subTheme = shift // sprintf('%03d', $hue);
285 60 => 0.250, # yellow
286 120 => 0.290, # green
289 300 => 0.450, # magenta
293 my ($x0, $x1, $y0, $y1);
294 $x0 = (int( $hue / 60 ) * 60) % 360;
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;
306 #my $l2 = $opt_night ? ( $l1 + ( 1 - $l1 ) * 0.15 ) : $l1 * 0.85;
308 my $l3 = $opt_night ? 0.150 : 0.950;
309 my $l4 = $opt_night ? 0.100 : 0.980;
312 my $indent = "$baseIndent ";
315 $result .= sprintf "$baseIndent<style name=\"%s.%s\" parent=\"%s\">\n",
316 $baseTheme, $subTheme, $baseTheme;
319 $result .= sprintf "$baseIndent<style name=\"%s\">\n",
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";
326 $result .= sprintf "$indent<!-- h: %1.4f s:%1.4f l:%1.4f -->\n", $hue,
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";
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';
356 if ( $state eq 'waiting-for-start-marker' ) {
358 $state = 'skipping-styles', $base_indent = $1
359 if /^(\s*)\Q$start_marker\E/;
362 if ( $state eq 'skipping-styles' ) {
363 next unless /^\s*\Q$end_marker\E/;
364 outputThemes($fh, $base_indent);
366 $state = 'copying-the-rest';
369 if ( $state eq 'copying-the-rest') {
374 die "Unexpected state '$state'";
380 rename($filename, $xml);
383 outputThemes(\*STDOUT);