hidewords

#!/usr/bin/perl -w
#
# print (on a PostScript printer) one or more words "hidden"
# in an array of noise characters.
#

use strict;
use Getopt::Std;

my %opts;	# command line options
my ($x, $y);	# array indices
my ($i, $j);	# more array indices
my $c;		# a character
my ($total, $nlower, $nupper, $npunct, $ndigit, $nspace); # character counts
my $word;	# word from list of words to hide
my $r;		# random value
my @c;		# character 2-d array
my @used;	# keeps track of used positions in array
my ($xpos, $ypos); # random starting position in array
my ($dx, $dy);  # random direction from the starting position

getopts('P:', \%opts) || die "Usage: $0 [-P <printer>]\n";

#
# size of character array
#
my $ncols = 23;
my $nrows = 14;

#
# this is probably nonportable outside ASCIIland
#
my @upper = ('A'..'Z');
my @lower = ('a'..'z');
my @digit = ('0'..'9');
my @punct = qw(! " # $ % & ' ( ) * + , - . / : ; < = > ? @ [ \ ] ^ _ ` { | } ~);

#
# get list of words to hide
#
print "Enter one or more words to hide in the character array;\n";
print "Type ctrl-D when through:\n";

my @wlist = ();
while (<>) {
    chomp;
    push(@wlist, $_);
}

#
# erase screen so the magic words aren't left hanging.
#
system("clear");

#
# count different kinds of characters in words
#
$total = $nlower = $nupper = $npunct = $ndigit = $nspace = 0;
foreach $word (@wlist) {
    for ($i = 0; $i < length($word); $i++) {
	$c = substr($word, $i, 1);
	$total++;
	if ($c =~ /[[:lower:]]/) {
	    $nlower++;
	}
	elsif ($c =~ /[[:upper:]]/) {
	    $nupper++
	}
	elsif ($c =~ /[[:digit:]]/) {
	    $ndigit++;
	}
	elsif ($c =~ /[[:punct:]]/) {
	    $npunct++;
	}
	elsif ($c =~ /[[:space:]]/) {
	    $nspace++;
	}
	else { # ???
	    die "Sorry, I don't do characters like $c\n";
	}
    }
}

#
# generate character array with random characters, 
# with approximately the same distribution of character 
# classes as found in words to be hidden
#
for ($i = 0; $i < $ncols; $i++) {
    for ($j = 0; $j < $nrows; $j++) {
	$r = int(rand($total));
	if ($r < $nlower) {
	    $c[$i][$j] = $lower[rand(scalar @lower)];
	}
	elsif ($r < $nlower + $nupper) {
	    $c[$i][$j] = $upper[rand(scalar @upper)];
	}
	elsif ($r < $nlower + $nupper + $ndigit) {
	    $c[$i][$j] = $digit[rand(scalar @digit)];
	}
	elsif ($r < $nlower + $nupper + $ndigit + $npunct) {
	    $c[$i][$j] = $punct[rand(scalar @punct)];
	}
	else {
	    $c[$i][$j] = " ";
	}
	$used[$i][$j] = "N";
    }
}

#
# place the words into the array
#
foreach $word (@wlist) {
    #
    # try up to 100 times to put it somewhere
    #
    my $success = 0; my $tries = 0;
    while ($success == 0 && $tries < 100) {
	$tries++;
	#
	# pick a random starting point in the array
	# and a random direction
	#
	$xpos = int(rand($ncols));
	$ypos = int(rand($nrows));
	$dx = int(rand(3)) - 1;
	$dy = int(rand(3)) - 1;
	#
	# check for bad direction (going nowhere)
	#
	next if ($dx == 0 && $dy == 0);
	#
	# make sure we don't run off the edge of the array
	#
	next if ($xpos + $dx * length($word) >= $ncols);
	next if ($xpos + $dx * length($word) < 0);
	next if ($ypos + $dy * length($word) >= $nrows);
	next if ($ypos + $dy * length($word) < 0);
	#
	# and check to be sure we don't overwrite a previously-placed
	# word with a different character (same character is OK, though)
	#
	my $collide = 0;
	for ($i = 0; $i < length($word); $i++) {
	    $x = $xpos + $i * $dx;
	    $y = $ypos + $i * $dy;
	    if ($used[$x][$y] eq "Y" && $c[$x][$y] ne substr($word, $i, 1)) {
		$collide = 1;
		last;
	    }
	}
	next if $collide;
	#
	# seems to be OK to put it here...
	#
	for ($i = 0; $i < length($word); $i++) {
	    $x = $xpos + $i * $dx;
	    $y = $ypos + $i * $dy;
	    $c[$x][$y] = substr($word, $i, 1);
	    $used[$x][$y] = "Y";
	}
	$success = 1;
    }
    if ($success == 0) {
        die "Failed to place word, sorry\n";
    }
}

#
# output about credit card size...
#
my $ysize = int(2.125 * 72);
my $xsize = int(3.375 * 72); 
#
# center on 8.5x11 paper...
#
my $x0 = int((8.5 * 72  - $xsize)/2);
my $y0 = int((11.0 * 72 - $ysize)/2);

#
# output PostScript to the default (or specified) printer
#
open(PS, "|lpr" . $opt_P ? " -P $opt_P" : "");
# for debugging use this instead.
# open(PS, ">tmp.ps");

print PS "%!\n";
print PS "newpath\n";
print PS "$x0 $y0 moveto\n";
print PS "0 $ysize rlineto\n";
print PS "$xsize 0 rlineto\n";
print PS "0 -$ysize rlineto\n";
print PS "closepath\n";
print PS "2 setlinewidth\n";
print PS "stroke\n";

print PS "/Courier-Bold findfont\n";
print PS "11 scalefont\n";
print PS "setfont\n";
for ($i = 0 ; $i < $ncols; $i++) {
    for ($j = 0; $j < $nrows; $j++) {
	$xpos = $x0 + 8 + 10 * $i;
	$ypos = $y0 + 8 + 10 * $j;
	#
        # parens and backslashes need to be escaped in the PS
	#
	if ($c[$i][$j] eq "(" || $c[$i][$j] eq ")" || $c[$i][$j] eq "\\") {
	    print PS "$xpos $ypos moveto (\\$c[$i][$j]) show\n"
	}
	else {
	    print PS "$xpos $ypos moveto ($c[$i][$j]) show\n"
	}
    }
}
print PS "showpage\n";
close(PS);