use strict; use warnings; use 5.032; # chained comparison use Term::ANSIScreen; use if $^O eq 'MSWin32', 'Win32::Console'; my $OUT; if ( $^O eq 'MSWin32' ) { $OUT = Win32::Console-> new( STD_OUTPUT_HANDLE ); $OUT-> OutputCP( 65001 ); $OUT-> Mode( $OUT-> Mode | 4 ); } my @shades = ( "\N{SPACE}", "\N{LIGHT SHADE}", "\N{MEDIUM SHADE}", "\N{DARK SHADE}", "\N{FULL BLOCK}" ); utf8::encode( $_ ) for @shades; my @hues = ; my @pal; my @chars; BLOCK1: # 5 neutral grays for my $s ( 0 .. $#shades ) { push @pal, [( 255 / $#shades * $s ) x 3 ]; push @chars, colored( $shades[ $s ], 'white' ) } BLOCK2: # 24 = (6 hues) * (4 shades) for my $h ( 0 .. $#hues ) { for my $s ( 1 ..$#shades ) { push @pal, [ map { $_ / $#shades * $s * 255 } ( 0 <= $h <= 1 || $h == 5 ), # R ( 1 <= $h <= 3 ), # G ( 3 <= $h <= 5 ) # B ]; push @chars, colored( $shades[ $s ], $hues[ $h ]) } } BLOCK3: # 18 = (6 "diluted" hues) * (3 shades) for my $h ( 0 .. $#hues ) { for my $s ( 1 ..$#shades - 1 ) { push @pal, [ map { ( 1 + $s * ( $_ - 1 ) / $#shades ) * 255 } ( 0 <= $h <= 1 || $h == 5 ), # R ( 1 <= $h <= 3 ), # G ( 3 <= $h <= 5 ) # B ]; push @chars, colored( $shades[ $s ], "$hues[ $h ] on_white" ) } } # PDL stuff below use PDL::Lite; use PDL::IO::GD; use PDL::Transform::Color; use PDL::Graphics::ColorDistance 'delta_e_2000'; my $image = read_true_png( 'rose.png' ); my $palette = pdl \@pal; $image = $image-> mv( -1, 0 ); # RRR...GGG...BBB => RGBRGBRGB... $image = t_lab-> apply(( !t_srgb )-> apply( $image )); # RGB to Lab $palette = t_lab-> apply(( !t_srgb )-> apply( $palette )); # palette to Lab my $dist = delta_e_2000( $palette, $image-> dummy( 1, scalar @pal )); # Args to sub above are 2D and 4D; it's threading ("broadcasting") # in action. $dist is 3D piddle. We are only interested which index in # distances dimension holds minimum value. That's all. print @chars[ @$_ ], "\n" for @{ $dist-> minimum_ind-> unpdl };