mirror of https://github.com/nigels-com/glew.git
Add some comments; some whitespace changes
git-svn-id: https://glew.svn.sourceforge.net/svnroot/glew/trunk/glew@276 783a27ee-832a-0410-bc00-9f386506c6dd
This commit is contained in:
mem
parent
146894c461
commit
4e53d48347
|
|
@ -110,30 +110,30 @@ my %fnc_ignore_list = (
|
||||||
);
|
);
|
||||||
|
|
||||||
my %regex = (
|
my %regex = (
|
||||||
eofnc => qr/(?:\);?$|^$)/, # ); $|^$
|
eofnc => qr/(?:\);?$|^$)/, # )$ | );$ | ^$
|
||||||
extname => qr/^[A-Z][A-Za-z0-9_]+$/,
|
extname => qr/^[A-Z][A-Za-z0-9_]+$/,
|
||||||
function => qr/^(.+) ([a-z][a-z0-9_]*) \((.+)\)$/i,
|
function => qr/^(.+) ([a-z][a-z0-9_]*) \((.+)\)$/i,
|
||||||
prefix => qr/^(?:[aw]?gl|glX)/, # (agl,wgl,glX) + cluster wo/ capturing
|
prefix => qr/^(?:[aw]?gl|glX)/, # gl | agl | wgl | glX
|
||||||
tprefix => qr/^(?:[AW]?GL|GLX)_/, # (AGL,WGL,GLX) + cluster wo/ capturing
|
tprefix => qr/^(?:[AW]?GL|GLX)_/, # GL_ | AGL_ | WGL_ | GLX_
|
||||||
section => compile_regex('^(', join('|', @sections), ')$'), # sections in spec
|
section => compile_regex('^(', join('|', @sections), ')$'), # sections in spec
|
||||||
token => qr/^([A-Z0-9][A-Z0-9_]*):?\s+((?:0x)?[0-9A-F]+)(.*)$/, # define tokens
|
token => qr/^([A-Z0-9][A-Z0-9_]*):?\s+((?:0x)?[0-9A-F]+)(.*)$/, # define tokens
|
||||||
types => compile_regex('\b(', join('|', keys %typemap), ')\b'), # var types
|
types => compile_regex('\b(', join('|', keys %typemap), ')\b'), # var types
|
||||||
voidtype => compile_regex('\b(', keys %voidtypemap, ')\b '), # void type
|
voidtype => compile_regex('\b(', keys %voidtypemap, ')\b '), # void type
|
||||||
);
|
);
|
||||||
|
|
||||||
# reshapes the the function declaration from multiline to single line form
|
# reshapes the the function declaration from multiline to single line form
|
||||||
sub normalize_prototype
|
sub normalize_prototype
|
||||||
{
|
{
|
||||||
my $fnc = join(" ", @_);
|
local $_ = join(" ", @_);
|
||||||
$fnc =~ s/\s+/ /g;
|
s/\s+/ /g; # multiple whitespace -> single space
|
||||||
$fnc =~ s/\s*\(\s*/ \(/;
|
s/\s*\(\s*/ \(/; # exactly one space before ( and none after
|
||||||
$fnc =~ s/\s*\)\s*/\)/;
|
s/\s*\)\s*/\)/; # no after before or after )
|
||||||
$fnc =~ s/\s*\*([a-zA-Z])/\* $1/;
|
s/\s*\*([a-zA-Z])/\* $1/; # "* identifier"
|
||||||
$fnc =~ s/\*wgl/\* wgl/;
|
s/\*wgl/\* wgl/; # "* wgl"
|
||||||
$fnc =~ s/\*glX/\* glX/;
|
s/\*glX/\* glX/; # "* glX"
|
||||||
$fnc =~ s/\.\.\./void/;
|
s/\.\.\./void/; # ... -> void
|
||||||
$fnc =~ s/;$//;
|
s/;$//; # remove ; at the end of the line
|
||||||
return $fnc;
|
return $_;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Ugly hack to work arround the fact that functions are declared in more
|
# Ugly hack to work arround the fact that functions are declared in more
|
||||||
|
|
@ -165,47 +165,53 @@ sub parse_spec($)
|
||||||
},
|
},
|
||||||
|
|
||||||
"Name Strings" => sub {
|
"Name Strings" => sub {
|
||||||
# Add extension name to extension list
|
# Add extension name to extension list
|
||||||
# Does this look even plausible?
|
# Does this look even plausible?
|
||||||
push @extnames, $_ if (/$regex{extname}/)
|
if (/$regex{extname}/)
|
||||||
|
{
|
||||||
|
# prefix with "GL_" if prefix not present
|
||||||
|
s/^/GL_/ unless /$regex{tprefix}/o;
|
||||||
|
# Add extension name to extension list
|
||||||
|
push @extnames, $_;
|
||||||
|
}
|
||||||
},
|
},
|
||||||
|
|
||||||
"New Procedures and Functions" => sub {
|
"New Procedures and Functions" => sub {
|
||||||
# if line matches end of function
|
# if line matches end of function
|
||||||
if (/$regex{eofnc}/)
|
if (/$regex{eofnc}/)
|
||||||
{
|
{
|
||||||
# add line to function list
|
# add line to function declaration
|
||||||
push @fnc, $_;
|
push @fnc, $_;
|
||||||
|
|
||||||
# my $f = normalize_prototype(@fnc);
|
# if normalized version of function looks like a function
|
||||||
# print STDERR "$f\n";
|
|
||||||
|
|
||||||
# if normalized version of function looks like a function
|
|
||||||
if (normalize_prototype(@fnc) =~ /$regex{function}/)
|
if (normalize_prototype(@fnc) =~ /$regex{function}/)
|
||||||
{
|
{
|
||||||
# get return type, name, and arguments, add them to functions hash
|
# get return type, name, and arguments from regex
|
||||||
my ($return, $name, $parms) = ($1, $2, $3);
|
my ($return, $name, $parms) = ($1, $2, $3);
|
||||||
# print STDERR "$1 | $2 | $3\n";
|
|
||||||
if (!ignore_function($name, $extname))
|
if (!ignore_function($name, $extname))
|
||||||
{
|
{
|
||||||
|
# prefix with "gl" if prefix not present
|
||||||
$name =~ s/^/gl/ unless $name =~ /$regex{prefix}/;
|
$name =~ s/^/gl/ unless $name =~ /$regex{prefix}/;
|
||||||
if ($name =~ /^gl/ && $name !~ /^glX/)
|
# is this a pure GL function?
|
||||||
{
|
if ($name =~ /^gl/ && $name !~ /^glX/)
|
||||||
$return =~ s/$regex{types}/$typemap{$1}/og;
|
{
|
||||||
$return =~ s/void\*/GLvoid */og;
|
# apply typemaps
|
||||||
$parms =~ s/$regex{types}/$typemap{$1}/og;
|
$return =~ s/$regex{types}/$typemap{$1}/og;
|
||||||
$parms =~ s/$regex{voidtype}/$voidtypemap{$1}/og;
|
$return =~ s/void\*/GLvoid */og;
|
||||||
}
|
$parms =~ s/$regex{types}/$typemap{$1}/og;
|
||||||
|
$parms =~ s/$regex{voidtype}/$voidtypemap{$1}/og;
|
||||||
|
}
|
||||||
|
# add to functions hash
|
||||||
$functions{$name} = {
|
$functions{$name} = {
|
||||||
rtype => $return,
|
rtype => $return,
|
||||||
parms => $parms,
|
parms => $parms,
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
# reset function list
|
# reset function declaration
|
||||||
@fnc = ();
|
@fnc = ();
|
||||||
} elsif ($_ ne "" and $_ ne "None") {
|
} elsif ($_ ne "" and $_ ne "None") {
|
||||||
# if not eof, add line to function list
|
# if not eof, add line to function declaration
|
||||||
push @fnc, $_
|
push @fnc, $_
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
|
@ -214,16 +220,15 @@ sub parse_spec($)
|
||||||
if (/$regex{token}/)
|
if (/$regex{token}/)
|
||||||
{
|
{
|
||||||
my ($name, $value) = ($1, $2);
|
my ($name, $value) = ($1, $2);
|
||||||
#print STDERR "TOKEN: $1 | $2\n";
|
# prefix with "GL_" if prefix not present
|
||||||
# Prepend name with GL_, unless it is already prepended
|
|
||||||
$name =~ s/^/GL_/ unless $name =~ /$regex{tprefix}/;
|
$name =~ s/^/GL_/ unless $name =~ /$regex{tprefix}/;
|
||||||
# Add (name, value) pair to tokens hash, unless it's in taboo_tokens
|
# Add (name, value) pair to tokens hash, unless it's taboo
|
||||||
$tokens{$name} = $value unless exists $taboo_tokens{$name};
|
$tokens{$name} = $value unless exists $taboo_tokens{$name};
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
);
|
);
|
||||||
|
|
||||||
# Some people can't read
|
# Some people can't read, the template clearly says "Name String_s_"
|
||||||
$proc{"Name String"} = $proc{"Name Strings"};
|
$proc{"Name String"} = $proc{"Name Strings"};
|
||||||
|
|
||||||
# Open spec file
|
# Open spec file
|
||||||
|
|
@ -232,21 +237,20 @@ sub parse_spec($)
|
||||||
# For each line of SPEC
|
# For each line of SPEC
|
||||||
while(<SPEC>)
|
while(<SPEC>)
|
||||||
{
|
{
|
||||||
# Delete trailing newline character
|
# Delete trailing newline character
|
||||||
chomp;
|
chomp;
|
||||||
# Remove trailing white spaces
|
# Remove trailing white spaces
|
||||||
s/\s+$//;
|
s/\s+$//;
|
||||||
# If starts with a capital letter, it must be a new section
|
# If starts with a capital letter, it must be a new section
|
||||||
if (/^[A-Z]/)
|
if (/^[A-Z]/)
|
||||||
{
|
{
|
||||||
# Match section name with one of the predefined names
|
# Match section name with one of the predefined names
|
||||||
$section = /$regex{section}/ ? $1 : "default";
|
$section = /$regex{section}/o ? $1 : "default";
|
||||||
} else {
|
} else {
|
||||||
# If it's an internal line to a section, call the
|
# Line is internal to a section
|
||||||
# appropriate section processing function if it exists
|
# Remove leading whitespace
|
||||||
# Remove whitespaces from the beginning of the line
|
s/^\s+//;
|
||||||
s/^\s+//;
|
# Call appropriate section processing function if it exists
|
||||||
# Call appropriate processing function
|
|
||||||
&{$proc{$section}} if exists $proc{$section};
|
&{$proc{$section}} if exists $proc{$section};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -279,27 +283,27 @@ foreach my $spec (sort @speclist)
|
||||||
|
|
||||||
foreach my $ext (@{$extnames})
|
foreach my $ext (@{$extnames})
|
||||||
{
|
{
|
||||||
my $info = "$ext_dir/" . $ext;
|
my $info = "$ext_dir/" . $ext;
|
||||||
open EXT, ">$info";
|
open EXT, ">$info";
|
||||||
print EXT $ext . "\n";
|
print EXT $ext . "\n";
|
||||||
print EXT $reg_http . $spec . "\n";
|
print EXT $reg_http . $spec . "\n";
|
||||||
|
|
||||||
my $prefix = $ext;
|
my $prefix = $ext;
|
||||||
$prefix =~ s/^(.+?)(_.+)$/$1/;
|
$prefix =~ s/^(.+?)(_.+)$/$1/;
|
||||||
foreach my $token (sort { hex ${$tokens}{$a} <=> hex ${$tokens}{$b} } keys %{$tokens})
|
foreach my $token (sort { hex ${$tokens}{$a} <=> hex ${$tokens}{$b} } keys %{$tokens})
|
||||||
{
|
{
|
||||||
if ($token =~ /^$prefix.*/i)
|
if ($token =~ /^$prefix.*/i)
|
||||||
{
|
{
|
||||||
print EXT "\t" . $token . " " . ${%{$tokens}}{$token} . "\n";
|
print EXT "\t" . $token . " " . ${%{$tokens}}{$token} . "\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
foreach my $function (sort keys %{$functions})
|
foreach my $function (sort keys %{$functions})
|
||||||
{
|
{
|
||||||
if ($function =~ /^$prefix.*/i)
|
if ($function =~ /^$prefix.*/i)
|
||||||
{
|
{
|
||||||
print EXT "\t" . ${$functions}{$function}{rtype} . " " . $function . " (" . ${$functions}{$function}{parms} . ")" . "\n";
|
print EXT "\t" . ${$functions}{$function}{rtype} . " " . $function . " (" . ${$functions}{$function}{parms} . ")" . "\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
close EXT;
|
close EXT;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue