quakeforge/tools/misc/qfgl_gen.pl

77 lines
1.6 KiB
Perl
Executable file

#! /usr/bin/perl -w
use strict;
&main(@ARGV);
sub main () {
my ($input_file, $funcs_file, $header_file, $footer_file) = @_;
my (@input, @funcs, $funcs, @header, @footer, $line);
if ($#ARGV != 3) {
die("Usage: $0 <input header> <funcs file> <header> <footer>\n");
}
@input = &read_file(sprintf("indent -l1000 -nhnl -st %s |", $input_file));
@funcs = &read_file($funcs_file);
@header = &read_file($header_file);
@footer = &read_file($footer_file);
if ($#funcs == -1) {
die("Use a function or two!\n");
}
$funcs = join ("|", @funcs);
foreach $line (@header) {
print("$line\n");
}
&print_funcs ($funcs, \@input);
foreach $line (@footer) {
print("$line\n");
}
}
sub print_funcs () {
my (%names, @names, $name);
my ($return, $func, $args, $funcs, $line, @input);
$funcs = shift;
@input = @{+shift};
foreach $line (@input) {
if ($line =~ /GLAPI\s+(.+?)\s*GLAPIENTRY\s+([^\s\(]+)\s*\(([^()]+)\)/) {
$return = $1; $name = $2, $args = $3;
$names{$name} = [$return, $args];
}
}
@names = sort { $a cmp $b } keys %names;
foreach $name (@names) {
($return, $args) = @{$names{$name}};
if ($name =~ /(glX|ARB|EXT|MESA|NV|SGIS|SGIX|SGI|APPLE|HP|IBM|INTEL|SUN|SUNX|INGR|ATI|WIN|PGI)/) {
# It is an extension, ignore it.
} elsif ($name =~ /($funcs)/) {
print("QFGL_NEED ($return, $name, ($args));\n");
} else {
print("QFGL_DONT_NEED ($return, $name, ($args));\n");
}
}
}
sub read_file () {
my ($file, @lines);
$file = shift;
open (FILE, $file) or die "Can't open file $file: $!\n";;
while (<FILE>) {
chomp($_);
push(@lines, $_);
}
close (FILE);
return @lines;
}