1##
2## Copyright (C) 2002-2008, Marcelo E. Magallon <mmagallo[]debian org>
3## Copyright (C) 2002-2008, Milan Ikits <milan ikits[]ieee org>
4##
5## This program is distributed under the terms and conditions of the GNU
6## General Public License Version 2 as published by the Free Software
7## Foundation or, at your option, any later version.
8
9my %regex = (
10    extname  => qr/^[A-Z][A-Za-z0-9_]+$/,
11    exturl   => qr/^http.+$/,
12    function => qr/^(.+) ([a-z][a-z0-9_]*) \((.+)\)$/i,
13    token    => qr/^([A-Z][A-Z0-9_x]*)\s+((?:0x)?[0-9A-Fa-f]+|[A-Z][A-Z0-9_]*)$/,
14    type     => qr/^typedef\s+(.+)$/,
15    exact    => qr/.*;$/,
16);
17
18# prefix function name with glew
19sub prefixname($)
20{
21    my $name = $_[0];
22    $name =~ s/^(.*?)gl/__$1glew/;
23    return $name;
24}
25
26# prefix function name with glew
27sub prefix_varname($)
28{
29    my $name = $_[0];
30    $name =~ s/^(.*?)GL(X*?)EW/__$1GL$2EW/;
31    return $name;
32}
33
34#---------------------------------------------------------------------------------------
35
36sub make_exact($)
37{
38	my $exact = $_[0];
39	$exact =~ s/(; |{)/$1\n/g;
40    return $exact;
41}
42
43sub make_separator($)
44{
45    my $extname = $_[0];
46    my $l = length $extname;
47    my $s = (71 - $l)/2;
48    print "/* ";
49    my $j = 3;
50    for (my $i = 0; $i < $s; $i++)
51    {
52	print "-";
53	$j++;
54    }
55    print " $_[0] ";
56    $j += $l + 2;
57    while ($j < 76)
58    {
59	print "-";
60	$j++;
61    }
62    print " */\n\n";
63}
64
65#---------------------------------------------------------------------------------------
66
67sub parse_ext($)
68{
69    my $filename = shift;
70    my %functions = ();
71    my %tokens = ();
72    my @types = ();
73    my @exacts = ();
74    my $extname = "";    # Full extension name GL_FOO_extension
75    my $exturl = "";     # Info URL
76    my $extstring = "";  # Relevant extension string
77
78    open EXT, "<$filename" or return;
79
80    # As of GLEW 1.5.3 the first three lines _must_ be
81    # the extension name, the URL and the GL extension
82    # string (which might be different to the name)
83    #
84    # For example GL_NV_geometry_program4 is available
85    # iff GL_NV_gpu_program4 appears in the extension
86    # string.
87    #
88    # For core OpenGL versions, the third line should
89    # be blank.
90    #
91    # If the URL is unknown, the second line should be
92    # blank.
93
94    $extname   = readline(*EXT);
95    $exturl    = readline(*EXT);
96    $extstring = readline(*EXT);
97
98    chomp($extname);
99    chomp($exturl);
100    chomp($extstring);
101
102    while(<EXT>)
103    {
104        chomp;
105        if (s/^\s+//)
106        {
107            if (/$regex{exact}/)
108            {
109                push @exacts, $_;
110            }
111            elsif (/$regex{type}/)
112            {
113                push @types, $_;
114            }
115            elsif (/$regex{token}/)
116            {
117                my ($name, $value) = ($1, $2);
118                $tokens{$name} = $value;
119            }
120            elsif (/$regex{function}/)
121            {
122                my ($return, $name, $parms) = ($1, $2, $3);
123                $functions{$name} = {
124		    rtype => $return,
125		    parms => $parms,
126		};
127            } else {
128                print STDERR "'$_' matched no regex.\n";
129            }
130        }
131    }
132
133    close EXT;
134
135    return ($extname, $exturl, $extstring, \@types, \%tokens, \%functions, \@exacts);
136}
137
138sub output_tokens($$)
139{
140    my ($tbl, $fnc) = @_;
141    if (keys %{$tbl})
142    {
143        local $, = "\n";
144        print "\n";
145        print map { &{$fnc}($_, $tbl->{$_}) } sort { hex ${$tbl}{$a} <=> hex ${$tbl}{$b} } keys %{$tbl};
146        print "\n";
147    } else {
148        print STDERR "no keys in table!\n";
149    }
150}
151
152sub output_types($$)
153{
154    my ($tbl, $fnc) = @_;
155    if (scalar @{$tbl})
156    {
157        local $, = "\n";
158        print "\n";
159        print map { &{$fnc}($_) } sort @{$tbl};
160        print "\n";
161    }
162}
163
164sub output_decls($$)
165{
166    my ($tbl, $fnc) = @_;
167    if (keys %{$tbl})
168    {
169        local $, = "\n";
170        print "\n";
171        print map { &{$fnc}($_, $tbl->{$_}) } sort keys %{$tbl};
172        print "\n";
173    }
174}
175
176sub output_exacts($$)
177{
178    my ($tbl, $fnc) = @_;
179    if (scalar @{$tbl})
180    {
181        local $, = "\n";
182        print "\n";
183        print map { &{$fnc}($_) } sort @{$tbl};
184        print "\n";
185    }
186}
187
188