#!/usr/bin/perl -w
# tab-width=4

# PRGInfo.pl
#
# Idea and original Amiga program: Anders Persson
# Windows program and future development on Windows: B. Stojalowski
# Perl port: Ian Colquhoun
#
# ChangeLog:
#		version 1.0 - March 28, 2007
#				- initial release

use strict;
use File::Basename;

my $arg1 = $ARGV[0];
my $rom = 0;
my $basic = 0;
my $ml = 0;
my $newstart = 0;
my $autostart = 0;
my $buff = "";

if (!$arg1 || $arg1 =~ /^-/) {
	print "$0 v1.0 (ported from code at http://user.tninet.se/~pug510w/datormuseum/prginfo.html)\n\n";
	print "Usage:\n";
	print "$0 file.prg\n\n";
	print "This program shows information about any CBM 8 bit file.\n";
	print "It shows the address space the file uses in memory and also\n";
	print "takes an educated guess of what the file is. (Vic20 8K plugin\n";
	print "at block 5, C64 program, program for unexpanded Vic20 etc...\n";
	print "Note that if you for example have saved a Vic20 program\n";
	print "with a C64, then $0 will think it's a C64 program.\n\n";
	exit (1);
}

my ($filename, $directory, $suffix) = fileparse($arg1);
my $info = $filename . "\n";

# Open file and read first 11 bytes
open (PRG, "<$arg1") or die "Error opening $arg1: $!\n";
binmode(PRG);
read (PRG, $buff, 11);
close (PRG);

my $lb = (ord (substr $buff,0,1) + 256) % 256;
my $hb = (ord (substr $buff,1,1) + 256) % 256;
my $a1 = (ord (substr $buff,6,1) + 256) % 256;
my $a2 = (ord (substr $buff,7,1) + 256) % 256;
my $a3 = (ord (substr $buff,8,1) + 256) % 256;
my $a4 = (ord (substr $buff,9,1) + 256) % 256;
my $a5 = (ord (substr $buff,10,1) + 256) % 256;

if (($a1 == 65) && ($a2 == 48) && ($a3 == 195) && ($a4 == 194) && ($a5 = 205)) {
    $autostart = 1;
}

my $startaddr = $hb * 256 + $lb;

if ($startaddr < 0) {
    $startaddr = 65536 + $startaddr;
}

my $size = (-s $arg1) - 2;
my $endaddr = $startaddr + $size - 1;

$info .= "\n";
$info .= sprintf("StartAddress: \$%04X = %d\n", $startaddr, $startaddr);
$info .= sprintf("EndAddress  : \$%04X = %d\n", $endaddr, $endaddr);
$info .= sprintf("Len         : \$%04X = %d\n", $size, $size);
$info .= "\n";

if ($endaddr > 65536 ) {
    $info .= "No CBM 8Bit file - end address exceeds 64k!\n";
    $info .= "\n";
}

$info .= "Computer type:\n";
$info .= "--------------\n";

# check for ROM files
if ($lb == 0) {
    if ( abs(8192 - $size) < 8 ) {
        if ($startaddr == 40960) {
            $info .= "Vic20 8K plugin for block 5\n";
            if ($autostart) {
                $info .= "Autostart on reset\n";
			}
			$ml = 1;
			$rom = 1;
		}
        elsif ($startaddr == 24576) {
            $info .= "Vic20 8K plugin for block 3\n";
            $ml = 1;
            $rom = 1;
		}
        elsif ($startaddr == 16384) {
            $info .= "Vic20 8K plugin for block 2\n";
            $ml = 1;
            $rom = 1;
		}
        elsif ($startaddr == 8192) {
            $info .= "Vic20 8K plugin for block 1\n";
            $ml = 1;
            $rom = 1;
		}
	}
    if ( abs(4096 - $size) < 8 ) {
		if ($startaddr == 40960 || $startaddr == (40960 + 4096)) {
			$info .= "Vic20 4K plugin for block 5\n";
			$ml = 1;
			$rom = 1;
			if ($autostart && ($startaddr == 40960)) {
				$info .= "Autostart on reset\n";
			}
		}
		elsif ($startaddr == 24576 || $startaddr == (24576 + 4096)) {
			$info .= "Vic20 4K plugin for block 3\n";
			$ml = 1;
			$rom = 1;
		}
		elsif ($startaddr == 16384 || $startaddr == (16384 + 4096)) {
			$info .= "Vic20 4K plugin for block 2\n";
			$ml = 1;
			$rom = 1;
		}
		elsif ($startaddr == 8192 || $startaddr == (8192 + 4096)) {
			$info .= "Vic20 4K plugin for block 1\n";
			$ml = 1;
			$rom = 1;
		}	
	}
}

if (!$rom) {
	# check for BASIC files
	if ($lb == 1) {
		$basic = 1;
		if ($startaddr == 4097 && $endaddr < 8192) {
			$info .= "Unexpanded Vic20\n";
		}
		elsif ($startaddr == 1025 && $endaddr < 8192) {
			$info .= "Vic20 with 3K expansion (block 0)\n";
		}
		elsif ($startaddr == 4609 && $endaddr < 16384) { 
			$info .= "Vic20 with 8K expansion (block 1)\n";
		}
		elsif ($startaddr == 4609 && $endaddr < 24576) {
			$info .= "Vic20 with 16K expansion (blocks 1/2)\n";
		}
		elsif ($startaddr == 4609 && $endaddr < 32768) {
			$info .= "Vic20 with 24K expansion (blocks 1/2/3)\n";
		}
		elsif ($startaddr == 7169 || $startaddr == 16385) {
			$info .= "Commodore 128\n";
			$info .= "(Or expanded Vic20 with altered basic memory address)\n";
			$newstart = 1;
		}
		elsif ($startaddr == 4097 && $endaddr < 32768) {
			$info .= "Vic20 With Super Expander\n";
			$info .= "(Or basic memory address altered for other reason) and 8K expansion or more\n";
			$newstart = 1;
		}
		elsif ($startaddr > 4609 && $endaddr < 32768) {
			$info .= "Expanded Vic20, saved from manually altered basic memory address\n";
			$newstart = 1;
		}
		elsif ($startaddr == 2049) {
			$info .= "Commodore 64\n";
			$info .= "(Or Expanded Vic20, saved from manually altered basic memory address)\n";
			$newstart = 1;
		}
		else {
			$info .= "No guess\n";
		}
	}
	else {
		$ml = 1;
		if ($startaddr >= 4096 && $endaddr < 8192) {
			$info .= "Vic20 graphics memory (standard 5K) or C64/128\n";
		}
		elsif ($startaddr >= 828 && $endaddr < 1024) {
			$info .= "Cassette buffer or sprite data\n";
		}
		elsif ($startaddr >= 1024 && $endaddr < 8192) {
			$info .= "Commodore64/128 or Vic20 with 3K expansion\n";
		}
		elsif ($startaddr >= 4608 && $endaddr < 16384) {
			$info .= "Vic20 with 8K expansion or C64/128\n";
		}
		elsif ($startaddr >= 4608 && $endaddr < 24576) {
			$info .= "Vic20 with 16K expansion or C64/128\n";
		}
		elsif ($startaddr >= 4608 && $endaddr < 32768) {
			$info .= "Vic20 with 24K expansion or C64/128\n";
		}
		elsif ($startaddr >= 40960 && $endaddr < 49152) {
			$info .= "Vic20 block 5\n";
		}
		else {
			$info .= "Commodore 64/128\n";
		}
	}
}

$info .= "\nUsage:\n";
$info .= "-------\n";

if ($ml || $rom) {
	$info .= "LOAD \"$filename\",8,1\n";
	if ($rom) {
		my $msys;
		my $fadr;
		if ($filename =~ /(sys|SYS)(\d+)\./) {
			$msys = $2;
			$info .= "SYS $msys\n";
			$fadr = 1;
		}
		if ($startaddr == 40960 && $autostart) {
			if ($fadr) {
				$info .= "(or maybe)\n";
			}
			$info .= "SYS 64802\n";
			$info .= "(or reset)\n";
		}
		if (!$autostart) {
			if ($msys != $startaddr) {
				if ($fadr) {
					$info .= "(or maybe)\n";
				}
				$info .= "SYS $startaddr\n";
			}
		}
	}
	else {
		$info .= "SYS $startaddr\n";
	}
}
else {
	if ($newstart) {
		$info .= "POKE 43,$lb:POKE 44,$hb\n";
		$info .= "POKE " . $startaddr - 1 . ",0 : NEW\n";
	}
	$info .= "LOAD \"$filename\",8\n";
	$info .= "RUN\n";
}

print $info;
