Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

168 lines (131 sloc) 3.765 kB
#!/usr/bin/perl -w
# Since the sdl_const.pl and gl_const.pl scripts with 2.0-beta2 don't seem to
# work at all, this script takes SDL/Constans.pm and OpenGL/Constants.pm (as
# original from 2.0-beta2) and fixes them up, and moves them into ../lib/
# I already did this for 1.20.2, so you need to run this only if you intent
# to rebuild the .pm files.
# See http://Bloodgate.com/perl/sdl/sdl_perl.html
use strict;
##############################################################################
my $sdl = read_file('SDL/Constants.pm');
# remove 'main::' on subs
$sdl =~ s/sub main::([\w]+)/sub $1/g;
# turn on () on subs to make peep optimizer to inline them
#$sdl =~ s/sub ([\w]+)\s+{/sub $1 () {/g;
write_file('../lib/SDL/Constants.pm',insert_export($sdl));
undef $sdl;
##############################################################################
my $gl = read_file('OpenGL/Constants.pm');
# remove 'main::' on subs
$gl =~ s/sub main::([\w]+)/sub $1/g;
# turn on () on subs to make peep optimizer to inline them
#$gl =~ s/sub ([\w]+)\s+{/sub $1 () {/g;
write_file
('../lib/SDL/OpenGL/Constants.pm',insert_export($gl,grep_constants()));
1;
sub read_file
{
my $file = shift;
print "Reading $file...";
my $FILE;
open $FILE, $file or die ("Cannot read $file: $!\n");
local $/; # slurp mode
my $doc = <$FILE>;
close $FILE;
print "done.\n";
$doc;
}
sub write_file
{
my ($file,$txt) = @_;
print "Writing $file...";
my $FILE;
open $FILE, ">$file" or die ("Cannot write $file: $!\n");
print $FILE $txt;
close $FILE;
print "done.\n";
}
sub insert_export
{
my $txt = shift;
my @sub = ();
# gather all sub names
$txt =~ s/sub ([\w]+)\s+/push @sub, $1; 'sub ' . $1 . ' '/eg;
# if we got a second list of names, parse it and include anything that isn't
# alreay in
my $add = "";
if (ref($_[0]) eq 'ARRAY')
{
my $const = shift;
foreach my $c (sort @$const)
{
if ( grep (/^$c->[0]$/, @sub) == 0)
{
print "Adding $c->[0] $c->[1]\n";
$add .= "sub $c->[0] () { $c->[1] }\n";
push @sub, $c->[0];
}
}
$add .= "\n";
}
# SDL/Constants.pm contains doubles :-( So filter them out.
my @sorted = sort @sub;
my $last; @sub = (); my @doubles;
foreach my $cur (@sorted)
{
if (defined $last && $last eq $cur)
{
# double!
push @doubles,$last;
}
else
{
push @sub, $last if defined $last;
}
$last = $cur;
}
foreach my $cur (@doubles)
{
$txt =~ s/\bsub $cur.*//g; # remove
}
my $export = "require Exporter;\nuse strict;\n";
$export .= "use vars qw/\$VERSION \@ISA \@EXPORT/;";
$export .= "\n\@ISA = qw/Exporter/;\n";
# this makes Exporter export the symbols from SDL::Constants to whatever
# package used SDL::Constants (usually SDL::Event.pm)
my $pack;
if ($txt =~ /SDL::Constants/)
{
$txt =~ s/SDL::Constants/SDL::Event/g;
$pack = 'SDL::Event';
}
if ($txt =~ /SDL::OpenGL::Constants/)
{
$txt =~ s/SDL::OpenGL::Constants/SDL::OpenGL/g;
$pack = 'SDL::OpenGL';
}
$export .= "\nsub import { $pack\->export_to_level(1, \@_); }\n";
$export .= "\n\@EXPORT = qw/\n";
my $line = "\t";
foreach my $s (sort @sub)
{
if (length($line)+length($s) > 70)
{
$export .= "$line\n"; $line = "\t";
}
$line .= "$s ";
}
$export .= "$line /;\n";
# insert Exporter section
$txt =~ s/sub/$export\n\n$add\nsub/;
$txt;
}
sub grep_constants
{
# grep all the OpenGL constants from SDL and return them
my $sdl_gl = read_file('/usr/include/GL/gl.h');
my @const = ();
$sdl_gl =~ s/^#define (GL_.*?)\s+(0x[\da-fA-F]+)/push @const,[$1,$2];/egm;
\@const;
}
END { print "\n"; }
Jump to Line
Something went wrong with that request. Please try again.