#!/opt/local/bin/perl
#
#  Name:  pack_fragtext.pl -- Pack texture/fragment names and codes
#
#  Purpose:
#	This script uses the output from script get_fragtext.pl to
#	create two sets of packed versions of the dominant texture class
#	and rock fragment class modifier for each layer of each mapunit,
#	one using the standard texture or fragment class abbreviations,
#	and one using the numeric codes for the standard classes.  Each
#	output record also includes the mean depth to bedrock.  The
#	outputs are in a packed binary format suitable for ingest into
#	INFO tables, defined by aml scripts def_soiltext_items.aml and
#	def_rockfrag_items.aml.
#
#  Usage:
#	perl pack_fragtext.pl tcodetab fcodetab infile textnames
#			      textcodes fragnames fragcodes
#
#  Options and Arguments:
#	tcodetab	Table of soil-texture numeric codes and
#			abbreviated class names.  Records having a
#			numeric value in the first field are assummed
#			to have the corresponding abbreviated class name
#			in the second field.
#	fcodetab	Table of fragment modifier numeric codes and
#			abbreviated class names.  Records having a
#			numeric value in the first field are assummed
#			to have the corresponding abbreviated fragment
#			modifier name in the second field.
#	infile		Name of input file containing standard soil
#			texture and fragment-modifier class
#			abbreviations in the format produced by script
#			get_fragtext.pl.
#	textnames	Name of output file for abbreviated soil texture
#			class names.
#	textcodes	Name of output file for soil texture codes.
#	fragnames	Name of output file for abbreviated fragment
#			modifier names.
#	fragcodes	Name of output file for fragment codes.
#
#  External associations:
#	This script is part of a package for extracting soil texture and
#	rock fragment information from STATSGO data.  Input is in the
#	format generated by script get_fragtext.pl.  The outputs are in
#	the Arc/Info binary formats defined by scripts
#	def_soiltext_items.aml and def_rockfrag_items.aml.
#
#  External files accessed:
#	These files are described under agruments, above.
#
#  Internal subroutines defined:
#	help		Output help text.
#	usage		Output terse usage text.
#
#  Internal variables:
#	CODE		File handle for input code table.
#	IN		File handle for input fragment/texture data.
#	FRAGC		File handle for output rock fragment codes.
#	FRAGN		File handle for output rock fragment names.
#	TEXTC		File handle for output soil texture codes.
#	TEXTN		File handle for output soil texture names.
#	cmd		Name of this script; used for help text.
#	frag		Current rock-fragment abbreviation.
#	fragcodes	Associative array of fragment code values.
#	frags		Array of fragment names for each layer.
#	layer		Current layer of mapunit.
#	muid		Mapunit ID for current record.
#	opt		Name of current option.
#	rockd		Mean depth to bedrock.
#	text		Current fragtext abbreviation.
#	textcodes	Associative array of fragtext code values.
#	texts		Array of texture names for each layer.
#
#  Script history:
#	01-96	Initial texture-only version, R. A. White
#	12-96	Generalized for rock fragment also, R. A. White
#
############   End of Prolog for Script pack_fragtext.pl   ############

#  Define usage and help text

@cmd =  (split ('/', $0));
$cmd = pop (@cmd);

sub usage
    {
    print "\n";
    print "Usage:  perl $cmd tcodetab fcodetab infile textnames\n",
	  "			      testcodes fragnames fragcodes\n";
    print "        perl $cmd -u|h\n";
    }

sub help
    {
    print "\n";
    print $cmd, " -- pack fragment/texture names and codes\n";
    &usage;
    print "\n";
    print "Options and arguments are\n";
    print "     -h   	Write this help text to stdout and exit.\n";
    print "     -u   	Display terse usage message and exit.\n";
    print "  tcodetab	Table of soil-texture numeric codes and\n",
	  "		abbreviated class names.  Records having a\n",
	  "		numeric value in the first field are",
			" assummed\n", 
	  "		to have the corresponding abbreviated class",
			" name\n",
	  "		in the second field.\n";
    print "  fcodetab	Table of fragment modifier numeric codes and\n",
	  "		abbreviated class names.  Records having a\n",
	  "		numeric value in the first field are",
			" assummed\n",
	  "		to have the corresponding abbreviated",
			" fragment\n",
	  "		modifier name in the second field.\n";
    print "   infile	Name of input file containing standard soil\n",
	  "		texture and rock-fragment-modifier class\n",
	  "		abbreviations in the format produced by",
			" script\n",
	  "		get_fragtext.pl.\n";
    print "  textnames	Name of output file for abbreviated soil",
			" texture\n",
	  "		class names.\n";
    print "  textcodes	Name of output file for soil texture codes.\n";
    print "  fragnames	Name of output file for abbreviated fragment\n",
	  "		modifier names.\n";
    print "  fragcodes	Name of output file for fragment codes.\n";
    }

#  Get options

while ($ARGV[0] =~ /-(\w+)(\s+|$)/)
    {
    push (@opt, $1);
    shift;
    }	
if ($opt[0] eq 'u')
    {
    &usage;
    exit;
    }
if ($opt[0] eq 'h')
    {
    &help;
    exit;
    }

#  Preprocess arguments

if  (@ARGV < 7)
    {
    &usage;
    exit 1;
    }


#  Build array of codes for each texture and fragment-modifier class

open (CODE, $ARGV[0]);
while (<CODE>)
    {
    $textcodes{$2} = $1 if /^\s*(\d+)\s+(\S+)/;
    }
close CODE;

open (CODE, $ARGV[1]);
while (<CODE>)
    {
    $fragcodes{$2} = $1 if /^\s*(\d+)\s+(\S+)/;
    }
close CODE;

#  Open input and output layered data files

open (LAY, $ARGV[2]) || die "Cannot open $ARGV[2]";
open (TEXTN, "> $ARGV[3]") || die "Cannot open $ARGV[3]";
open (TEXTC, "> $ARGV[4]") || die "Cannot open $ARGV[4]";
open (FRAGN, "> $ARGV[5]") || die "Cannot open $ARGV[5]";
open (FRAGC, "> $ARGV[6]") || die "Cannot open $ARGV[6]";

#  Read in layer records and encode texture/fragment class data

while ($_ = <LAY>)
    {
    @_ = split;
    $muid = shift (@_);
    $rockd = shift (@_);
    print TEXTN pack ("A6 s", $muid, $rockd);
    print TEXTC pack ("A6 s", $muid, $rockd);
    print FRAGN pack ("A6 s", $muid, $rockd);
    print FRAGC pack ("A6 s", $muid, $rockd);
    $nlayer = @_ / 2;
    for ($layer = 0; $layer < $nlayer; $layer++)
	{
	$text = shift (@_);
	print TEXTN pack ("A4", $text); 
	print TEXTC pack ("s", $textcodes{$text}); 
	}
    for ($layer = 0; $layer < $nlayer; $layer++)
	{
	$frag = shift (@_);
	print FRAGN pack ("A4", $frag); 
	print FRAGC pack ("s", $fragcodes{$frag}); 
	}
    }

close LAY;
close TEXTN;
close TEXTC;
close FRAGN;
close FRAGC;

exit 0;		# From Script pack_fragtext.pl