#!/usr/bin/perl 
# Make an SD-card image file with 4 P800 X1215 disks -- version 0.1 -- date Jan 05 2012
#
# usage: mk4dsdm.pl <pack1>.sdi <pack2>.sdi <pack3>.sdi <pack4>.sdi
#
# - Each sector on the sd-card is 512 bytes
# - A p800 disk sector takes the 1st 410 bytes of those 512
# - A p800 disk (X1215) takes 6528 sectors
# - A disk on the sd-card takes 8192 sectors (of which 6528 are used)
# - Pack1 starts on the sd-card at sector 0     + 1
# - Pack2 starts on the sd-card at sector 8192  + 1 (hex 2000 + 1)
# - Pack3 starts on the sd-card at sector 16384 + 1 (hex 4000 + 1)
# - Pack4 starts on the sd-card at sector 24476 + 1 (hex 6000 + 1)
#
# Sector 0 is a header
# Sector 32768 - 1 (hex 8000 - 1) is a trailer
# Header and trailer are used for automatic recognition of the
# file on sd-card by the P856 in the fpga.
# At startup of the P856 Panel program a program in the P856
# fpga tries to find the file with the disk images with the
# aid of the header/trailer
#
# Bytes of sectors 6528..8191 of each pack are filled with 0xFF.
use strict;
use bytes;
my $DEBUG = 1;
my $version = 0.1;
print "Make a marked SD-card image with 4 P800 disks, version $version\n";

my $file1 = shift;
my $file2 = shift;
my $file3 = shift;
my $file4 = shift;

if ($file1 eq "" || $file1 !~ /\.sdi/)
{
    print "No filename for image 1, or wrong .sdi extention\n";
    exit;
}
if ($file2 eq "" || $file2 !~ /\.sdi/)
{
    print "No filename for image 2, or wrong .sdi extention\n";
    exit;
}
if ($file3 eq "" || $file3 !~ /\.sdi/)
{
    print "No filename for image 3, or wrong .sdi extention\n";
    exit;
}
if ($file4 eq "" || $file4 !~ /\.sdi/)
{
    print "No filename for image 4, or wrong .sdi extention\n";
    exit;
}

if( -e $file1)
{
	open (IN,$file1) || die "cannot open disk image file $file1: $!";
}
else
{
    print "Disc image $file1 not existing\n";
	exit;
}
close (IN)   || die "can't close $file1: $!";
if( -e $file2)
{
	open (IN,$file2) || die "cannot open disk image file $file2: $!";
}
else
{
    print "Disc image $file2 not existing\n";
	exit;
}
close (IN)   || die "can't close $file2: $!";
if( -e $file3)
{
	open (IN,$file3) || die "cannot open disk image file $file3: $!";
}
else
{
    print "Disc image $file3 not existing\n";
	exit;
}
close (IN)   || die "can't close $file3: $!";
if( -e $file4)
{
	open (IN,$file1) || die "cannot open disk image file $file4: $!";
}
else
{
    print "Disc image $file1 not existing\n";
	exit;
}
close (IN)   || die "can't close $file4: $!";

my $outfile = "sd4pack.sdm";
my $s;
my $buf;
my $i;
my $ws=0;
print "The generated image file is: $outfile\n";

open (OUT,">:raw", $outfile) || die "cannot open ouputfile $outfile: $!";
#
print "Header at sector: $ws\n";
wrheader();

open (IN,$file1) || die "cannot open disk image file $file1: $!";
print "Copy $file1 to pack0\n";
$s=0;
print "Image 0 at sector: $ws\n";
while($s<6528)
{
    readsector($s);
    writenextsector();
    $s=$s+1;
}
print "$file1 copied, $s sectors written, fill slack of pack0\n";
$i=0;
while($s<8192)
{
    wrslack();
    $s=$s+1;
    $i=$i+1;
}
print "$i slack sectors written for pack0\n";
close (IN)   || die "can't close $file1: $!";
#
open (IN,$file2) || die "cannot open disk image file $file2: $!";
print "Copy $file2 to pack1\n";
$s=0;
print "Image 1 at sector: $ws\n";
while($s<6528)
{
    readsector($s);
    writenextsector();
    $s=$s+1;
}
print "$file2 copied, $s sectors written, fill slack of pack1\n";
$i=0;
while($s<8192)
{
    wrslack();
    $s=$s+1;
    $i=$i+1;
}
print "$i slack sectors written for pack1\n";
close (IN)   || die "can't close $file2: $!";
#
open (IN,$file3) || die "cannot open disk image file $file3: $!";
print "Copy $file3 to pack2\n";
$s=0;
print "Image 2 at sector: $ws\n";
while($s<6528)
{
    readsector($s);
    writenextsector();
    $s=$s+1;
}
print "$file3 copied, $s sectors written, fill slack of pack2\n";
$i=0;
while($s<8192)
{
    wrslack();
    $s=$s+1;
    $i=$i+1;
}
print "$i slack sectors written for pack2\n";
close (IN)   || die "can't close $file3: $!";
#
open (IN,$file4) || die "cannot open disk image file $file4: $!";
print "Copy $file4 to pack3\n";
$s=0;
print "Image 3 at sector: $ws\n";
while($s<6528)
{
    readsector($s);
    writenextsector();
    $s=$s+1;
}
print "$file4 copied, $s sectors written, fill slack of pack3\n";
$i=0;
# the total length of the file still remains 32768 sectors
# sector 0 is the header and sector 32767 is the trailer
while($s<8190)  #<<<<<<<< 2 less to leave space for header/trailer
{
    wrslack();
    $s=$s+1;
    $i=$i+1;
}
print "$i slack sectors written for pack2\n";
#
print "Trailer at sector: $ws\n";
wrtrailer();
#
close (IN)   || die "can't close $file4: $!";
close (OUT)  || die "can't close $outfile: $!";
print "Four pack SD-card image file $outfile ready, $ws sectors written\n";
print "Rename the image file in case another one has to be made\n";

###################################################################

sub readsector {
    my $s=shift;
    my $pos=$s*512;
	if(sysseek(IN, $pos, 0) ne undef)
	{    
        	if(sysread(IN, $buf, 512) != 512)
        	{
            		print "Readsector: Error while reading sector $s\n";
            		exit;
        	}
    	}
    	else
	{
		print "Readsector: Seek error while reading sector $s\n";
		exit;
	}	        
}

sub writenextsector {
    my $pos=$ws*512;
	if(sysseek(OUT, $pos, 0) ne undef)
	{    
        	if(syswrite(OUT, $buf, 512) != 512)
        	{
            		print "Writesector: Error while writing sector $ws\n";
            		exit;
        	}
    	}
    	else
	{
		print "Writesector: Seek error while writing sector $ws\n";
		exit;
	}
    	$ws=$ws+1; # point to next sector to write
}

sub wrslack {
    # write a slack sector to the disk pack
    my $pos=$ws*512;
    my $j=0;
    my $b=pack("C", 0xFF);
	if(sysseek(OUT, $pos, 0) ne undef)
	{
        while($j<512)
        {
            if(syswrite(OUT, $b, 1) != 1)
            {
                print "Writeslacksector: Error while writing sector $ws\n";
            }
            $j=$j+1;
        }
    }
    else
	{
		print "Writeslacksector: Seek error while writing sector $ws\n";
	}
    $ws=$ws+1; # point to next sector to write
}

sub wrheader {
	$buf = pack("CCCC", 0xAAAA);		# 4
	$buf = $buf . "P800FILEHEADER  ";	# 16
	my $b=pack("C", 0xFF);
	my $i=20;
	while ($i<512)
	{
		$buf = $buf . $b;
		$i=$i+1;
	}
	writenextsector();
}

sub wrtrailer {
	$buf = pack("CCCC", 0xAAAA);		# 4
	$buf = $buf . "P800FILETRAILER ";	# 16
	my $b=pack("C", 0xFF);
	my $i=20;
	while ($i<512)
	{
		$buf = $buf . $b;
		$i=$i+1;
	}
	writenextsector();	
}