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