#!/usr/local/bin/perl -w
=pod

ssd2table v. 21 Jul 1996, Dave Schweisguth <dcs@proton.chem.yale.edu>

=cut

### Preliminaries

require 5.002;			    # Perl 5.002 required
use strict;			    # Require optional-but-desirable practices
use vars qw($whatami);		    # Exempt globals from 'use strict'
use Churn qw(%schema retrieve_ssd);

### Parameters

# Environment

($whatami = $0) =~ s|.*/||;	    # `basename $0`
my $isatty	= -t STDIN;

# Initialization (don't change these)

my($ssd, @segs, $seg, $res, $type, $column);

### Arguments and error-checking

# Parse args

my($arg, $sign, $first, $rest);
while (@ARGV and ($sign, $first, $rest) = ($ARGV[0] =~ /^([\-+])(.)(.*)/)) {
    if ($sign eq '+' && $first !~ /[\0]/) { # -/+ switches
	&usage("$sign$first is not an option.\n");
    }
    if ($first =~ /[\0]/) {	# Switches with arguments (none at the moment)
    	shift;
    	$arg = $rest ne '' ? $rest : @ARGV ? shift :
      	    &usage("$sign$first requires an argument.\n");
    } elsif ($rest eq '') {
	shift;
    } else {
    	$ARGV[0] = "$sign$rest";
    }
    if    ($first eq 'u') { &usage(0); }
    else	          { &usage("$sign$first is not an option.\n"); }
}

sub usage {
    warn $_[0] ? "$whatami: $_[0]" : '', <<EOP;
Usage: $whatami [-u] [ssd]
ssd may be '-' or omitted to read from standard input.
-u	This message
EOP
    exit !! $_[0];
}

# Post-process args

if (@ARGV > 1 || @ARGV == 0 && $isatty) {
    &usage("Specify or provide on standard input a single spin-system database.\n");
} elsif (@ARGV == 0) {
    $ARGV[0] = '-';
}

### Do it

$ssd = &retrieve_ssd(shift) || exit 1;   # Read spin system database or die

print <<EOP;
# Res	H1/H3	NH1	NH2	H6/H8	H2/H5	H1'	H2'	H3'	H4'	H5'	H5''	P
#----	-----	----	----	-----	-----	----	----	----	----	----	----	-----
EOP

@segs = sort keys %{$$ssd{segs}};
foreach $seg (@segs) {
    print "Segment $seg\n" if $#segs > 0;
    foreach $res (sort { $a <=> $b } keys %{$$ssd{segs}{$seg}}) {
	$type = $$ssd{segs}{$seg}{$res}{type};
	print "\u$type$res";
	foreach $column (0 .. 11) {
	    print "\t";
	    if ($schema{$type}[$column] eq 'na') {
		print "NA";
	    } else {
		print "\U$$ssd{segs}{$seg}{$res}{spins}{$schema{$type}[$column]}";
	    }
	}
	print "\n";
    }
}

print <<EOP;

# ? or blank = unknown
# NA = Not Applicable
# NO = Not Observed
EOP

exit;