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 }