#!/usr/bin/perl

use 5.036001;
use warnings;

our $VERSION = "0.01 - 20230629";
our $CMD = $0 =~ s{.*/}{}r;

sub usage {
    my $err = shift and select STDERR;
    say "usage: $CMD ...";
    exit $err;
    } # usage

use Carp;
use Convert::Color;
use Term::ANSIScreen qw(:color);
use GD;
use Data::Peek;
use Term::ReadKey;
use Getopt::Long qw(:config bundling);
GetOptions (
    "help|?"                    => sub { usage (0); },
    "V|version"                 => sub { say "$CMD [$VERSION]"; exit 0
+; },

    "d|dark".
     "|dark-background!"        => \ my $dark,

    "v|verbose:1"               => \(my $opt_v = 0),
    ) or usage (1);

my $bgc = $dark ? "black" : "white";
my ($cols, $rows, $wpixels, $hpixels) = GetTerminalSize ();

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

# "Greyscale" unicode blocks
binmode STDOUT, ":encoding(utf-8)";
# This could be specified nicer, but seems to be a problem when postin
+g to PerlMonks, see comment below
my @shades = ("\N{SPACE}", "\N{LIGHT SHADE}", "\N{MEDIUM SHADE}", "\N{
+DARK SHADE}", "\N{FULL BLOCK}");

# Pre-generate colors
my @termcolors = map { color $termcolor . " on $bgc" }
    qw( red yellow green cyan blue magenta white ); # White won't "wor
+k" on light background

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

sub printImage ($fname) {
    -s $fname or croak ("Non-existing or empty image");
    my $img = GD::Image->new ($fname) or croak "GD::Image cannot proce
+ss $fname";
    my ($origw, $origh) = $img->getBounds ();
    my ($w, $h) = ($origw + 0, $origh + 0);
    my $reset = color "reset";

    my $divfactor = 1;
    if ($w > $cols) {
        my $tmp = $w / $cols;
        #say "$w / $cols / $tmp";
        $tmp > $divfactor and $divfactor = $tmp;
        }
    if ($h > $rows) {
        my $tmp = $h / $rows;
        #say "$h / $rows / $tmp";
        $tmp > $divfactor and $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;
        }

    for (my $y = 0; $y < $h; $y++) {
        my $lastcindex = -1;
        for (my $x = 0; $x < $w; $x++) {
            my $index = $img->getPixel ($x, $y);
            my ($r, $g, $b) = $img->rgb ($index);

            #my $grey = int(($r + $g + $b) / 3);

            my $basecolor = Convert::Color->new ("rgb8:" . join "," =>
+ $r, $g, $b);
            my ($ph, $ps, $pv) = $basecolor->as_hsv->hsv;
            my $colormode = $ps > 0.5 ? 1 : 0;

            # Map the brightness to the corresponding Unicode characte
+rs
            my $brightness = int ($pv * 4);
            defined ($shades[$brightness]) or
                croak ("Undefined $pv -> $brightness");
            my $shade = $shades[$brightness];

            # Map the color to roughly their corresponding ANSI termin
+al color code.
            my $cindex =
                $ps < 0.5               ? 6 : # White
                $ph >  34 && $ph <=  82 ? 1 : # Yellow
                $ph >  82 && $ph <= 159 ? 2 : # Green
                $ph > 159 && $ph <= 205 ? 3 : # Cyan
                $ph > 205 && $ph <= 270 ? 4 : # Blue
                $ph > 270 && $ph <= 330 ? 5 : # Magenta
                                          0 ; # Red

            unless ($cindex == $lastcindex) {
                print $termcolors[$cindex];
                $lastcindex = $cindex;
                }

            print $shade;
            }
        say $reset;
        }

    print $reset;
    return;
    } # printImage
[download]