#!/usr/bin/env perl

if (@ARGV != 3) { die "generate (schema) (template) (output)\n"; }

$schema   = $ARGV[0];
$template = $ARGV[1];
$output   = $ARGV[2];

&parse_schema;
&parse_template;
exit 0;

sub parse_schema {
    open (FILE, "$schema");
    @list = <FILE>;
    close (FILE);

    $NAME    = "";
    $FILE    = "";
    $Nfield  = 0;
    $TIMEOUT = 0;

    &init_key ("TIMEOUT");
    &init_key ("NAME");
    &init_key ("EXTNAME");
    &init_key ("STRUCT");
    &init_key ("FILE");
    &init_key ("SIZE");
    &init_key ("TYPE");

    foreach $line (@list) {
	chop $line;
	($key, $value) = split (" ", $line, 2);
	
	&set_keypair ($key, $value);

	# there are used internally (not just a replacement)
	if ($key eq "TYPE") { $TYPE = $value; }
	if ($key eq "STRUCT") { $STRUCT = $value; }

	# not a simple key/value entry
	if ($key eq "FIELD") {
	    ($element, $field, $format, $comment, $unit) = split (/,\s+/, $value, 5);
#	    print "$element : $field : $format : $comment : $unit\n";
	    push @element, $element;
	    push @field,   $field;
	    push @format,  $format;
	    push @comment, $comment;
	    push @unit,    $unit;
	}
    }
    if ($TYPE eq "BINTABLE") { &count_bintablesize; }
    if ($TYPE eq "TABLE") { &count_tablesize; }
}

sub parse_template {
    open (FILE, $template);
    @list = <FILE>;
    close (FILE);

    open (FILE, ">$output");

    foreach $line (@list) {
	
	&check_keypairs;

	print FILE $line;

	# fill in structure
	if ($line =~ m|/\*\* STRUCT DEFINITION \*\*/|) {
	    &write_structure;
	}

	# fill in structure
	if ($line =~ m|/\*\* TABLE DEFINITION \*\*/|) {
	    if ($TYPE eq "BINTABLE") { &write_bintabledefs; }
	    if ($TYPE eq "TABLE")    { &write_tabledefs; }
	}

	# fill in swaps
	if ($line =~ m|/\*\* BYTE SWAP \*\*/|) {
	    &write_byteswaps;
	}
    }
    close (FILE);
}

sub write_bintabledefs {

    for ($i = 0; $i < @field; $i++) {
	# add [\d\.] to match ascii-type formats
	($type, $length) = $format[$i] =~ m|^(\w+)\[(\d+)\]|;
	if (!$type && !$length) { $type = $format[$i]; }

	if ($type eq "char") {
	    if ($length == 0) { 
		$pt1 = sprintf "A";
	    } else {
		$pt1 = sprintf "%dA", $length;
	    }
	}

	if ($type eq "byte")   { $pt1 = "B"; }
	if ($type eq "short")  { $pt1 = "I"; }
	if ($type eq "int")    { $pt1 = "J"; }
	if ($type eq "e_time") { $pt1 = "J"; }
	if ($type eq "float")  { $pt1 = "E"; }
	if ($type eq "double") { $pt1 = "D"; }

	if ($type eq "rawshort") { $pt1 = "I"; }

	printf FILE "  fits_define_bintable_column (header, ";
	printf FILE "\"%s\",   ", $pt1;
	printf FILE "\"%s\",   ", $field[$i];
	printf FILE "\"%s\", ",   $comment[$i];
	printf FILE "\"%s\", 1.0, 0.0);\n", $unit[$i];
    }

}

sub write_tabledefs {

    for ($i = 0; $i < @field; $i++) {
	($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|;
	if (!$type && !$length) { die "format must be specified for ASCII table"; }

	if ($type eq "char")   { $pt1 = sprintf "A%s", $length; }
	if ($type eq "byte")   { $pt1 = sprintf "I%s", $length; }
	if ($type eq "short")  { $pt1 = sprintf "I%s", $length; }
	if ($type eq "int")    { $pt1 = sprintf "I%s", $length; }
	if ($type eq "e_time") { $pt1 = sprintf "I%s", $length; }
	if ($type eq "float")  { $pt1 = sprintf "F%s", $length; }
	if ($type eq "double") { $pt1 = sprintf "F%s", $length; }

	if ($type eq "rawshort")  { $pt1 = sprintf "I%s", $length; }

	printf FILE "  fits_define_table_column (header, ";
	printf FILE "\"%s\", ",   $pt1;
	printf FILE "\"%s\", ",   $field[$i];
	printf FILE "\"%s\", ",   $comment[$i];
	printf FILE "\"%s\");\n", $unit[$i];
    }

}

sub write_structure {
    print FILE "typedef struct {\n";
    for ($i = 0; $i < @element; $i++) {
	($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|;
	if (!$type && !$length) { $type = $format[$i]; }

	if (($type eq "char") && ($length != 0)) { 
	    $pt2 = sprintf "%s[%d];", $element[$i], $length;
	} else {
	    $pt2 = sprintf "%s;", $element[$i];
	}

	if ($unit[$i] eq "") {
	    $pt3 = sprintf "// %s", $comment[$i];
	} else {
	    $pt3 = sprintf "// %s (%s)", $comment[$i], $unit[$i];
	}
	printf FILE "  %-16s %-21s %s\n", $type, $pt2, $pt3;
    }    
    print FILE "} $STRUCT;\n";
}

sub write_byteswaps {
    $N = 0;
    for ($i = 0; $i < @field; $i++) {
	($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|;
	if (!$type && !$length) { $type = $format[$i]; }

	if ($type eq "char") {
	    if ($length == 0) { 
		$N ++;
	    } else {
		$N += $length;
	    }
	    next;   # skip byte swap command
	}
	if ($type eq "byte")  {
	    $N ++;
	    next;
	}
	# this is a patch for old photreg tables: provide a fix for the tables
	# some photreg tables were not byteswapped for certain columns
	if ($type eq "rawshort")  {
	    $N +=2;
	    next;
	}
	if ($type eq "short")  {
	    $T = "BYTE";
	    $n = 2;
	}
	if ($type eq "int")    {
	    $T = "WORD";
	    $n = 4;
	}
	if ($type eq "e_time")    {
	    $T = "WORD";
	    $n = 4;
	}
	if ($type eq "float")  {
	    $T = "WORD";
	    $n = 4;
	}
	if ($type eq "double") { 
	    $T = "DBLE";
	    $n = 8;
	}
	printf FILE "    SWAP_%s (%d); // %s\n", $T, $N, $field[$i];
	$N += $n;
    }
}

sub count_bintablesize {

    $Nbytes = 0;
    for ($i = 0; $i < @field; $i++) {

	# add [\d\.] to match ascii-type formats
	($type, $length) = $format[$i] =~ m|^(\w+)\[(\d+)\]|;
	if (!$type && !$length) { 
	    $type = $format[$i]; 
	    $length = 0;
	}

	if ($type eq "char") {
	    if ($length) {
		$Nbytes += $length;
	    } else {
		$Nbytes ++;
	    }
	}
	if ($type eq "byte")   { $Nbytes += 1; }
	if ($type eq "short")  { $Nbytes += 2; }
	if ($type eq "int")    { $Nbytes += 4; }
	if ($type eq "e_time") { $Nbytes += 4; }
	if ($type eq "float")  { $Nbytes += 4; }
	if ($type eq "double") { $Nbytes += 8; }

	if ($type eq "rawshort")  { $Nbytes += 2; }
    }
    return ($Nbytes);
}

sub count_tablesize {

    $Nbytes = 0;
    for ($i = 0; $i < @field; $i++) {
	($length) = $format[$i] =~ m|^\w+\[([\d\.]+)\]|;
	if ($length == 0) { die "ASCII table format requires field size"; }
	$Nbytes += $length;
    }
    return ($Nbytes);
}

sub init_key {
    my ($key)   = $_[0];

    push @key, $key;
    push @value, "";
}

sub set_keypair {
    my ($i);
    my ($key)   = $_[0];
    my ($value) = $_[1];

    for ($i = 0; $i < @key; $i++) {
	if ($key eq $key[$i]) {
	    if ($value[$i] ne "") { die "key is multiply defined\n"; }
	    $value[$i] = $value;
	    return;
	}
    }
}

sub check_keypairs {
    my ($i);
    for ($i = 0; $i < @key; $i++) {
	if ($line =~ m|\$$key[$i]|) {
#	    print "$key[$i]  -- $value[$i]\n";
	    if ($value[$i] eq "") { die "missing value for required key $key[$i]\n"; }
	    $line =~ s|\$$key[$i]|$value[$i]|g;
	}
    }
}

# we need to find the structure size, including padding 
# i'm not sure I know the answer to this: it is probably 
# the total number of bytes rounded up to the largest 
# data item in the structure (ie, 8 for a double, etc)
# if we have the size, then we can double check the structure
# against the expectation at runtime.  for the moment,
# calculate by hand and add to def.d file 

