Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 160 lines (120 sloc) 3.605 kB
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
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
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
24 write_file( '../lib/SDL/Constants.pm', insert_export($sdl) );
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
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
4979eb1 @jtpalmer perltidy
jtpalmer authored
38 write_file(
39 '../lib/SDL/OpenGL/Constants.pm',
40 insert_export( $gl, grep_constants() )
41 );
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
42
43 1;
44
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
45 sub read_file {
4979eb1 @jtpalmer perltidy
jtpalmer authored
46 my $file = shift;
47
48 print "Reading $file...";
49 my $FILE;
50 open $FILE, $file or die("Cannot read $file: $!\n");
51 local $/; # slurp mode
52 my $doc = <$FILE>;
53 close $FILE;
54 print "done.\n";
55 $doc;
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
56 }
57
58 sub write_file {
4979eb1 @jtpalmer perltidy
jtpalmer authored
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";
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
67 }
68
69 sub insert_export {
4979eb1 @jtpalmer perltidy
jtpalmer authored
70 my $txt = shift;
71
72 my @sub = ();
73
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 my $const = shift;
83 foreach my $c ( sort @$const ) {
84 if ( grep ( /^$c->[0]$/, @sub ) == 0 ) {
85 print "Adding $c->[0] $c->[1]\n";
86 $add .= "sub $c->[0] () { $c->[1] }\n";
87 push @sub, $c->[0];
88 }
89 }
90 $add .= "\n";
91 }
92
93 # SDL/Constants.pm contains doubles :-( So filter them out.
94 my @sorted = sort @sub;
95 my $last;
96 @sub = ();
97 my @doubles;
98 foreach my $cur (@sorted) {
99 if ( defined $last && $last eq $cur ) {
100
101 # double!
102 push @doubles, $last;
103 } else {
104 push @sub, $last if defined $last;
105 }
106 $last = $cur;
107 }
108 foreach my $cur (@doubles) {
109 $txt =~ s/\bsub $cur.*//g; # remove
110 }
111
112 my $export = "require Exporter;\nuse strict;\n";
113 $export .= "use vars qw/\$VERSION \@ISA \@EXPORT/;";
114 $export .= "\n\@ISA = qw/Exporter/;\n";
115
116 # this makes Exporter export the symbols from SDL::Constants to whatever
117 # package used SDL::Constants (usually SDL::Event.pm)
118 my $pack;
119 if ( $txt =~ /SDL::Constants/ ) {
120 $txt =~ s/SDL::Constants/SDL::Event/g;
121 $pack = 'SDL::Event';
122 }
123 if ( $txt =~ /SDL::OpenGL::Constants/ ) {
124 $txt =~ s/SDL::OpenGL::Constants/SDL::OpenGL/g;
125 $pack = 'SDL::OpenGL';
126 }
127 $export .= "\nsub import { $pack\->export_to_level(1, \@_); }\n";
128
129 $export .= "\n\@EXPORT = qw/\n";
130
131 my $line = "\t";
132 foreach my $s ( sort @sub ) {
133 if ( length($line) + length($s) > 70 ) {
134 $export .= "$line\n";
135 $line = "\t";
136 }
137 $line .= "$s ";
138 }
139 $export .= "$line /;\n";
140
141 # insert Exporter section
142 $txt =~ s/sub/$export\n\n$add\nsub/;
143
144 $txt;
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
145 }
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
146
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
147 sub grep_constants {
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
148
4979eb1 @jtpalmer perltidy
jtpalmer authored
149 # grep all the OpenGL constants from SDL and return them
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
150
4979eb1 @jtpalmer perltidy
jtpalmer authored
151 my $sdl_gl = read_file('/usr/include/GL/gl.h');
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
152
4979eb1 @jtpalmer perltidy
jtpalmer authored
153 my @const = ();
154 $sdl_gl =~ s/^#define (GL_.*?)\s+(0x[\da-fA-F]+)/push @const,[$1,$2];/egm;
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
155
4979eb1 @jtpalmer perltidy
jtpalmer authored
156 \@const;
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
157 }
ee5feab @kthakore scripts added from old sdlpl to generate constants
kthakore authored
158
159 END { print "\n"; }
Something went wrong with that request. Please try again.