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__