one-screen.pl

This script uses GD to clean up a screenshot from Montezuma's Revenge, before stitching 100 of these into a map of an entire level. It removes the Inventory and score panels, tries to find and remove Panama Joe, and finally saves the screen with the border cropped away. The script is not intended for use as is (but rather for inspiration if you want to do something similar), and is therefore rather crude, especially concerning the hard-coded paths to the files, and the command line arguments.

If you are not satisfied with the listing below, you can also download one-screen.pl.

#!/usr/bin/perl -w
use GD;

sub imageSaveWithoutBorder {
    $imageOriginal = shift;
    $imageName = shift;
    $imageSave = GD::Image->new(320,197);
    $imageSave->copy($imageOriginal,0,0,32,35,320,197);
    open(IMAGEOUT,">$imageName") or die("Could not open file $imageName for writing");
    binmode IMAGEOUT;
    print IMAGEOUT $imageSave->png;
    close IMAGEOUT;
}

sub imageFillWithTile {
my ($x,$y,$maxX,$maxY) = @_;
my $remainingX = 0;
my $remainingY = 0;
    for (my $s = $x; $s < $maxX; $s += 8) {
	for (my $t = $y; $t < $maxY; $t += 8) {
	    $remainingX = $maxX - $s;
	    $remainingY = $maxY - $t;
	    if ($remainingX > 8) {
		$remainingX = 8;
	    }
	    if ($remainingY > 8) {
		$remainingY = 8;
	    }
	    $imageCurrent->copy($imageTile,$s,$t,0,0,$remainingX,$remainingY);
	}
    }
}

sub imageRemoveInventory {
    imageFillWithTile(32,35,144,64);
    imageFillWithTile(240,35,352,64);
}

sub isHeroAt {
my ($x,$y,$hero)=@_;
my ($s,$t);
my ($maxs, $maxt) = $hero->getBounds();
    return 0 if ($imageCurrent->getPixel($x+9,$y+11) != $hero->getPixel(9,11)) ;
    return 0 if ($imageCurrent->getPixel($x+6,$y+11) != $hero->getPixel(6,11)) ;
    for ($s=0;$s<$maxs;$s++) {
	for ($t=0;$t<$maxt;$t++) {
	    return 0 if ($imageCurrent->getPixel($x+$s,$y+$t) != $hero->getPixel($s,$t)) ;
	}
    }
    return 1;
}

$filename=shift or die("must have one argument");
$manLeft = GD::Image->new("../man-left.png");
$manRight = GD::Image->new("../man-right.png");
$imageCurrent = GD::Image->new($filename);
$imageTile = GD::Image->new(8,8);
$imageTile->copy($imageCurrent,0,0,232,35,8,8);
$black=$imageCurrent->getPixel(0,0);

imageRemoveInventory();

FIND_LABEL:
for ($s=32;$s<336;$s++) {
    for ($t=35;$t<212;$t++) {
	last FIND_LABEL if isHeroAt($s,$t,$manLeft);
	last FIND_LABEL if isHeroAt($s,$t,$manRight);
    }
}

if ($s!=336) {
    $imageCurrent->filledRectangle($s,$t,$s+15,$t+19,$black);
    $savedir="ok/";
} else {
    $savedir="manual/";
}


imageSaveWithoutBorder($imageCurrent,$savedir.$filename);
Last updated: 2007.01.24