Generated: Tue Feb 2 17:54:41 2010 from glGet.pl 2009/06/24 6.6 KB.
#!/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