Re: Imagecat - show color images in a terminal

[Anonymous Monk]

Many thanks for great distraction! Actually, you rolled out manual color quantization to pre-defined palette; any decent graphics toolkit should provide this option.

In Strawberry, I had to inject this fragment (same as in my code below) close to top so that your script works in standard Windows console/terminal:

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 );
}

I didn't do binmode STDOUT, ':utf8'; but continue, instead, to print octets for consistency with your code. Plus I won't digress why e.g. the "$OUT" has to be defined in outer scope, or else this node will be too long! (Same about few other details)

One important thing is I'm setting the ENABLE_VIRTUAL_TERMINAL_PROCESSING bit ("4" above), therefore at least Win10 with an (automatic) update of a few years ago is required. I didn't investigate why the usual alternative route with Win32::Console::ANSI seems to be incompatible with printing Unicode.

My test subject is ImageMagick's built-in [1] rose image which is 70 by 46; I hardcoded file name and totally omitted resizing in my code. Also, there is no error checking for e.g. incompatible color model, etc. To produce a file:

convert rose: rose.png

Another note: I had plans to add many more colors to palette, like e.g. whatever RGB triplet would be produced with trivial formula for "red medium shade block on cyan". However, it looks like fonts are very inconsistent in which area percentage is filled with Light/Medium/Dark blocks (click "View All" [2]). E.g. for Consolas, medium block fill is close to 25% rather than 50%. Hues would be very wrong. I decided to stop with pure hues on black and on white (the latter are kind of "diluted" hues). Color distortion would then be wrong contrast/gamma only. In fact, on Windows, colors 0-7 are "dimmed" anyway. Nevertheless, screenshots below were produced with "Raster 8x12" font in terminal, they have 50% for "medium" (DejaVu Sans Mono has 50%, too. That's too much digression already.)

With your script, I don't see [3] "Full block" in neither red nor white in output (image certainly has a few pure white pixels). Don't know if it was intentional, but at least it partially explains differences with my code results.

My script, and output [4]:

use strict;
use warnings;
use 5.032;          # chained comparison

use Term::ANSIScreen;
use GD;

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 = <red yellow green cyan blue magenta>;
my @chars;

my $source = GD::Image-> new( 'rose.png' ) or die;
my $dest   = GD::Image-> new( 1, 1 ) or die;

BLOCK1:                     # 5 neutral grays
for my $s ( 0 .. $#shades ) {
    $dest-> colorAllocate(( 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 ) {
        $dest-> colorAllocate(
            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 ])
    }
}

for my $y ( 0 .. $source-> height - 1 ) {
    for my $x ( 0 .. $source-> width - 1 ) {
        my $rgb = $source-> getPixel( $x, $y );
        my ( $r, $g, $b ) = $source-> rgb( $rgb );
        
        print $chars[ $dest-> colorClosestHWB( $r, $g, $b )]
    }
    print "\n"
}

I'm using colorClosestHWB, as it produces slightly more pleasing picture than colorClosest (e.g. no unexpected magenta). The latter output is same if I'd copy (GD's method) source to destination of appropriate size and palette stuffed to capacity with e.g. dummy black. And very close, but not the same if I'd use Imager and its to_paletted instead of GD. Imager also allows to dither with error diffusion, but result looks very ugly for such small image and enlarged "pixels".

OK, let's add "diluted" hues as BLOCK3 after BLOCK2 (palette sequence order doesn't matter; everything is resolved automatically):

BLOCK3:                     # 18 = (6 "diluted" hues) * (3 shades)
for my $h ( 0 .. $#hues ) {
    for my $s ( 1 ..$#shades - 1 ) {
        $dest-> colorAllocate(
            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" )
    }
}

Ah, here are [5] some hints of other hues than just red! But still "somewhat" far from true color image. Let's get serious and add some science! I'll map RGB triplets to palette indexes manually (just as you did in original script), but instead of whatever algorithm GD (or Imager, etc.) uses to find "closest color", I'll calculate distances and pick minimum in perceptually uniform color space (i.e. neither RGB nor HSV). Script is very similar but requires PDL and related modules from CPAN:

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 = <red yellow green cyan blue magenta>;
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 => RGBRG
+BRGB...
$image = t_lab-> apply(( !t_srgb )-> apply( $image ));      # RGB to L
+ab
$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 };

And isn't result [6] better? Looks like science works after all. In case anyone wonders, no black in output is because there is no black (nothing close to it) in original, but such conversions are better performed with "black point compensation" adjustment, which I didn't looked into how to add in this case.

1. https://imagemagick.org/image/rose.png
2. https://www.fileformat.info/info/unicode/char/2592/fontsupport.htm
3. https://i.ibb.co/R0WmtNF/original.png
4. https://i.ibb.co/cbt07mK/my-gd.png
5. https://i.ibb.co/JnCdFP7/my-gd.png
6. https://i.ibb.co/kHCLYCg/scientific.png

[Anonymous Monk]

• https://i.ibb.co/F3qqTSJ/consola.png
• https://i.ibb.co/G9KY1xM/dejavu.png
• https://i.ibb.co/Z6B7H7f/dejavu-dontmix.png
• https://i.ibb.co/Lpz1wWh/ibmplex.png
• https://i.ibb.co/LPgqfSB/wrong-setup.png

I think I exhausted this exercise as distraction source, better call it a day and publish. Know more now that I don't know than I knew that I didn't knew, as usual :). Plus a few factoids about weirdness/bugs in Imager/PDL/FreeType.

Console in screenshots was configured to use fonts as seen in commands before they were run. "Wrong setup" is console configured to use DejaVuSansMono and command to calculate for Consolas. Which was exactly the point -- to demo (for self) that color management does work even with very limited resources = size and composition of palette to pick best match. Google image search fails anyway to find the original, which is Wiki title pic of Kelly, of course (for ye movie fans out here :)

I don't know if yellow shift and more posterization for DejaVuSansMono is either because FreeType renders glyphs differently from Windows, or, perhaps, 50% fill for medium shade (as opposed to other fonts) means scarce repertoire of tints closer to quarter-tones in palette, for skin.

Read more... (6 kB)

[Tux]

Nice, but trying to play with this I found that it requires PDL::IO::Image which depends on Alien::FreeImage which won't build on modern g++ (it requires -std=c++14 and redefines powf64) and it has security issues (see issues).

Other than that, thanks! Some things to look back at when I encounter similar tasks.

[Anonymous Monk]

I suspected result on Linux be wilder than "wrong_setup" because terminals are almost certain to use palette, not pure RGB. "Security"? Life corrects as always.

##################################
########### Deal with image
##################################

use PDL::IO::FlexRaw;

my $image;
{
    my $im = Imager-> new( file => $image_file )
        -> to_rgb8
        -> convert( preset => 'noalpha' )
        -> scale( xscalefactor => 1, 
                  yscalefactor => 1 / $distortion );

    my $w_r   = $cols / $im-> getwidth;
    my $h_r   = $rows / $im-> getheight;
    my $ratio = $w_r < $h_r ? $w_r : $h_r;
    $im = $im-> scale( scalefactor => $ratio ) if $ratio < 1;

    $im-> write( data => \my $buf, type => 'raw' );
    my $dims = [ 3, $im-> getwidth, $im-> getheight ];
    open my $fh, '<:raw', \$buf;
    $image = readflex( $fh, [{ Type => 'byte', Dims => $dims }])
}

TIMTOWTDI. One reason to use PDL::IO::Image was to play with its rescale filters (which amounted to nothing) to average glyph bitmap to single pixel. In the end it's arithmetic mean with Imager::scale(qtype => 'mixing',... and itself not necessary neither, could be unpack '%32C*', ...

(Another reason for PDL::IO::Image was to use the best what happened to image IO and basic manipulation, for PDL if not Perl. Very sad if it's abandoned. PDL::IO::GD and PDL::IO::Pic don't compare)