glew/auto/bin/make.pl

224 lines
5.1 KiB
Perl
Raw Normal View History

##
## Copyright (C) 2002-2008, Marcelo E. Magallon <mmagallo[]debian org>
## Copyright (C) 2002-2008, Milan Ikits <milan ikits[]ieee org>
##
## This program is distributed under the terms and conditions of the GNU
## General Public License Version 2 as published by the Free Software
## Foundation or, at your option, any later version.
my %regex = (
extname => qr/^[A-Z][A-Za-z0-9_]+$/,
exturl => qr/^http.+$/,
function => qr/^(.+) ([a-z][a-z0-9_]*) \((.+)\)$/i,
token => qr/^([A-Z][A-Z0-9_x]*)\s+((?:0x)?[0-9A-Fa-f]+(u(ll)?)?|[A-Z][A-Z0-9_]*)$/,
type => qr/^typedef\s+(.+)$/,
exact => qr/.*;$/,
);
# prefix function name with glew
sub prefixname($)
{
my $name = $_[0];
$name =~ s/^(.*?)gl/__$1glew/;
return $name;
}
# prefix function name with glew
sub prefix_varname($)
{
my $name = $_[0];
$name =~ s/^(.*?)GL(X*?)EW/__$1GL$2EW/;
return $name;
}
#---------------------------------------------------------------------------------------
sub make_exact($)
{
my $exact = $_[0];
$exact =~ s/(; |{)/$1\n/g;
return $exact;
}
sub make_separator($)
{
my $extname = $_[0];
my $l = length $extname;
my $s = (71 - $l)/2;
print "/* ";
my $j = 3;
for (my $i = 0; $i < $s; $i++)
{
print "-";
$j++;
}
print " $_[0] ";
$j += $l + 2;
while ($j < 76)
{
print "-";
$j++;
}
print " */\n\n";
}
#---------------------------------------------------------------------------------------
sub parse_ext($)
{
my $filename = shift;
my %functions = ();
my %tokens = ();
my @reuse = (); # Extensions to reuse
my @types = ();
my @exacts = ();
my $extname = ""; # Full extension name GL_FOO_extension
my $exturl = ""; # Info URL
my $extstring = ""; # Relevant extension string
open EXT, "<$filename" or return;
# As of GLEW 1.14.0 the first four lines _must_ be
# the extension name, the URL and the GL extension
# string (which might be different to the name),
# and the reused extensions
#
# For example GL_NV_geometry_program4 is available
# iff GL_NV_gpu_program4 appears in the extension
# string.
#
# For core OpenGL versions, the third line should
# be blank.
#
# If the URL is unknown, the second line should be
# blank.
$extname = readline(*EXT);
$exturl = readline(*EXT);
$extstring = readline(*EXT);
@reuse = split(" ", readline(*EXT));
chomp($extname);
chomp($exturl);
chomp($extstring);
while(<EXT>)
{
chomp;
if (s/^\s+//)
{
if (/$regex{exact}/)
{
push @exacts, $_;
}
elsif (/$regex{type}/)
{
push @types, $_;
}
elsif (/$regex{token}/)
{
my ($name, $value) = ($1, $2);
$tokens{$name} = $value;
}
elsif (/$regex{function}/)
{
my ($return, $name, $parms) = ($1, $2, $3);
$functions{$name} = {
rtype => $return,
parms => $parms,
};
} else {
print STDERR "'$_' matched no regex.\n";
}
}
}
close EXT;
return ($extname, $exturl, $extstring, \@reuse, \@types, \%tokens, \%functions, \@exacts);
}
sub output_tokens($$)
{
my ($tbl, $fnc) = @_;
if (keys %{$tbl})
{
local $, = "\n";
print "\n";
print map { &{$fnc}($_, $tbl->{$_}) } sort {
if (${$tbl}{$a} eq ${$tbl}{$b}) {
$a cmp $b
} else {
if (${$tbl}{$a} =~ /_/) {
if (${$tbl}{$b} =~ /_/) {
$a cmp $b
} else {
-1
}
} else {
if (${$tbl}{$b} =~ /_/) {
1
} else {
2014-10-16 14:46:52 +00:00
if (hex ${$tbl}{$a} eq hex ${$tbl}{$b}) {
$a cmp $b
} else {
hex ${$tbl}{$a} <=> hex ${$tbl}{$b}
}
}
}
}
} keys %{$tbl};
print "\n";
} else {
print STDERR "no keys in table!\n";
}
}
sub output_types($$)
{
my ($tbl, $fnc) = @_;
if (scalar @{$tbl})
{
local $, = "\n";
print "\n";
print map { &{$fnc}($_) } sort @{$tbl};
print "\n";
}
}
sub output_decls($$)
{
my ($tbl, $fnc) = @_;
if (keys %{$tbl})
{
local $, = "\n";
print "\n";
print map { &{$fnc}($_, $tbl->{$_}) } sort keys %{$tbl};
print "\n";
}
}
sub output_exacts($$)
{
my ($tbl, $fnc) = @_;
if (scalar @{$tbl})
{
local $, = "\n";
print "\n";
print map { &{$fnc}($_) } sort @{$tbl};
print "\n";
}
}
sub output_reuse($$)
{
my ($tbl, $fnc) = @_;
if (scalar @{$tbl})
{
local $, = "\n";
print "\n";
print map { &{$fnc}($_) } sort @{$tbl};
print "\n";
}
}