#!/perl -w
# NAME: glGet.pl
# AIM: Specialised to process a glGet.xml, and produce a C table
# 23/06/2009 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
require 'htmltools.pl' or die "Unable to load htmltools.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $outfile = "temp.$pgmname.txt";
open_log($outfile);

my $in_file = "C:\\DTEMP\\glGet.xml";

# DEBUG
my $dbg01 = 0;    # show each TAG, and close
my $dbg02 = 0;    # show text accumulations


prt( "$pgmname ... process $in_file...\n" );

sub process_xml_file($) {
   my ($fil) = shift;
   my @gltext = ();
   my (@lines, $line, $max, $i, $len, $j, $ch, $intag, $tag, $text, $ctxt, $lnnum);
   if( !open INF, "<$fil" ) {
      prt("ERROR: Unable to open $fil...\n" );
      return @gltext;
   }
   @lines = <INF>;
   $max = scalar @lines;
   close INF;
   prt("Processing $max lines, from $fil...\n");
   @lines = array_tags2newline(@lines);
   $ctxt = htmlcleanall( join("\n",@lines) );
   $ctxt = removetag($ctxt,'code');
   $ctxt = removetag($ctxt,'div');
   $ctxt = removetag($ctxt,'var');
   $ctxt = removetag($ctxt,'em');
   $ctxt = removetag($ctxt,'dd');
   $ctxt = removetag($ctxt,'dt');
   $ctxt = removetag($ctxt,'mml:math');
   $ctxt = removetag($ctxt,'mml:mn');
   $ctxt = trimblanklines($ctxt);
   $ctxt = trimblanklines($ctxt);
   $ctxt = remove_table_attribs($ctxt);
   $i = length($ctxt);
   prt("\nNew clean of $i chars...\n");
   $ctxt = remove_doctype($ctxt);
   $ctxt = removetagattrib($ctxt,'html');
   $ctxt = remove_empty_paras($ctxt);
   $ctxt = inline_clean_paras($ctxt, 90);
   $ctxt = inline_clean_td($ctxt, 90);
   $ctxt = trimblanklines($ctxt);
   $ctxt = trimblanklines($ctxt);
   $i = length($ctxt);
   prt("End new clean with $i chars, written to tempglget.txt...\n");
   write2file($ctxt,"tempglget.txt");
   my ($ingl1, $ingl2, $tx1, $tx2);
   $intag = 0;
   $tag = '';
   $text = '';
   $line = $ctxt;
   $i = $max;
   $lnnum = 0;
   $ingl1 = 0;
   $ingl2 = 0;
   $tx1 = '';
   $tx2 = '';
   ##for ($i = 0; $i < $max; $i++) {
   ##   $line = $lines[$i];
   ##   chomp $line;
      $len = length($line);
      for ($j = 0; $j < $len; $j++) {
         $ch = substr($line,$j,1);
         $lnnum++ if ($ch =~ /\n/);
         if ($intag) {
            $tag .= $ch;
            if ($ch eq '>') {
               $tag = substr($tag,1,length($tag) - 2);
               $intag = 0;
               if ($tag =~ /^\//) {
                  $tag = substr($tag,1);
                  prt("close: [$tag]\n") if ($dbg01);
               } else {
                  prt("tag: [$tag]\n") if ($dbg01);
               }
               $tag = '';
            } 
         } elsif ($ch eq '<') {
            $tag = $ch;
            $intag = 1;
            $text = trim_all($text);
            if (length($text)) {
               prt( "$lnnum:text: $text\n" ) if ($dbg02);
               if ($text =~ /^GL_/) {
                  if ($ingl1 && $ingl2 && length($tx1) && length($tx2)) {
                     push(@gltext, [$tx1, $tx2]);
                  }
                  $text = trim_all($text);
                  $text = substr($text,0,length($text)-2) if ($text =~ /\s+i$/);
                  $tx1 = $text;
                  $ingl1 = 1;
                  $ingl2 = 0;
               } else {
                  if ($text =~ /^params\s+/) {
                     if ($ingl1) {
                        $tx2 = $text;
                        $ingl2 = 1;
                     }
                  } else {
                     if ($ingl1 && $ingl2) {
                        $tx2 .= ' ' if !($tx2 =~ /\s$/);
                        $tx2 .= $text;
                     }
                  }
               }
               $text = '';
            }
         } else {
            $text .= $ch;
         }
      }
   ##}
   prt("Done $i lines...\n");
   return @gltext;
}

my $test1 = "params returns sixteen"; # 4
my $test2 = "params returns a single integer"; # 4
my $test3 = "params returns four"; # 15
my $test4 = "params returns 16"; # 4
my $test5 = "params returns a single positive floating-point"; # 1
my $test6 = "params returns single boolean"; # 1
my $test7 = "params returns four boolean"; # 1
my $test8 = "params return one"; # 1
my $test9 = "params returns a single boolean"; # 86
my $test10 = "params returns one"; # 192
my $test11 = "params returns two"; # 11
my $test12 = "params returns a single"; # 19
my $test13 = "params returns three"; # 2
my $test14 = "params returns single enumerated"; # 1
my $test15 = "params returns a list of symbolic constants of length GL_NUM_COMPRESSED_TEXTURE_FORMATS";

my %tests = (
   $test1 => 16,
   $test2 => 1,
   $test3 => 4,
   $test4 => 16,
   $test5 => 1,
   $test6 => 1,
   $test7 => 4,
   $test8 => 1,
   $test9 => 1,
   $test10 => 1,
   $test11 => 2,
   $test12 => 1,
   $test13 => 3,
   $test14 => 1,
   $test15 => 16
   );

my %beginnings = ();
my @missed = ();

sub get_a_value {
   my ($t) = shift;
   my $v = 0;
   my ($k);
   foreach $k (keys %tests) {
      if (index($t,$k) == 0) {
         return $tests{$k};
      }
   }
   return $v;
}

sub collect_values {
   my ($t) = shift;
   my $off = index($t, 'value');
   if ($off > 0) {
      my $st = substr($t,0,$off-1);
      if (defined $beginnings{$st}) {
         $beginnings{$st}++;
      } else {
         $beginnings{$st} = 1;
      }
   } else {
      # note test4 SPECIAL
      push(@missed, substr($t,0,40));
   }
}

my @gl = process_xml_file($in_file);
my $cnt = scalar @gl;
prt( "Got $cnt GL text items...\n" );
my ($g, $x1, $x2, $key, $val);
for ($g = 0; $g < $cnt; $g++) {
   $x1 = $gl[$g][0];
   $x2 = $gl[$g][1];
   collect_values($x2);
}

for ($g = 0; $g < $cnt; $g++) {
   $x1 = $gl[$g][0];
   $x2 = $gl[$g][1];
   $val = get_a_value($x2);
   prt("#ifdef $x1\n");
   prt("   { $x1,\n");
   prt("     \"$x2\",\n");
   prt("     $val, NULL },\n");
   prt("#endif // $x1\n");
}

#if (@missed) {
#   prt( "Missed ".scalar @missed." beginnings...\n" );
#   foreach $x2 (@missed) {
#      prt( "$x2\n" );
#   }
#}
#$cnt = scalar keys(%beginnings);
#prt( "Got $cnt beginnings items ... value\n" );
#$cnt = 0;
#foreach $key (keys %beginnings) {
#   $cnt++;
#   $val = $beginnings{$key};
#   my $var = "\$test$cnt";
#   prt("$var = \"$key\"; # $val\n");
#}

close_log($outfile,1);
exit(0);

# eof - glGet.pl
