Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Imagecat - show color images in a terminal

by cavac (Prior)
on Jun 28, 2023 at 12:26 UTC ( [id://11153183]=CUFP: print w/replies, xml ) Need Help??

A few days ago a played around with displaying (color) ASCII art in a Terminal in Re: 80x25 ASCII text art in terminal, because harangzsolt33 peaked my interest. i mentioned that it should be possible to display low res color images in the text console as well and that i would look into it if someone was interested.

Turns out, the first interested party was myself. Literally a couple of hours after i posted, i had to sort through some PNG icons through an SSH connection. "Instead of downloading the folder, opening the files locally and finding the correct icon, wouldn't it be nice to just display a low res version in my terminal?". Yes, i know there are technically a few other tools that can already do this. But i decided i wanted a Perl version, so that i can easily customize it to my liking. I wanted to build it in a way that it ONLY uses very basic ANSI colors, to support as many color terminals as possible (and as long as they support Unicode).

So, i created imagecat:

#!/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; my ($cols, $rows, $wpixels, $hpixels) = GetTerminalSize(); # Prevent auto-wrapping $cols--; $rows--; # "Greyscale" unicode blocks # This could be specified nicer, but seems to be a problem when postin +g to PerlMonks, see comment below my @shades; foreach my $char (qw(32 9617 9618 9619 9608)) { my $tmp = chr($char); utf8::encode($tmp); push @shades, $tmp; } 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 $lastcindex = -1; for(my $y = 0; $y < $h; $y++) { 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 = 0; if($ps > 0.5) { $colormode = 1; } # Map the brightness to the corresponding Unicode characte +rs my $brightness = int($pv * 4); if(!defined($shades[$brightness])) { croak("Undefined $pv -> $brightness"); } my $shade = $shades[$brightness]; # Map the color to roughly their corresponding ANSI termin +al color code. my $cindex = 0; if($ps < 0.5) { # White $cindex = 6; } elsif($ph > 34 && $ph <= 82) { # Yellow $cindex = 1; } elsif($ph > 82 && $ph <= 159) { # Green $cindex = 2; } elsif($ph > 159 && $ph <= 205) { # Cyan $cindex = 3; } elsif($ph > 205 && $ph <= 270) { # Blue $cindex = 4; } elsif($ph > 270 && $ph <= 330) { # Magenta $cindex = 5; } else { # Red $cindex = 0; } if($cindex != $lastcindex) { print $termcolors[$cindex]; $lastcindex = $cindex; } print $shade; } print "\n"; } { my $reset = color 'reset'; print $reset; } return; }

Had a slight problem posting the original code to PerlMonks. The while @shades initialization is a single line in my original code, but PM refused to show Unicode in code tags. Basically, this is what it should look like (that is, unless there are more PM rendering bugs):

my @shades = (' ', '░', '▒', '▓', '█');

Yes, this could be improved with using full RGB colors and 2 "pixels" per character using something like 'Upper half block ▀' for a higher resolution. But for now, i just wanted to learn if i can do a version with much more basic color support. HSV color mapping is a strange beast... Edit: I wrote the full color, double-vertical resolution imagecat2, see my post below.

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

Replies are listed 'Best First'.
Re: Imagecat - show color images in a terminal
by soonix (Chancellor) on Jun 28, 2023 at 18:58 UTC
    my @shades = ("\N{SPACE}", "\N{LIGHT SHADE}", "\N{MEDIUM SHADE}", +"\N{DARK SHADE}", "\N{FULL BLOCK}");
    may be more work typing, but looks the same in your editor, in (github|gitlab|bitbucket|whoever)'s web interface, on all OSes and - but that's a probably matter of taste - might even be better readable.

      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
Re: Imagecat - show color images in a terminal
by Fletch (Bishop) on Jun 28, 2023 at 13:09 UTC
Re: Imagecat - show color images in a terminal
by Tux (Canon) on Jun 29, 2023 at 10:11 UTC

    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.


    Enjoy, Have FUN! H.Merijn
Re: Imagecat - show color images in a terminal
by Anonymous Monk on Jun 29, 2023 at 12:25 UTC

    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 ); }

    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

    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
    

      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.

        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
Re: Imagecat - show color images in a terminal
by cavac (Prior) on Jul 10, 2023 at 14:09 UTC

    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; }

    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.

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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://11153183]
Approved by Athanasius
Front-paged by Athanasius
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2025-05-19 13:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.