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