#! /usr/bin/perl -w
use CGI qw(:cgi-lib) ;
# if something goes wrong call
# &CheckerboardFracture("explanation of failure") ;
sub CheckerboardFracture {
$reason = $_[0] ;
# system("/usr/bin/rm -f /tmp/JDB.$rhost.*") ;
print &PrintHeader ;
print "\n" ;
print "
\n" ;
print "Checkerboard fracture\n" ;
print "\n" ;
print "\n" ;
print "Checkerboard fracture
\n" ;
print "Sorry your checkerboard is broken because\n" ;
print "\n" ;
print "$reason\n" ;
print "
\n" ;
print "
\n" ;
print "Your input values were\n" ;
print &PrintVariables(%input) ;
print "\n" ;
print "\n" ;
}
&ReadParse(*input) ;
# $rhost = $ENV{'REMOTE_HOST'} ;
$tempfile = "/tmp/JDB.checker.$$" ;
if ($input{'size'} >= 200) {
&CheckerboardFracture("It's too big") ;
exit ;
}
# create the upper-left square
open(ULXPMFILE, "|/usr/bin/xpmtoppm |/usr/bin/pnmtile $input{'size'} $input{'size'} > $tempfile.ul.ppm") ;
print ULXPMFILE < $tempfile.ur.ppm") ;
print URXPMFILE < $tempfile.top.ppm") ;
system("/usr/bin/pnmcat -lr $tempfile.ur.ppm $tempfile.ul.ppm > $tempfile.bot.ppm") ;
unlink("$tempfile.ur.ppm") ;
unlink("$tempfile.ul.ppm") ;
system("/usr/bin/pnmcat -tb $tempfile.top.ppm $tempfile.bot.ppm > $tempfile.sqr.ppm") ;
unlink("$tempfile.top.ppm") ;
unlink("$tempfile.bot.ppm") ;
# this silliness required because I can't find a fflush operator
open(GIFFILE, ">$tempfile.gif") ;
print (GIFFILE "Content-type: image/gif\n\n") ;
close(GIFFILE) ;
#now make the board
$sqsize = 8*$input{'size'} ;
system("/usr/bin/pnmtile $sqsize $sqsize $tempfile.sqr.ppm | ( /usr/bin/ppmtogif -interlace >> $tempfile.gif ) 2> /dev/null" ) ;
unlink("$tempfile.sqr.ppm") ;
system("/bin/cat","$tempfile.gif") ;
unlink("$tempfile.gif") ;
#&CheckerboardFracture("Just kidding") ;