my @shades = ("\N{SPACE}", "\N{LIGHT SHADE}", "\N{MEDIUM SHADE}", 
+"\N{DARK SHADE}", "\N{FULL BLOCK}");
[download]

Ah, yeah, right, i could use the names of the unicode characters. I totally forgot!

Thank you for reminding me!

PerlMonks XP is useless? Not anymore: XPD - Do more with your PerlMonks XP

Related if you use iterm on osx you can literally cat images: https://iterm2.com/documentation-images.html

It also needs a binmode to prevent Unicode warnings. It is fun to play with. Here is a bit of a cleaned up version that uses Unicode, map, say and ternary. It also resets the color at the end of each line: not all peple prefer a black background.

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 );
}
[download]

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
[download]

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.

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

• 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)

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.


Enjoy, Have FUN! H.Merijn

And here is imagecat2, the full RGB color version with double the vertical resolution. As a bonus, each pixel (subpixel?) is now much more square, so the aspect ratio in the image is now more true to the original image.

This will need a 24 bit color terminal. I only tested in on Linux (Xubuntu 22.04), so i can't guarantee that it will work on Mac, Microsoft Bob or even other Linux distributions without fiddling with the settings.

#!/usr/bin/env perl

use v5.36;
use strict;
use warnings;
use utf8;

use Carp;
use Convert::Color;
use Term::ANSIScreen qw/:color/;
use GD;
use Data::Dumper;

use Term::ReadKey;

# This version of imagecat requires a 24 bit color terminal and an ava
+ilable Unicode "Upper Half Block"
# https://tintin.mudhalla.net/info/truecolor/
# https://www.compart.com/en/unicode/U+2580

my ($cols, $rows, $wpixels, $hpixels) = GetTerminalSize();

$rows = $rows * 2; # Thanks to Unicode, we can work with DOUBLE the re
+solution!

# Prevent auto-wrapping
$cols--;
$rows--;

# "Greyscale" unicode blocks
# This could be specified nicer, but seems to be a problem when postin
+g to PerlMonks
my $halfblock = chr(9600);
utf8::encode($halfblock);

my @termcolors;

# Pre-generate colors
foreach my $termcolor (qw[red yellow green cyan blue magenta white]) {
    my $tmp = color $termcolor . ' on black';
    push @termcolors, $tmp;
}

# Iterate through all image filenames given on command line
foreach my $fname (@ARGV) {
    print "------ $fname ------\n";
    my $ok = 0;
        eval {
            printImage($fname);
            $ok = 1;
        };
        if(!$ok) {
            print STDERR "ERROR: $!\n";
        }
    print "\n";
}

sub printImage($fname) {
    my $img = GD::Image->new($fname);
    my ($origw, $origh) = $img->getBounds();
    my ($w, $h) = ($origw + 0, $origh + 0);



    my $divfactor = 1;
    if($w > $cols) {
        my $tmp = $w / $cols;
        #print "$w / $cols / $tmp\n";
        if($tmp > $divfactor) {
            $divfactor = $tmp;
        }
    }
    if($h > $rows) {
        my $tmp = $h / $rows;
        #print "$h / $rows / $tmp\n";
        if($tmp > $divfactor) {
            $divfactor = $tmp;
        }
    }

    if($divfactor > 1) {
        $w = int($w / $divfactor);
        $h = int($h / $divfactor);

        my $newpic = GD::Image->new($w, $h, 1);

        $newpic->copyResized($img,
                          0, 0, # DEST X Y
                          0, 0, # SRC X Y
                          $w, $h, # DEST W H
                          $origw, $origh, # SRC W H
                        );

        $img = $newpic;
    }

    my $lastfgcolor = '';
    my $lastbgcolor = '';

    my ($r, $g, $b); # Color vars
    for(my $y = 0; $y < $h; $y+=2) {
        for(my $x = 0; $x < $w; $x++) {
            # Foreground color
            my $index = $img->getPixel($x, $y);
            ($r,$g,$b) = $img->rgb($index);

            my $newfgcolor = "\e[38;2;" . join(';', $r, $g, $b) . "m";

            if($newfgcolor ne $lastfgcolor) {
                $lastfgcolor = $newfgcolor;
                print $newfgcolor;
            }

            # Background color
            my $lowy = $y + 1;
            if($lowy == $h) {
                # End of image. need a black half-line
                ($r, $g, $b) = (0, 0, 0);
            } else {
                my $index = $img->getPixel($x, $lowy);
                ($r,$g,$b) = $img->rgb($index);
            }

            my $newbgcolor = "\e[48;2;" . join(';', $r, $g, $b) . "m";

            if($newbgcolor ne $lastbgcolor) {
                $lastbgcolor = $newbgcolor;
                print $newbgcolor;
            }


            print $halfblock;
            #print utf8::encode("\N{FULL BLOCK}");
        }
        ($r, $g, $b) = (0, 0, 0);
        $lastfgcolor = "\e[38;2;" . join(';', $r, $g, $b) . "m";
        $lastbgcolor = "\e[48;2;" . join(';', $r, $g, $b) . "m";
        print $lastfgcolor, $lastbgcolor, "\n";
    }

    {
        my $reset = color 'reset';
        print $reset;
    }

    return;
}
[download]

imagecat2 uses the Unicode "Upper Half Block" to display two pixels per character. Basically, for every line of characters, i parse TWO lines of the image. The upper line is the foreground color and the lower the background.

I try to minimize the color change characters i print by only setting a new foreground or background color if that has changed from the last printed pixel, so you could save the result to a text file and use the normal "cat" program to display its contents when required. But it could still result in a relatively large file/slow printing when showing a colorful photo in a high resolution text terminal.