#!/usr/bin/perl 
# 2aptape.pl
# convert textfile to an asr ascii papertape
# lower case characters are converted to upper case
# tabs are expanded to the specified tab-stops
#
# output record format OLD ($NEW="FALSE"):
# 	leader (0000)
#	linefeed (0212)
#	textrecord (to UPPER)
#	x-off (0223)
#	carriage return (0215)
#   rubout (377)
#   linefeed
#   textrecord
#   ....
#	trailer (0000)
#
# output record format NEW ($NEW="TRUE"):
# 	leader (0000)
#	linefeed (0212)
#	textrecord (to UPPER)
#	carriage return (0215)
#	x-off (0223)
#   rubout (377)
#   linefeed
#   textrecord
#   .....
#	trailer (0000)
#
## usage: 2aptape text.txt
##  output: text.src
#
use strict;
use bytes;
my $DEBUG = 0;
# tab stops
my $tabp1=5;
my $tabp2=11;
my $tabp3=29;
# set punch FORMAT
my $NEW="TRUE";
#
#
my $lf 		= 0212;
my $null 	= 0000;
my $xoff 	= 0223;
my $cr 		= 0215;
my $rub		= 0377;
my $eom     = 0203;
my $blk     = 0240;
my $setp 	= 0200;
my $mskp 	= 0177;

my $fi = shift (@ARGV);
if ($fi eq "" || $fi !~ /\.txt/)
{
    print "No filename, or wrong .txt extention\n";
    exit;
}

my $fo = "";
my $ty = "";
my $ftext = "";
($fo,$ty) = split(/\./, $fi);
$ftext = $fo . ".text";		# expanded input text file
$fo    = $fo . ".src";		# punch output file (DDP Ascii code)


print "Convert $fi to the ascii papertape $fo\n";
print "Start reading $fi\n";

open (IN,$fi) || die "cannot open inputfile $fi: $!";
open (TXT, ">temp") || die "cannot open outputfile temp: $!";
open (BIN, ">:raw", $fo) || die "cannot open outputfile $fo: $!";

# punch leader
my $i=0;
for ($i=0; $i<200; $i++)
{    
    punch ($null);
}

my $cin=0;		# number of lines read in
my $cout=0;		# number of lines punched
my $l;			# input record length
my $ch;			# char input record
my $ptrin=0;	# input record char pointer 0..n-1
my $ptrout=0;	# output record char pointer 0..m-1
my $line = "";	# assembled expanded input text record 

while (<IN>)
{   
	$cin=$cin+1;
	$ptrin=0;
    $ptrout=0;	
	$line = "";
	$l=length($_);
	punch ( $lf );				# punch line feed
	tr/[a-z]/[A-Z]/;			# to upper case
 	while($ptrin < $l)   
    {
        $ch=substr($_,$ptrin,1);			# get next char from input record
		$ptrin=$ptrin+1;		
		if( $ch =~ /\t/ || $ch =~ /\\/)		# replace tab by one or more spaces
		{
					# replace tab by space
					print " ";							#console
					punchspace();                  		#.src file
					$line=$line . " ";					#.text file
					$ptrout=$ptrout+1;
					if($ptrout <= $tabp1)
					{
							while($ptrout<$tabp1)
							{
									print " ";			#console
									punchspace();      	#.src file
									$line=$line . " ";	#.text file
					                $ptrout=$ptrout+1;
							}
							next;
					}
					if($ptrout <= $tabp2)
					{
							while($ptrout<$tabp2)
							{
									print " ";			#console
									punchspace();     	#.src file
									$line=$line . " ";	#.text file
					                $ptrout=$ptrout+1;
							}
							next;
					}
					if($ptrout <= $tabp3)
					{
							while($ptrout<$tabp3)
							{
									print " ";			#console
									punchspace();     	#.src file
									$line=$line . " ";	#.text file
					                $ptrout=$ptrout+1;
							}
							next;
					}
		}
		elsif($ch ne "\n")
		{
				$line=$line . $ch;						#.text file				
				$ch=unpack("C",$ch) ;
				print chr($ch);							#console
				$ch=$ch & $mskp;
				$ch=$ch | $setp;
				punch($ch);								#.src file
    			$ptrout=$ptrout+1;
		}
	}
	#
	# end of record
	#
	print "\n";											#console
	$line = $line . "\n";
	print TXT $line;    # write record to temp			.text file

	if($NEW eq "FALSE")									#.src file
	{
		punch ( $xoff );
		punch ( $cr );
		punch ( $rub );
	}
	if($NEW eq "TRUE")									#.src file
	{
		punch ( $cr );
		punch ( $xoff );
		punch ( $rub );
	}
	$cout=$cout+1;
}

# end of tape

punch ($eom);
punch ($xoff);
punch ($rub);
	
# trailer
$b=0;
$i=0;
for ($i=0; $i<200; $i++)
{
    punch ($null);
}

close (IN)  || die "can't close $fi: $!";
close (TXT) || die "can't close temp: $!";
close (BIN) || die "can't close $fo: $!";

rename( "temp", $ftext);   
print "End of papertape conversion\n";
print "$cin  lines read from $fi\n";
print "$cout lines writtten to $fo\n";


sub punch {
    my($a) = @_;
    my $byte=0;
    $byte = pack("C", $a);
    print BIN $byte;
}

sub punchspace {
    my $byte=0;
	$byte = pack("C", $blk);
	print BIN $byte;
}
