💾 Archived View for thrig.me › art › drawbigat.pl captured on 2023-05-24 at 18:14:46.

View Raw

More Information

-=-=-=-=-=-=-

#!/usr/bin/env perl

use strict;
use warnings;
use Curses;
use Imager;

# `doas pkg_add noto-fonts` or as necessary for the OS involved
my $font =
  Imager::Font->new( file => '/usr/local/share/fonts/noto/Cousine-Regular.ttf' )
  or die;

initscr;
my $SQUASH  = 3;
my $img     = Imager->new( xsize => $COLS, ysize => $LINES * $SQUASH ) or die;
my $fgcolor = Imager::Color->new("#ffffff");

# these depend on the terminal size, font, etc
$img->string(
    x      => 7,
    y      => 156,
    font   => $font,
    string => "@",
    size   => 256,
    aa     => 1,
    color  => $fgcolor,
);

#$img->write( file => "bigat.png" );
#`feh bigat.png`;
# or run `convert at.png bitat.xbm` for a bitmap conversion

# curses "color" setup
start_color;
curs_set(0);
noecho;
my $j = 0;
for my $i ( 1 .. 255 ) {
    init_color( $i, $j, $j, $j );
    init_pair( $i, $i, 0 );
    $j += 2;
}

# extract Image pixels and feed curses addch
for my $r ( 0 .. $LINES - 1 ) {
    for my $c ( 0 .. $COLS - 1 ) {
        # black and white so don't care about the GBA. terminal is way
        # wider than tall (and the letters are not square, either) so
        # squash things down by skipping rows in the image
        my $red = ( $img->getpixel( x => $c, y => $r * $SQUASH )->rgba )[0];
        if ( $red > 0 ) {
            $red = between( 1, 255, $red - 24 + int rand 48 );
            with_attr(
                COLOR_PAIR( 255 - $red ),
                sub {
                    addch( $r, $c, '.' );
                }
            );
        } else {
            # some sometimes visible noise outside the letter
            with_attr(
                COLOR_PAIR( rand() > 0.5 ? 1 : 54 ),
                sub {
                    addch( $r, $c, rand() > 0.5 ? '.' : '#' );
                }
            );
        }
    }
}
getchar;    # wait for `scrot` or whatever to happen
endwin;
exit;

sub between {
    my ( $min, $max, $value ) = @_;
    if    ( $value < $min ) { return $min }
    elsif ( $value > $max ) { return $max }
    return $value;
}

sub with_attr {
    my ( $x, $body ) = @_;
    attron($x);
    $body->();
    attroff($x);
}