use strict;
use warnings;

use Term::ANSIColor 'colored';
use Term::ReadKey 'GetTerminalSize';

use Imager ':handy';

use PDL;
use PDL::IO::Image;
use PDL::Transform::Color;
use PDL::Graphics::ColorDistance 'delta_e_2000';

##################################
########### Deal with usage
##################################

my ( $image_file, $font_file ) = @ARGV;
die "Usage: $0 \"image file\" \"optional font file\"\n" 
    unless $image_file;

##################################
########### Deal with 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 );             # Win10 
}

binmode STDOUT, ':utf8';
$_ -- for my ( $cols, $rows ) = GetTerminalSize;

$rows --; $rows --;         # fit command in screenshot

##################################
########### Configurable stuff
##################################

my $colors = << 'END_OF_COLORS';
    0       0       0       black
    1       1       1       bright_white
    1       0       0       bright_red
    1       1       0       bright_yellow
    0       1       0       bright_green
    0       1       1       bright_cyan
    0       0       1       bright_blue
    1       0       1       bright_magenta

    0.5     0.5     0.5     bright_black
    0.75    0.75    0.75    white
    0.5     0       0       red
    0.5     0.5     0       yellow
    0       0.5     0       green
    0       0.5     0.5     cyan
    0       0       0.5     blue
    0.5     0       0.5     magenta
END_OF_COLORS

# ^ Presumably, (1/) for 8 color terminal, 
#   use only 8 rows above (and delete 'bright_');
#   (2/) for 16 color terminal configured with a palette,
#   edit values to match palette

my $distortion = 2.0;   # Not adjusted below (assume constant)
my $font_size  = 100;
my $dont_mix   = 0;     # "1" is don't mix RGB, use only 
                        # colored chars on grey, or grey on color

my @chars = ( "\N{SPACE}",                   # the defaults, 
    "\N{LIGHT SHADE}", "\N{MEDIUM SHADE}",   # unless font file
    "\N{DARK SHADE}", "\N{MIDDLE DOT}" );    # is given
                                             #
my @weights = ( 0, 0.18, 0.49, 0.81, 0.03 ); # (DejaVuSansMono values)

my @chars_to_try = ( @chars, 
    "\N{PROPORTION}", "\N{DOTTED CIRCLE}", "\N{BULLET}", 
    "\N{BULLSEYE}", "\N{CIRCLED DOT OPERATOR}" 
);

##################################
########### Deal with font
##################################

if ( $font_file ) {
    my $font = NF( 
        file => $font_file,
        size => $font_size,
        aa   => 1,
        color => NC( grey => 255 ),
    );
    my $bbox = $font-> bounding_box( string => 'a' );       # any
    my ( $w, $h, $baseline ) = map $bbox-> $_, 
        qw( advance_width font_height global_ascent );
    
    my $cell = Imager-> new( xsize => $w, ysize => $h, channels => 1 )
+;
    
    @chars = @weights = ();
    for my $char ( @chars_to_try ) {
        next unless "\1" eq $font-> has_chars( string => $char );

        $cell-> box( filled => 1, color => NC( grey => 0 ));
        $cell-> string( x => 0, y => $baseline, 
            font => $font, string => $char );

        my ( $fill ) = $cell
            -> scale( xpixels => 1, ypixels => 1, 
                type => 'nonprop', qtype => 'mixing' )
            -> getsamples( y => 0 );

        push @chars, $char;
        push @weights, $fill / 255
    }
}

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

my $image;
{
    my $pimage = PDL::IO::Image-> new_from_file( $image_file )
        -> rescale_pct( 100, 100 / $distortion );

    my $w_r   = $cols / $pimage-> get_width;
    my $h_r   = $rows / $pimage-> get_height;
    my $ratio = $w_r < $h_r ? $w_r : $h_r;

    $pimage-> rescale_pct( 100 * $ratio ) if $ratio < 1;
    $image = $pimage-> pixels_to_pdl-> mv( -1, 0 );
}

##################################
########### Deal with palette
##################################

my ( @composition, @color_names );

for ( split "\n", $colors ) {
    next unless /(?=\pL)/;
    push @composition, $`;
    push @color_names, $';
}
my $compo = 255 * pdl join ';', @composition;

my @pixels;
my $palette_str = '';

my %seen;
my $n = @color_names;

for my $w_i ( 0 .. $#weights ) {
    
    my $fg = $compo * $weights[ $w_i ];
    my $bg = $compo * ( 1 - $weights[ $w_i ]);

    my $table = $bg-> dummy( 1, $n ) + 
                $fg-> dummy( 1, $n )-> xchg( 1, 2 );

    my $triplets = byte $table-> clump( 1, 2 );
    my $triplets_str = ${ $triplets-> get_dataref };
    
    for my $bg_i ( 0 .. $#color_names ) {
        for my $fg_i ( 0 .. $#color_names ) {
            my $rgb = substr $triplets_str, 0, 3, '';

            next if $seen{ $rgb } ++;
            next if $dont_mix
                and $color_names[ $fg_i ] !~ /black|white/
                and $color_names[ $bg_i ] !~ /black|white/;

            $palette_str .= $rgb;
            push @pixels, colored( $chars[ $w_i ], 
                "$color_names[ $fg_i ] on_$color_names[ $bg_i ]" )
        }
    }
}

my $plt_size = scalar @pixels;
my $palette  = zeroes byte, 3, $plt_size;
${ $palette-> get_dataref } = $palette_str;
$palette-> upd_data;

##################################
########### Ready to go
##################################

$image   = t_lab-> apply(( !t_srgb )-> apply( $image ));
$palette = t_lab-> apply(( !t_srgb )-> apply( $palette ));

my $distance = delta_e_2000( $palette, $image-> dummy( 1, $plt_size ))
+;

print @pixels[ @$_ ], "\n"
    for @{ $distance-> minimum_ind-> unpdl };

__END__
[download]