current commit
190331.11 · Added Bill's changes to organize RGB chart by HSL.
#! 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