IPP Software Navigation Tools IPP Links Communication Pan-STARRS Links

Ignore:
Timestamp:
May 25, 2005, 6:21:56 AM (21 years ago)
Author:
eugene
Message:

adding average, measure, etc

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/Ohana/src/libautocode/generate

    r4020 r4023  
    3838
    3939        # there are used internally (not just a replacement)
    40         if ($key eq "TYPE") { $TYPE = $value; }
     40        if ($key eq "TYPE")   { $TYPE = $value;   }
     41        if ($key eq "SIZE")   { $SIZE = $value;   }
    4142        if ($key eq "STRUCT") { $STRUCT = $value; }
    4243
     
    5354        }
    5455    }
    55     if ($TYPE eq "BINTABLE") { &count_bintablesize; }
    56     if ($TYPE eq "TABLE") { &count_tablesize; }
     56    if ($TYPE eq "BINTABLE") { $Nexpect = &count_bintablesize; }
     57    if ($TYPE eq "TABLE")    { $Nexpect = &count_tablesize;    }
     58    if ($Nexpect != $SIZE) { die "size mismatch: $Nexpect vs $SIZE\n"; }
    5759}
    5860
     
    9597        if ($mode[$i] eq "SUBSTRUCT") { next; }
    9698
    97         # need to handle all structures like: float poly[5][4]
    98         # add [\d\.] to match ascii-type formats
    99         ($type, $length) = $format[$i] =~ m|^(\w+)\[(\d+)\]|;
    100         if (!$type && !$length) { $type = $format[$i]; }
    101 
    102         if ($type eq "char") {
    103             if ($length == 0) {
    104                 $pt1 = sprintf "A";
    105             } else {
    106                 $pt1 = sprintf "%dA", $length;
    107             }
    108         }
    109 
    110         if ($type eq "byte")   { $pt1 = "B"; }
    111         if ($type eq "short")  { $pt1 = "I"; }
    112         if ($type eq "int")    { $pt1 = "J"; }
    113         if ($type eq "e_time") { $pt1 = "J"; }
    114         if ($type eq "float")  { $pt1 = "E"; }
    115         if ($type eq "double") { $pt1 = "D"; }
    116 
    117         if ($type eq "rawshort") { $pt1 = "I"; }
     99        ($type, $Np) = &get_type_array ($format[$i]);
     100       
     101        # rawshort is a short without byteswapping
     102
     103        $pt1 = 0;
     104        if ($type eq "char")          { $pt1 = "A"; }
     105        if ($type eq "byte")          { $pt1 = "B"; }
     106        if ($type eq "unsigned char") { $pt1 = "B"; }
     107        if ($type eq "rawshort")      { $pt1 = "I"; }
     108        if ($type eq "short")         { $pt1 = "I"; }
     109        if ($type eq "unsigned short"){ $pt1 = "I"; }
     110        if ($type eq "int")           { $pt1 = "J"; }
     111        if ($type eq "unsigned int")  { $pt1 = "J"; }
     112        if ($type eq "e_time")        { $pt1 = "J"; }
     113        if ($type eq "float")         { $pt1 = "E"; }
     114        if ($type eq "double")        { $pt1 = "D"; }
     115        if (!$pt1) { die "unknown type $type"; }
     116
     117        if ($Np == 1) {
     118            $pt2 = $pt1;
     119        } else {
     120            $pt2 = sprintf "%d%s", $Np, $pt1;
     121        }
    118122
    119123        printf FILE "  fits_define_bintable_column (header, ";
    120         printf FILE "\"%s\",   ", $pt1;
    121         printf FILE "\"%s\",   ", $field[$i];
    122         printf FILE "\"%s\", ",   $comment[$i];
    123         printf FILE "\"%s\", 1.0, 0.0);\n", $unit[$i];
    124     }
    125 
     124        printf FILE "%-8s",               "\"$pt2\", ";
     125        printf FILE "%-20s",              "\"$field[$i]\", ";
     126        printf FILE "%-35s",              "\"$comment[$i]\", ";
     127        printf FILE "%-20s 1.0, 0.0);\n", "\"$unit[$i]\", ";
     128    }
     129
     130}
     131
     132sub get_type_array {
     133   
     134    my ($format) = $_[0];
     135    my ($type);
     136    my ($Np, $N1, $N2, $N3);
     137
     138    $type = $N1 = $N2 = $N3 = $Np = 0;
     139    if (!$type) {
     140        ($type, $N1, $N2, $N3) = $format =~ m|^(.w+)\[(\d+)\]\[(\d+)\]\[(\d+)\]|;
     141        $Np = $N1*$N2*$N3;
     142    }
     143    if (!$type) {
     144        ($type, $N1, $N2)      = $format =~ m|^(.+)\[(\d+)\]\[(\d+)\]|;
     145        $Np = $N1*$N2;
     146    }
     147    if (!$type) {
     148        ($type, $N1)           = $format =~ m|^(.+)\[(\d+)\]|;
     149        $Np = $N1;
     150    }
     151    if (!$type) {
     152        $type                  = $format;
     153        $Np = 1;
     154    }
     155    # print "type: $type, Np: $Np\n";
     156    if ($Np == 0) { die "syntax error in format/array\n"; }
     157    return ($type, $Np);
    126158}
    127159
     
    131163        # skip SUBSTRUCT type of entries:
    132164        if ($mode[$i] eq "SUBSTRUCT") { next; }
     165
     166        ($type, $N1, $N2)      = $format[$i] =~ m|^(\w+)\[(\d+)\]\[(\d+)\]|;
     167        if ($N2) { die "ASCII table cannot have multi-valued column"; }
    133168
    134169        ($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|;
    135170        if (!$type && !$length) { die "format must be specified for ASCII table"; }
    136171
    137         if ($type eq "char")   { $pt1 = sprintf "A%s", $length; }
    138         if ($type eq "byte")   { $pt1 = sprintf "I%s", $length; }
    139         if ($type eq "short")  { $pt1 = sprintf "I%s", $length; }
    140         if ($type eq "int")    { $pt1 = sprintf "I%s", $length; }
    141         if ($type eq "e_time") { $pt1 = sprintf "I%s", $length; }
    142         if ($type eq "float")  { $pt1 = sprintf "F%s", $length; }
    143         if ($type eq "double") { $pt1 = sprintf "F%s", $length; }
    144 
    145         if ($type eq "rawshort")  { $pt1 = sprintf "I%s", $length; }
     172        $pt1 = 0;
     173        if ($type eq "char")          { $pt1 = sprintf "A%s", $length; }
     174        if ($type eq "byte")          { $pt1 = sprintf "I%s", $length; }
     175        if ($type eq "unsigned char") { $pt1 = sprintf "I%s", $length; }
     176        if ($type eq "rawshort")      { $pt1 = sprintf "I%s", $length; }
     177        if ($type eq "short")         { $pt1 = sprintf "I%s", $length; }
     178        if ($type eq "unsigned short"){ $pt1 = sprintf "I%s", $length; }
     179        if ($type eq "int")           { $pt1 = sprintf "I%s", $length; }
     180        if ($type eq "unsigned int")  { $pt1 = sprintf "I%s", $length; }
     181        if ($type eq "e_time")        { $pt1 = sprintf "I%s", $length; }
     182        if ($type eq "float")         { $pt1 = sprintf "F%s", $length; }
     183        if ($type eq "double")        { $pt1 = sprintf "F%s", $length; }
     184        if (!$pt1) { die "unknown type $type"; }
    146185
    147186        printf FILE "  fits_define_table_column (header, ";
    148         printf FILE "\"%s\", ",   $pt1;
    149         printf FILE "\"%s\", ",   $field[$i];
    150         printf FILE "\"%s\", ",   $comment[$i];
    151         printf FILE "\"%s\");\n", $unit[$i];
     187        printf FILE "%-8s",      "\"$pt1\", ";
     188        printf FILE "%-20s",     "\"$field[$i]\", ";
     189        printf FILE "%-35s",     "\"$comment[$i]\", ";
     190        printf FILE "%-20s);\n", "\"$unit[$i]\"";
    152191    }
    153192
     
    160199        if ($mode[$i] eq "SUBFIELD") { next; }
    161200
    162         ($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|;
    163         if (!$type && !$length) { $type = $format[$i]; }
    164 
    165         if (($type eq "char") && ($length != 0)) {
    166             $pt2 = sprintf "%s[%d];", $element[$i], $length;
     201        # here we only want to match the pattern [1][2][3]..[N]
     202        ($type, $array) = $format[$i] =~ m|^(\w+)(\[.*\])|;
     203        # print "type: $type, array: $array\n";
     204        if (!$type && !$array) { $type = $format[$i]; }
     205
     206        if ($array && (($TYPE eq "BINTABLE") || ($type eq "char"))) {
     207            $pt2 = sprintf "%s%s;", $element[$i], $array;
    167208        } else {
    168209            $pt2 = sprintf "%s;", $element[$i];
     
    179220}
    180221
     222# this does not work with ASCII tables,
     223# but should not be needed for ASCII tables!
    181224sub write_byteswaps {
     225    if ($TYPE eq "TABLE") {
     226        printf FILE "/*** no byteswaps for ASCII tables ***/\n";
     227        return;
     228    }
    182229    $N = 0;
    183230    for ($i = 0; $i < @field; $i++) {
     
    185232        if ($mode[$i] eq "SUBSTRUCT") { next; }
    186233
    187         ($type, $length) = $format[$i] =~ m|^(\w+)\[([\d\.]+)\]|;
    188         if (!$type && !$length) { $type = $format[$i]; }
    189 
    190         if ($type eq "char") {
    191             if ($length == 0) {
    192                 $N ++;
    193             } else {
    194                 $N += $length;
    195             }
    196             next;   # skip byte swap command
    197         }
    198         if ($type eq "byte")  {
    199             $N ++;
    200             next;
    201         }
    202         # this is a patch for old photreg tables: provide a fix for the tables
     234        ($type, $Np) = &get_type_array ($format[$i]);
     235
     236        # rawshort is a patch for old photreg tables: provide a fix for the tables
    203237        # some photreg tables were not byteswapped for certain columns
    204         if ($type eq "rawshort")  {
    205             $N +=2;
    206             next;
    207         }
    208         if ($type eq "short")  {
    209             $T = "BYTE";
    210             $n = 2;
    211         }
    212         if ($type eq "int")    {
    213             $T = "WORD";
    214             $n = 4;
    215         }
    216         if ($type eq "e_time")    {
    217             $T = "WORD";
    218             $n = 4;
    219         }
    220         if ($type eq "float")  {
    221             $T = "WORD";
    222             $n = 4;
    223         }
    224         if ($type eq "double") {
    225             $T = "DBLE";
    226             $n = 8;
    227         }
    228         printf FILE "    SWAP_%s (%d); // %s\n", $T, $N, $field[$i];
    229         $N += $n;
     238
     239        $n = 0;
     240        if ($type eq "char")          { $N +=   $Np; next; }
     241        if ($type eq "byte")          { $N +=   $Np; next; }
     242        if ($type eq "unsigned char") { $N +=   $Np; next; }
     243        if ($type eq "rawshort")      { $N += 2*$Np; next; }
     244        if ($type eq "short")         { $T = "BYTE"; $n = 2; }
     245        if ($type eq "unsigned short"){ $T = "BYTE"; $n = 2; }
     246        if ($type eq "int")           { $T = "WORD"; $n = 4; }
     247        if ($type eq "unsigned int")  { $T = "WORD"; $n = 4; }
     248        if ($type eq "e_time")        { $T = "WORD"; $n = 4; }
     249        if ($type eq "float")         { $T = "WORD"; $n = 4; }
     250        if ($type eq "double")        { $T = "DBLE"; $n = 8; }
     251        if (!$n) { die "unknown type $type"; }
     252        for ($j = 0; $j < $Np; $j++) {
     253            printf FILE "    SWAP_%s (%d); // %s\n", $T, $N, $field[$i];
     254            $N += $n;
     255        }
    230256    }
    231257}
     
    239265
    240266        # add [\d\.] to match ascii-type formats
    241         ($type, $length) = $format[$i] =~ m|^(\w+)\[(\d+)\]|;
    242         if (!$type && !$length) {
    243             $type = $format[$i];
    244             $length = 0;
    245         }
    246 
    247         if ($type eq "char") {
    248             if ($length) {
    249                 $Nbytes += $length;
    250             } else {
    251                 $Nbytes ++;
    252             }
    253         }
    254         if ($type eq "byte")   { $Nbytes += 1; }
    255         if ($type eq "short")  { $Nbytes += 2; }
    256         if ($type eq "int")    { $Nbytes += 4; }
    257         if ($type eq "e_time") { $Nbytes += 4; }
    258         if ($type eq "float")  { $Nbytes += 4; }
    259         if ($type eq "double") { $Nbytes += 8; }
    260 
    261         if ($type eq "rawshort")  { $Nbytes += 2; }
     267        ($type, $Np) = &get_type_array ($format[$i]);
     268
     269        $valid = 0;
     270        if ($type eq "char")           { $Nbytes += 1*$Np; $valid = 1; }
     271        if ($type eq "byte")           { $Nbytes += 1*$Np; $valid = 1; }
     272        if ($type eq "unsigned char")  { $Nbytes += 1*$Np; $valid = 1; }
     273        if ($type eq "rawshort")       { $Nbytes += 2*$Np; $valid = 1; }
     274        if ($type eq "short")          { $Nbytes += 2*$Np; $valid = 1; }
     275        if ($type eq "unsigned short") { $Nbytes += 2*$Np; $valid = 1; }
     276        if ($type eq "int")            { $Nbytes += 4*$Np; $valid = 1; }
     277        if ($type eq "unsigned int")   { $Nbytes += 4*$Np; $valid = 1; }
     278        if ($type eq "e_time")         { $Nbytes += 4*$Np; $valid = 1; }
     279        if ($type eq "float")          { $Nbytes += 4*$Np; $valid = 1; }
     280        if ($type eq "double")         { $Nbytes += 8*$Np; $valid = 1; }
     281        if (!$valid) { die "unknown type $type"; }
    262282    }
    263283    return ($Nbytes);
     
    271291        if ($mode[$i] eq "SUBSTRUCT") { next; }
    272292
    273         ($length) = $format[$i] =~ m|^\w+\[([\d\.]+)\]|;
     293        ($fpt) = $format[$i] =~ m|^\w+\[([\d\.]+)\]|;
     294        $length = int($fpt);
     295        # print "$format[$i], $length, $fpt\n";
    274296        if ($length == 0) { die "ASCII table format requires field size"; }
    275297        $Nbytes += $length;
     
    302324    my ($i);
    303325    for ($i = 0; $i < @key; $i++) {
     326        # if ($VERBOSE) { print "$key[$i]  -- $value[$i]\n"; }
    304327        if ($line =~ m|\$$key[$i]|) {
    305 #           print "$key[$i]  -- $value[$i]\n";
    306328            if ($value[$i] eq "") { die "missing value for required key $key[$i]\n"; }
    307329            $line =~ s|\$$key[$i]|$value[$i]|g;
Note: See TracChangeset for help on using the changeset viewer.