#!/usr/bin/perl -w

# render jumpman junior levels to PNG files, by reading the graphics
# and map data from the ROM image. input is 'jumpman.rom' in the current
# directory, output is level01.png through level12.png in the current dir.

# this code won't win any beauty contests, but it does work.

$verbose = 2; # 0 = quiet, 2 = very chatty

$black_is_white = 0; # 1 = draw all-black shapes in white. only affects
                     # level09.png (the bombs are invisible there).

use Image::Magick;
use bytes;

sub getbyte {
	return ord(substr($rom, $_[0], 1));
}

sub getword {
	return getbyte($_[0]) + 256 * getbyte($_[0] + 1);
}

sub getdelta {
	return $_[0] < 128 ? ($_[0]) : ($_[0] - 256);
}

# placeholder colors. ideally we'd have a full Atari palette, and read
# the color register values from the level desc in the rom.
%palette = (
		0 => [ 0x0000, 0x0000, 0x0000 ],  # background
		1 => [ 0x0000, 0x0000, 0x8000 ],  # girders, up-ropes
		2 => [ 0x0000, 0x8000, 0x0000 ],  # ladders, down-ropes
		3 => [ 0x8000, 0x0000, 0x8000 ],  # bombs
);

sub draw {
	my ($img, $shape, $dx, $dy, $xpos, $ypos, $copies) = @_;
	my $shaddr = sprintf("%04x", $shape);
	my $shname = $shapes{$shaddr} || "???";
	warn sprintf "drawing shape $shname ($shaddr) at %02x,%02x copies $copies, delta ($dx, $dy)\n", $xpos, $ypos if $verbose > 1;
	my $white = 0;
	if($black_is_white && ($shape == 0x9c89 || $shape == 0x9ceb || $shape == 0x9c49)) {
		warn "drawing all-black shape in white\n";
		$white = 1;
		#$shape = 0x9c89; # see the other black shapes in level09.png
		#$shape = 0x9ceb;
	}
	while($copies--) {
		my $width;
		my $addr = $shape;
		while(($width = getbyte($addr++)) != 0xff) {
			my $xoffs = getdelta(getbyte($addr++));
			my $yoffs = getdelta(getbyte($addr++));
			for(my $p = 0; $p < $width; $p++) {
				my $pixel = getbyte($addr++);
				my $color = $palette{$pixel};
				if($white) {
					$color = [ 0xffff, 0xffff, 0xffff]; # make invisible stuff show up white
				}
				$img->SetPixel(x => $xpos + $xoffs + $p, y => $ypos + $yoffs, color => $color);
			}
		}
		$xpos += $dx;
		$ypos += $dy;
	}
}

#main()
open I, "<main.info" or die $!;
while(<I>) {
	next unless /^label\s+{\s+name\s+"(sh_\w+)".*addr\s+\$([0-9a-fA-F]+);/;
	$shapes{lc $2} = $1;
}
close I;

if($verbose > 1) {
	print "addr shape\n";
	for(sort keys %shapes) {
		print "$_ $shapes{$_}\n";
	}
}

open ROM, "<jumpmanjr.rom" or die $!;
if((read ROM, $rom, 0x4000, 0x8000) != 0x4000) {
	die "couldn't read ROM\n";
}

for my $level (1..12) {
	my $img = Image::Magick->new;
	$img->Set(size => '160x100');
	$img->ReadImage('canvas:black');

	my $desc = 0xa000 + 0x40 * ($level - 1) + 22;
	my $mapaddr = getword($desc);

	if($level == 9) {
		# show real map for blackout, not the blank one.
		# the bombs are still invisible though.
		$mapaddr = 0xb000;
	}

	warn sprintf("level $level, map pointer at \$%04x, points to \$%04x\n", $desc, $mapaddr) if $verbose;

	# don't initialize these, we want warnings if some level
	# tries to draw without selecting shape and direction.
	my $shape;
	my $copies;
	my $dx;
	my $dy;
	my $xpos;
	my $ypos;

	while(1) {
		my $opcode = getbyte($mapaddr);
		if($opcode eq 0xff) {
			warn sprintf "  got end opcode (\$ff) at \$%04x\n", $mapaddr if $verbose > 1;
			last;
		}

		my $operand1 = getbyte($mapaddr + 1);
		my $operand2 = getbyte($mapaddr + 2);
		my $opword = getword($mapaddr + 1);
		warn sprintf "%04x:   %02x   %02x %02x\n", $mapaddr, $opcode, $operand1, $operand2 if $verbose > 1;
		$mapaddr += 3;

		if($opcode == 0xfe) {
			$shape = $opword;
			warn sprintf "set shape %04x\n", $shape if $verbose > 1;
		} elsif($opcode == 0xfd) {
			$dx = getdelta($operand1);
			$dy = getdelta($operand2);
			warn "set delta X $dx, delta Y $dy\n" if $verbose > 1;
		} elsif($opcode == 0xfc) {
			$mapaddr = $opword;
			next;
		} else {
			$xpos = $opcode;
			$ypos = $operand1;
			$copies = $operand2;
			draw($img, $shape, $dx, $dy, $xpos, $ypos, $copies);
		}
	}

	my $pngfile = sprintf("level%02d.png", $level);
	open my $out, ">$pngfile";
	$img->Write(file => $out, filename => $pngfile);
	close $out;
	warn "wrote $pngfile\n";
}