#!/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 available 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 resolution!

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

# "Greyscale" unicode blocks
# This could be specified nicer, but seems to be a problem when posting 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;
}