scripts/const.pl

   1 #!/usr/bin/perl -w
   2
   3 # Since the sdl_const.pl and gl_const.pl scripts with 2.0-beta2 don't seem to
   4 # work at all, this script takes SDL/Constans.pm and OpenGL/Constants.pm (as
   5 # original from 2.0-beta2) and fixes them up, and moves them into ../lib/
   6
   7 # I already did this for 1.20.2, so you need to run this only if you intent
   8 # to rebuild the .pm files.
   9
  10 # See http://Bloodgate.com/perl/sdl/sdl_perl.html
  11
  12 use strict;
  13
  14 ##############################################################################
  15
  16 my $sdl = read_file('SDL/Constants.pm');
  17
  18 # remove 'main::' on subs
  19 $sdl =~ s/sub main::([\w]+)/sub $1/g;
  20
  21 # turn on () on subs to make peep optimizer to inline them
  22 #$sdl =~ s/sub ([\w]+)\s+{/sub $1 () {/g;
  23
  24 write_file('../lib/SDL/Constants.pm',insert_export($sdl));
  25
  26 undef $sdl;
  27
  28 ##############################################################################
  29
  30 my $gl = read_file('OpenGL/Constants.pm');
  31
  32 # remove 'main::' on subs
  33 $gl =~ s/sub main::([\w]+)/sub $1/g;
  34
  35 # turn on () on subs to make peep optimizer to inline them
  36 #$gl =~ s/sub ([\w]+)\s+{/sub $1 () {/g;
  37
  38 write_file
  39   ('../lib/SDL/OpenGL/Constants.pm',insert_export($gl,grep_constants()));
  40
  41 1;
  42
  43 sub read_file
  44   {
  45   my $file = shift;
  46
  47   print "Reading $file...";
  48   my $FILE;
  49   open $FILE, $file or die ("Cannot read $file: $!\n");
  50   local $/;     # slurp mode
  51   my $doc = <$FILE>;
  52   close $FILE;
  53   print "done.\n";
  54   $doc;
  55   }
  56
  57 sub write_file
  58   {
  59   my ($file,$txt) = @_;
  60
  61   print "Writing $file...";
  62   my $FILE;
  63   open $FILE, ">$file" or die ("Cannot write $file: $!\n");
  64   print $FILE $txt;
  65   close $FILE;
  66   print "done.\n";
  67   }
  68
  69 sub insert_export
  70   {
  71   my $txt = shift;
  72
  73   my @sub = ();
  74   # gather all sub names
  75   $txt =~ s/sub ([\w]+)\s+/push @sub, $1; 'sub ' . $1 . ' '/eg;
  76
  77   # if we got a second list of names, parse it and include anything that isn't
  78   # alreay in
  79
  80   my $add = "";
  81   if (ref($_[0]) eq 'ARRAY')
  82     {
  83     my $const = shift;
  84     foreach my $c (sort @$const)
  85       {
  86       if ( grep (/^$c->[0]$/, @sub) == 0)
  87         {
  88         print "Adding $c->[0] $c->[1]\n";
  89         $add .= "sub $c->[0] () { $c->[1] }\n";
  90         push @sub, $c->[0];
  91         }
  92       }
  93     $add .= "\n";
  94     }
  95
  96   # SDL/Constants.pm contains doubles :-( So filter them out.
  97   my @sorted = sort @sub;
  98   my $last; @sub = (); my @doubles;
  99   foreach my $cur (@sorted)
 100     {
 101     if (defined $last && $last eq $cur)
 102       {
 103       # double!
 104       push @doubles,$last;
 105       }
 106     else
 107       {
 108       push @sub, $last if defined $last;
 109       }
 110     $last = $cur;
 111     }
 112   foreach my $cur (@doubles)
 113     {
 114     $txt =~ s/\bsub $cur.*//g;  # remove
 115     }
 116
 117   my $export = "require Exporter;\nuse strict;\n";
 118   $export .= "use vars qw/\$VERSION \@ISA \@EXPORT/;";
 119   $export .= "\n\@ISA = qw/Exporter/;\n";
 120
 121   # this makes Exporter export the symbols from SDL::Constants to whatever
 122   # package used SDL::Constants (usually SDL::Event.pm)
 123   my $pack;
 124   if ($txt =~ /SDL::Constants/)
 125     {
 126     $txt =~ s/SDL::Constants/SDL::Event/g;
 127     $pack = 'SDL::Event';
 128     }
 129   if ($txt =~ /SDL::OpenGL::Constants/)
 130     {
 131     $txt =~ s/SDL::OpenGL::Constants/SDL::OpenGL/g;
 132     $pack = 'SDL::OpenGL';
 133     }
 134   $export .= "\nsub import { $pack\->export_to_level(1, \@_); }\n";
 135
 136   $export .= "\n\@EXPORT = qw/\n";
 137
 138   my $line = "\t";
 139   foreach my $s (sort @sub)
 140     {
 141     if (length($line)+length($s) > 70)
 142       {
 143       $export .= "$line\n"; $line = "\t";
 144       }
 145     $line .= "$s ";
 146     }
 147   $export .= "$line /;\n";
 148
 149   # insert Exporter section
 150   $txt =~ s/sub/$export\n\n$add\nsub/;
 151
 152   $txt;
 153   }
 154
 155 sub grep_constants
 156   {
 157   # grep all the OpenGL constants from SDL and return them
 158
 159   my $sdl_gl = read_file('/usr/include/GL/gl.h');
 160
 161   my @const = ();
 162   $sdl_gl =~ s/^#define (GL_.*?)\s+(0x[\da-fA-F]+)/push @const,[$1,$2];/egm;
 163
 164   \@const;
 165   }
 166
 167 END { print "\n"; }