#!/usr/bin/perl -- -*-perl-*-

# Eple: assemble .DSK file from those dropped on the program
# 		(c) 2002 Systeme D
#		doesn't yet check if too many directory entries
#		no sector interleave yet

# @args = ("H1.MXM","PLSPR.BIN","SMLMESS.TXT");			# files to test on
use constant USER => 0;									# user number
use constant SEPARATOR => ':';							# directory separator

# ------------------------------------------------------------------------------------------
# Stage 1: Prepare size of image
# ------------------------------------------------------------------------------------------

$totalrecs = 2;											# total number of records so far
$pointer = 0;											# which file are we up to?

foreach $inputFile (@ARGV) {    						# @args for testing

	# ---- Open file

	open (INFILE, $inputFile) or die "Can't open $inputFile: $!\n";

	# ---- Get size of file

    ($a,$a,$a,$a,$a,$a,$a,$size,$a,$a,$a,$a,$a) = stat(INFILE);
	$rec = Round($size/1024);

	if (($rec+$totalrecs)>180) {
		die "$inputFile: Too many files for a data format .DSK";
	}

	$filename[$pointer]  = $inputFile;
	$filestart[$pointer] = $totalrecs;
	$filesize[$pointer]  = $size;
	$filerecs[$pointer]  = $rec;
	$extents[$pointer]	 = Round($rec/16);
	$cpmrecs[$pointer]	 = Round($size/128);

	print "File $pointer: $inputFile. Start record: $totalrecs. Size: $size. Records: $rec. Extents: $extents[$pointer].\n";
	$totalrecs=$totalrecs+$rec;
	$pointer++;
	close INFILE;

}

$totalfiles = $pointer-1;								# how many files written?

# ------------------------------------------------------------------------------------------
# Stage 2: Start writing .DSK
# ------------------------------------------------------------------------------------------

print "Enter .DSK filename: ";
chomp ($dskfile = <STDIN>);
$dskfile = uc $dskfile.".DSK";

open (OUTFILE, ">$dskfile");

# ---- Write image header

print OUTFILE "EXTENDED CPC DSK File\x0D\x0A";
print OUTFILE "Disk-Info\x0D\x0A";
print OUTFILE "Eple v1.0\x00\x00\x00\x00\x00";
print OUTFILE "(\x01\x00\x00";
print OUTFILE "\x13" x 40;
print OUTFILE "\x00" x 164;

# ------------------------------------------------------------------------------------------
# Stage 3: Write directory
# ------------------------------------------------------------------------------------------

$track = 0;
$trackbytes = 0;
NewTrack();

for ($i=0; $i<=$totalfiles; $i++) {

	# ---- Convert filename into 8.3 format

	$thisfile = $filename[$i];
	$thisfile = substr($thisfile,rindex($thisfile,SEPARATOR)+1);
	if (index($thisfile,'.') == -1) {
		$mainname =$thisfile;
		$extension='   ';
	} else {
		$mainname =substr($thisfile,0,index($thisfile,'.'));
		$extension=substr($thisfile,  index($thisfile,'.')+1);
	}
	if (length($mainname)>8 or length($extension)>3) {
		die "$thisfile: incorrect filename format";
	}
	$mainname  = uc $mainname . ' ' x (8-length($mainname ));
	$extension = uc $extension. ' ' x (3-length($extension));

	$cpmrec = $cpmrecs[$i];
	$rec = $filerecs[$i];
	for ($extent=0; $extent<$extents[$i]; $extent++) {
		print OUTFILE chr(USER);						# user number
		print OUTFILE $mainname;						# filename
		print OUTFILE $extension;						#  |
		print OUTFILE chr($extent);						# extent
		print OUTFILE "\x00\x00";						# not used
		print OUTFILE chr(Smaller($cpmrec,128));		# number of 128-byte records

		$blanks=16;										# write extent numbers
		for ($extwrite=0; $extwrite<Smaller(16,$rec); $extwrite++) {
			print OUTFILE chr($extent*16+$filestart[$i]+$extwrite);
			$blanks--;
		}
		print OUTFILE "\x00" x $blanks;					# fill with 00s
		
		$rec=$rec-16;
		$cpmrec=$cpmrec-128;
		$trackbytes=$trackbytes+32;
	}
}

print OUTFILE "\xE5" x (2048-$trackbytes);				# write unused directory entries
$trackbytes = 2048;										#  |

# ------------------------------------------------------------------------------------------
# Stage 4: Write files
# ------------------------------------------------------------------------------------------

for ($i=0; $i<=$totalfiles; $i++) {

	open (INFILE, $filename[$i]) or die "Can't open $filename[$i]: $!\n";
	for ($rec=0; $rec<$filerecs[$i]; $rec++) {
		# print "$filename[$i]: Writing record $rec of $filerecs[$i]\n";
		read INFILE,$buffer,1024;
		$buffer = $buffer . ("\xE5" x (1024-length($buffer)));
		print OUTFILE substr($buffer,0,512);
		TrackCheck();
		print OUTFILE substr($buffer,512,512);
		TrackCheck();
	}
	close INFILE;
}

$buffer = "\xE5" x 512;
while ($track<40) {
	print OUTFILE $buffer;
	TrackCheck();
}

close OUTFILE;

print "$dskfile successfully written.\n";

# ------------------------------------------------------------------------------------------
# Subroutine: Write track header (+ internal routine)
#			  Check whether new track yet
# ------------------------------------------------------------------------------------------

sub NewTrack {
	print OUTFILE "Track-Info\x0D\x0A\x00\x00\x00\x00";
	print OUTFILE chr($track)."\x00\x00\x00\x02\x09\x4E\xE5";
	for ($r=0xC1; $r<0xCA; $r++) {
		SectorID($r);
	}
	print OUTFILE "\x00" x 160;
}

sub SectorID {
	print OUTFILE chr($track)."\x00";
	print OUTFILE chr($_[0])."\x02";
	print OUTFILE "\x00\x00\x00\x02";
}

sub TrackCheck {
	$trackbytes = $trackbytes+512;
	if ($trackbytes == 4608) {
		$trackbytes = 0;
		$track++;
		if ($track<40) {
			NewTrack();
		}
	}
}

# ------------------------------------------------------------------------------------------
# Subroutine: Round up to nearest integer unless already an integer
#			  Return smaller of two numbers
# ------------------------------------------------------------------------------------------

sub Round {
	$z = $_[0];
	if ($z == int $z) {
		return $z;
	} else {
		return (int $z) + 1;
	}
}

sub Smaller {
	if ($_[0]<$_[1]) {
		return $_[0];
	} else {
		return $_[1];
	}
}