/scripts/const.pl
http://github.com/PerlGameDev/SDL · Perl · 159 lines · 96 code · 39 blank · 24 comment · 10 complexity · 3284ed59b1b978e77930e281e6596c61 MD5 · raw file
- #!/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"; }