test_HSL.pl

# 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;
   1 #! perl
   2 # Show Term::ANSIColor 216-cube of colors 000..555 arrayed as HSL grid
   3 #
   4 # Copyright 2019 William Ricker modifying code by Andy Lester
   5 # License Same As Perl
   6 
   7 
   8 use Modern::Perl 2017;
   9 
  10 use Convert::Color;
  11 use Convert::Color::HSL;
  12 use Convert::Color::RGB;
  13 
  14 use Term::ANSIColor;
  15 
  16 use Readonly;
  17 # use Data::Dump qw/dd/; # needed in commented out traces
  18 
  19 my Readonly $degrees = 12;  ## This is the number that avoids collisions
  20 my Readonly $columns = 360 / $degrees; 
  21 
  22 
  23     my $where_href = _save_rgb_grid();
  24     _show_hue_sat_grid(1, 0,  $where_href);
  25     _show_hue_sat_grid(0, 0,  $where_href);
  26 #   _show_hue_sat_grid(0, 1,  $where_href);  # 1 for Skip ; leave the sparse matrix gaps blank
  27 
  28 
  29 ############ SUBROUTINES ###########
  30 
  31 
  32 # Helper to scale Term::ANSIColor 0..5 R,G,B to 0.0 .. 1.0 standard
  33 sub _five_to_1{
  34     return shift()/5;
  35 }
  36 
  37 # our %Where;
  38 
  39 
  40 sub _where {
  41     # pass in HSL object, returns xyz grid to display it on
  42     # if $degrees selected properly, won't cause collisions
  43     my $hsl = shift;
  44     my ($h, $s, $l) = $hsl->hsl;
  45     my $c = $hsl->chroma;
  46     my $y =  int 10*$l  ;  
  47     my $z =  int 10*$s ;
  48     my $x = sprintf "%0d", ($degrees * int( ($h+($degrees/2))/$degrees  ));
  49     return  [ $x, $y, $z] ;
  50 }
  51 
  52 
  53 ## HSL "Grid"
  54 
  55 # show Hue Sat Lum grid
  56 # Modeled on Ack3 _show_rgb_grid, but with HSL iteration over sparce save matrix
  57 # If a position is blank, repeat previous color
  58 # 
  59 #
  60 # Because 20 columns wide, 
  61 #    omits 'rgb' prefix
  62 #    stacks text over background 
  63 #
  64 # arguments
  65 # Reversed = 1 | 0
  66 # Skip : true will not repeat values but leave blank space
  67 # Where = the hashref returned by sibling
  68 #
  69 #
  70 sub _show_hue_sat_grid {
  71     my ($reversed, $skip, $where )  = @_;
  72     die unless 'HASH' eq ref $where;
  73     my (%Where) = ($where->%*);
  74 
  75     my @Hues =  map { $degrees * $_ } 0 .. ($columns-1); 
  76     say "ddd=Hue Degrees";
  77     say join( q( ), map { sprintf "%03d",$_ } @Hues),
  78         " l s";
  79     for my $z (sort {$b <=> $a} keys %Where){
  80         # say "s $z" ; # dd $Where{$z};
  81         for my $y (sort {$b <=> $a} keys $Where{$z}->%*){
  82             # say "l $y"; # dd $Where{$z}->{$y};
  83             my $code='rgb000'; # default if hue=0 ever missing
  84             for my $x (@Hues) {
  85 
  86                 my $skippable;
  87                 if ( defined $Where{$z}->{$y}->{$x}) { 
  88                     my $i = 0;
  89 
  90                     # a few tight hue angles get 324 336  so pick other one in Reversed
  91                     $i=1 if ($reversed > 0 and 1 < scalar $Where{$z}->{$y}->{$x}->@*);
  92                     # if ( 1 < scalar $Where{$z}->{$y}->{$x}->@*){ dd $Where{$z}->{$y};};
  93 
  94                     $code = $Where{$z}->{$y}->{$x}->[0]->{code} // $code; ## repeat if position not used
  95                 }
  96                 else {
  97                     $skippable=1;
  98                 }
  99 
 100                 if ($skip and $skippable) {
 101                     print q(    );
 102                 }
 103                 else {
 104                     print( ($reversed ?  Term::ANSIColor::colored( substr($code,3,3), $code )
 105                                       :  Term::ANSIColor::colored( substr($code,3,3), "reverse $code" )
 106                                      ),
 107                             ' ') ;
 108                 }
 109             }
 110             say "$y $z";
 111         }
 112         say "";
 113     }
 114    
 115  }
 116 
 117 
 118  # Save the RGB Grid values into HSL grid  
 119  # This saves a sparse matrix in nested hash form
 120  #
 121  # Modeled on Ack3 _show_rgb_grid, but with HSL and save instead of print
 122  # saves into %Where for sibling
 123 sub _save_rgb_grid {
 124     # Optional statistics
 125     # my (%Hues,%Lums,%Sats);
 126     my %Where;
 127     for my $r ( 0 .. 5 ) {
 128         for my $g ( 0 .. 5 ) {
 129             for my $b ( 0 ..5 ) {
 130 
 131                 my $rgb = "$r$g$b";
 132                 my $code = "rgb$r$g$b";
 133                 my $hsl = Convert::Color::RGB->new(map {(_five_to_1($_))} ($r, $g, $b))->as_hsl;
 134                 my @HSL = ($hsl->hsl);
 135                 # Optional collect stats 
 136                 # my { ($h,$s,$l)=@HSL; $Hues{int $h+0.5}++; $Lums{$l}++; $Sats{$s}++; }
 137                 my $hsl_code = sprintf q(h:%3d,s:%4.2f,l:%4.2f), @HSL;
 138                 my ($x,$y, $z) = _where($hsl)->@*;
 139 #                warn "Mapping white to [$x,$y, $z]" if 5==$r and 5==$g and 5==$b;
 140 #                warn "[$x,$y] conflict #{[$Where{$y}->{$x}]} = $code (h=$HSL[0])"
 141 #                    if defined $Where{$y}->{$x} ;
 142                 push $Where{$z}->{$y}->{$x}->@* , { code => $code, hsl=> $hsl } ;
 143 
 144             }
 145         }
 146     }
 147 
 148     # say "Hues"; for my $k (sort {$a <=> $b} keys %Hues){ say "$Hues{$k}\t$k"; } 
 149     # say "Lums"; for my $k (sort {$a <=> $b} keys %Lums){ say "$Lums{$k}\t$k"; } 
 150     # say "Sats"; for my $k (sort {$a <=> $b}keys %Sats){ say "$Sats{$k}\t$k"; } 
 151     return \%Where;
 152 }
 153 
 154 
 155