Changes to dev/generate-rgb-codes.pl. All files

dev/generate-rgb-codes.pl

new file mode 100644@@ -0,0 +1,149 @@+#! perl+# Show Term::ANSIColor 216-cube of colors 000..555 arrayed as HSL grid+#+# Copyright 2019 William Ricker modifying code by Andy Lester+# License Same As Perl++use strict;+use warnings;+use 5.010001;++use Convert::Color;+use Convert::Color::HSL;+use Convert::Color::RGB;++use Term::ANSIColor;++use Readonly;+my Readonly $degrees = 12;  ## This is the number that avoids collisions+my Readonly $columns = 360 / $degrees;+++my $where_href = _save_rgb_grid();+_show_hue_sat_grid($where_href);+++# Helper to scale Term::ANSIColor 0..5 R,G,B to 0.0 .. 1.0 standard+sub _five_to_1{+    return shift()/5;+}+++sub _where {+    # pass in HSL object, returns xyz grid to display it on+    # if $degrees selected properly, won't cause collisions+    my $hsl = shift;+    my ($h, $s, $l) = $hsl->hsl;+    my $c = $hsl->chroma;+    my $y =  int 10*$l  ;+    my $z =  int 10*$s ;+    my $x = sprintf "%0d", ($degrees * int( ($h+($degrees/2))/$degrees  ));+    return  [ $x, $y, $z] ;+}+++## HSL "Grid"++# show Hue Sat Lum grid+# Modeled on Ack3 _show_rgb_grid, but with HSL iteration over sparce save matrix+# If a position is blank, repeat previous color+#+# Because 20 columns wide,+#    omits 'rgb' prefix+#    stacks text over background+#+# arguments+# Where = the hashref returned by sibling+#+#+sub _show_hue_sat_grid {+    my $where = shift;++    my (%Where) = ($where->%*);++    my @Hues =  map { $degrees * $_ } 0 .. ($columns-1);+    for my $z (sort {$b <=> $a} keys %Where){+        # say "s $z" ; # dd $Where{$z};+        for my $y (sort {$b <=> $a} keys $Where{$z}->%*){+            # say "l $y"; # dd $Where{$z}->{$y};+            my $code='rgb000'; # default if hue=0 ever missing+            for my $x (@Hues) {+                my $skippable;+                if ( defined $Where{$z}->{$y}->{$x}) {+                    $code = $Where{$z}->{$y}->{$x}->[0]->{code} // $code; ## repeat if position not used+                }+                print substr( $code, 3, 3 ), ' ';+            }+            say '';+        }+        say '';+    }+ }+++ # Save the RGB Grid values into HSL grid+ # This saves a sparse matrix in nested hash form+ #+ # Modeled on Ack3 _show_rgb_grid, but with HSL and save instead of print+ # saves into %Where for sibling+sub _save_rgb_grid {+    # Optional statistics+    # my (%Hues,%Lums,%Sats);+    my %Where;+    for my $r ( 0 .. 5 ) {+        for my $g ( 0 .. 5 ) {+            for my $b ( 0 ..5 ) {++                my $rgb = "$r$g$b";+                my $code = "rgb$r$g$b";+                my $hsl = Convert::Color::RGB->new(map {(_five_to_1($_))} ($r, $g, $b))->as_hsl;+                my @HSL = ($hsl->hsl);+                # Optional collect stats+                # my { ($h,$s,$l)=@HSL; $Hues{int $h+0.5}++; $Lums{$l}++; $Sats{$s}++; }+                my $hsl_code = sprintf q(h:%3d,s:%4.2f,l:%4.2f), @HSL;+                my ($x,$y, $z) = _where($hsl)->@*;+#                warn "Mapping white to [$x,$y, $z]" if 5==$r and 5==$g and 5==$b;+#                warn "[$x,$y] conflict #{[$Where{$y}->{$x}]} = $code (h=$HSL[0])"+#                    if defined $Where{$y}->{$x} ;+                push $Where{$z}->{$y}->{$x}->@* , { code => $code, hsl=> $hsl } ;++            }+        }+    }++    # say "Hues"; for my $k (sort {$a <=> $b} keys %Hues){ say "$Hues{$k}\t$k"; }+    # say "Lums"; for my $k (sort {$a <=> $b} keys %Lums){ say "$Lums{$k}\t$k"; }+    # say "Sats"; for my $k (sort {$a <=> $b}keys %Sats){ say "$Sats{$k}\t$k"; }+    return \%Where;+}++++=for samples++# Inspecting Convert::Color POD sample values deeply++use Data::Dump qw/dd/;++my $red = Convert::Color::HSL->new( 0, 1, 0.5 );++# Can also parse strings+say q(pink);+my $pink = Convert::Color::HSL->new( '0,1,0.8' );+dd $pink;+dd $pink->as_rgb;+dd $pink->as_rgb->as_hsl;++my $cyan = Convert::Color->new( 'hsl:300,1,0.5' );++say q(cyan);+dd $cyan;+dd $cyan->as_rgb;++say "132";+my $onethreetwo= Convert::Color::RGB->new(map {(_five_to_1($_))} (1, 3, 2));+dd $onethreetwo;+dd $onethreetwo->as_hsl->hsl;+dd $onethreetwo->as_hsl->chroma;++=cut