#!/usr/bin/perl

# D8K.F6H
#
#       LÆMEUR'S SUPER-NEATO DOT-MATRIX PRINTER SIMULATOR SCRIPT                
#                    by LÆMEUR <adam@laemeur.com>
#
#                  For updates and notes on usage:
#                     http://laemeur.sdf.org/D8K
#
# (feel free to copy, modify, redistribute, speak admiringly of, &c.)
# ===================================================================
#
# USAGE:
#
#     feed me an ASCII-encoded PBM file, like so: 
#
#         $ ./dotmat.pl INFILE.PBM
#
#     I will barf back out a binary PGM file to STDOUT, so if you 
#     want that in a file, do like this:
#
#         $ ./dotmat.pl INFILE.PBM > OUTFILE.PGM
#

# Some variables...
my $source_width, $source_height, $print_width, $print_height = 0;
my @source_array = ();
my $print_array = "";
my @infile = ();
my $cline = "";

# ppd = Pixels Per Dot. 
# Set $xppd to 6 for 960-dot mode, or 12 for 480-dot mode
my $xppd = 12; 
my $yppd = 10;

# This array holds five 10x10 greyscale pictures of fuzzy dots.
@dotmaps = (255, 240, 176, 153, 163, 161, 166, 192, 204, 225, 250, 202, 138, 110, 112, 99, 135, 168, 192, 186, 215, 161, 84, 58, 46, 38, 76, 120, 145, 192, 163, 92, 33, 15, 15, 23, 38, 61, 115, 174, 120, 40, 17, 5, 7, 12, 28, 53, 125, 189, 92, 46, 17, 12, 17, 10, 28, 87, 166, 202, 156, 92, 38, 30, 28, 20, 38, 99, 163, 194, 204, 156, 102, 53, 43, 43, 89, 135, 148, 204, 238, 204, 166, 133, 122, 120, 156, 179, 186, 227, 255, 243, 220, 204, 207, 207, 215, 232, 238, 253, 255, 238, 148, 99, 143, 161, 153, 168, 192, 222, 248, 192, 92, 35, 76, 92, 94, 115, 161, 181, 199, 122, 43, 23, 30, 33, 40, 56, 110, 189, 133, 33, 7, 12, 15, 20, 30, 43, 104, 174, 104, 17, 10, 5, 7, 12, 28, 38, 102, 179, 89, 43, 17, 12, 17, 10, 23, 56, 120, 174, 156, 92, 38, 28, 28, 20, 30, 71, 117, 161, 204, 153, 79, 25, 30, 23, 46, 97, 120, 197, 238, 199, 128, 79, 94, 69, 81, 130, 174, 227, 255, 240, 204, 181, 192, 176, 176, 217, 235, 253, 255, 232, 133, 71, 84, 112, 135, 168, 186, 217, 245, 166, 71, 20, 38, 56, 84, 110, 130, 135, 194, 107, 35, 20, 28, 30, 38, 48, 53, 135, 133, 33, 7, 12, 15, 20, 30, 33, 61, 133, 102, 12, 7, 5, 7, 12, 28, 23, 51, 145, 66, 12, 7, 12, 17, 10, 23, 30, 64, 140, 112, 17, 5, 28, 28, 20, 30, 64, 97, 145, 179, 107, 53, 23, 28, 23, 43, 94, 120, 197, 232, 189, 120, 56, 40, 43, 61, 110, 166, 227, 255, 240, 202, 153, 148, 138, 145, 197, 230, 253, 255, 222, 122, 71, 51, 46, 102, 163, 186, 217, 243, 112, 17, 17, 25, 25, 71, 107, 130, 135, 184, 61, 17, 20, 28, 28, 38, 48, 53, 135, 133, 30, 7, 12, 15, 20, 30, 33, 61, 128, 102, 12, 7, 5, 7, 12, 28, 23, 40, 112, 66, 12, 7, 12, 17, 10, 23, 28, 48, 84, 112, 17, 5, 28, 28, 20, 30, 61, 89, 125, 176, 84, 23, 15, 25, 23, 43, 94, 117, 194, 230, 163, 64, 25, 15, 17, 53, 110, 166, 227, 255, 238, 194, 140, 107, 94, 130, 197, 230, 253, 253, 220, 92, 25, 38, 35, 28, 97, 153, 215, 227, 66, 12, 15, 25, 20, 15, 30, 92, 125, 112, 17, 12, 20, 28, 28, 25, 17, 33, 89, 61, 12, 7, 12, 15, 20, 28, 23, 7, 33, 56, 10, 7, 5, 7, 12, 28, 20, 7, 23, 51, 12, 7, 12, 17, 10, 23, 17, 20, 28, 110, 15, 5, 28, 28, 20, 28, 23, 46, 76, 158, 43, 5, 15, 25, 23, 33, 28, 61, 174, 217, 112, 28, 23, 15, 15, 25, 33, 107, 220, 253, 232, 186, 140, 107, 94, 122, 179, 222, 253);


# LET US BEGIN
# ------------
# Read input lines and put 'em into the @infile array.
while(<>) {
    push(@infile,$_);
}

# The structure of a PBM file is like so: 
#
#     P1                  <-- First line, magic number "P1".
#     # COMMENT line(s)   <-- There may be any number of hash-prefixed
#       ...                   comment lines next,
#     WIDTH HEIGHT        <-- followed by pixel width and height,
#     PIXELS...           <-- and then a list of pixel values.


# Peek at the first line and make sure it just says "P1".
# If it doesn't, this isn't an ASCII PBM file, and we shall run 
# straight away.  Otherwise, shift it off into oblivion and proceed.
if ($infile[0] != "P1") {
    print "Input not an ASCII PBM.";
    exit;
} else {
    shift(@infile);
}

# Now we'll strip off comment lines by using index() to see if there
# are any hash (#) characters in the topmost line of @infile.
while (index($infile[0],"#") > -1){
    shift(@infile);
}

# With comments stripped, the topmost line of @infile should now 
# contain the image dimensions.  We'll split the height and width
# values into @dims and discard the line.
my @dims = split(" ",$infile[0]);
shift(@infile);

# Next, set the dimensions of the output file and create a blank 
# greymap.
$source_width = $dims[0];
$source_height = $dims[1];
$print_width = ($xppd * $source_width) + 10;
$print_height = ($yppd * $source_height) + 10;

# For our output greymap, we're just creating a big 
# scalar/string full of white (0xFF). Originally I did this 
# with a proper Perl array, but the resource overhead was 
# preposterous.  This works better.
$print_array = "\xFF" x ($print_width * $print_height);

# All that's left of @infile are the lines of image data. These will 
# contain a series of "1"s and "0"s, sometimes and sometimes-not
# separated by whitespace.  What we'll do is just read every character,
# push the "1"s and "0"s into a source-image array, and ignore the 
# rest.

my @bits = ();
my $bit;

foreach $cline (@infile){
    # NOTE TO SELF: Rewrite this using vec() on $cline. Using 
    # split() can/will get enormously resource-heavy with large, 
    # badly-formatted input files.
    @bits = split(//,$cline); 
    foreach $bit (@bits) {
        if ($bit eq "1" || $bit eq "0") {
            push(@source_array, $bit);
	}
    }
	# SECOND NOTE TO SELF: There's really no need to buffer the
	# whole input file, is there?  Re-write this to generate
	# the output image as the input image is being read.
}

# At this point, we have a source array full of bitmap data, and a 
# big raster-string full of blank pixel-bytes. Now, we read each 
# element of the source array. If the element is a "0", we do nothing;
# if the element is a "1", we draw a big dot into the output image.


my $dot = 0;
my $mapno = 0;
my $x, $x2, $y, $y2 = 0; # loop counters
my $old_pixel;
my $new_pixel;

# On dot-matrix printouts there is usually a streaking/banding effect
# running across the page. This can be caused by ribbon defects, or
# by the tractor-feed not being very precise, or by tiny 
# irregularities in the pin-spacing on the printhead.  For our
# purposes, we'll ignore the ribbon-factor and just pretend everything
# is in the printer's head.  These two arrays hold X and Y offsets for 
# each of the nine pins on the virtual printhead.
my @head_d_x = (int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)));
my @head_d_y = (int(rand(2)),int(rand(2)),int(rand(4)),int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)),int(rand(2)));

# This program prints one line of dots at a time, but we want to
# make it look like there's a repeatedly-imperfect 9-pin printhead at
# work, so we increment this counter and reset it every 8(!) rows of dots
# and use it as an index into the @head_d_x/y arrays.
#
# ! Since this script simulates GRAPHICS printing on a dot-matrix
#   printer, we only use 8 pins of the printhead, instead of 9, since
#   that's how they usually worked.
my $headpin = 0;

# THE TIME-CONSUMING PART:
# ------------------------
# For every line of the source bitmap...
for ($y = 0; $y < $source_height; $y++){
    # ...read every pixel on the line...
    for ($x = 0; $x < $source_width; $x++){
	# ...if it's a "1", draw a dot.
	if ($source_array[($y * $source_width) + $x] eq "1"){

	    # $dot holds the index of the pixel where the top-left
            # corner of the 10x10 dot we're about to print into the
	    # output image.
	    $dot = $xppd + (($y * $yppd) * $print_width) + ($x * $xppd);

	    # Add a little left/right jitter.
	    $dot += ($head_d_x[$headpin] + int(rand(2)));

	    # Add a little up/down jitter.
	    $dot += ($head_d_y[$headpin] + int(rand(2))) * $print_width;

	    # Pseudorandomly select which of the dot pixmaps we'll be
	    # drawing.
	    $mapno = int(rand(5));

	    # Now "print" the 10x10 dot pixmap into the print_array
	    for ($y2 = 0; $y2 < 10; $y2++){
		for ($x2 = 0; $x2 < 10 ; $x2++){
                    # Read the existing pixel from the print_array
		    $old_pixel = vec($print_array,$dot+$x2,8);
		    # Read the new pixel from the dot map
		    $new_pixel = $dotmaps[($mapno*100)+($y2 * 10) + $x2];

		    # Subtract $old_pixel's value from our white-level
		    # to see how much "ink" is already on the paper,
		    # and do the same with $new_pixel.  Add up the
		    # inkiness, and subtract from pure white.
		    $new_pixel = 255 - ((255-$old_pixel)+(255-$new_pixel));

		    # All the ink in the world won't make black any 
		    # blacker.
		    if($new_pixel < 1){$new_pixel = 1;}

		    # Add some noise
		    $new_pixel += sin(rand(1)) * 127;

		    # All the noise in the world won't make white any
		    # whiter.
		    if ($new_pixel > 254) {$new_pixel = 254;}

		    # PRINT 1/100th OF A DOT
		    vec($print_array,$dot+$x2,8) = $new_pixel;
		}
		# To move $dot down one pixel, just add the image width.
		$dot += $print_width;
	    }
	}
    }
    # Increment our head pin index for the next row.
    $headpin++;
    if($headpin > 7){$headpin=0;}
}

# OUTPUT (The Fast Part)
# ----------------------
print "P5\n"; # The "magic number" for binary PGM files
print "#Made with Laemeur's 9-pin Dot-Matrix Printer Simulator\n";
print "$print_width $print_height\n"; # width and height
print "255\n"; # Number of grey levels in this file

binmode STDOUT;
print $print_array;

# THE END
