Commit | Line | Data |
ee5feabd |
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"; } |