quakeforge/tools/misc/qfgl_gen.pl

#! /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;
}