-
Notifications
You must be signed in to change notification settings - Fork 67
/
Copy pathgenerate-rgb-codes.pl
149 lines (118 loc) · 3.96 KB
/
generate-rgb-codes.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
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