Initial checkout of Vore Tournament 0.1.alpha.
[voretournament/voretournament.git] / misc / tools / shader-checksums.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use Digest::MD5;
6
7 my $data = do { undef local $/; <STDIN>; };
8 my $com_token;
9 sub gettoken($)
10 {
11         my ($returnnewline) = @_;
12         $com_token = undef;
13
14 skipwhite:
15         if($returnnewline)
16         {
17                 $data =~ s/^[ \t]*//;
18         }
19         else
20         {
21                 $data =~ s/^[ \t\r\n]*//;
22         }
23
24         return 0
25                 if $data eq "";
26
27         $data =~ s/^\r\n/\n/;
28
29         $data =~ s/^\/\/[^\r\n]*// and goto skipwhite;
30
31         $data =~ s/^\/\*.*?\*\/// and goto skipwhite;
32
33         if($data =~ s/^(["'])(.*?)\1//)
34         {
35                 my $str = $1;
36                 my %q = ( "\\" => "\\", "n" => "\n", "t" => "\t" );
37                 $str =~ s/\\([\\nt])/$q{$1}/ge;
38                 $com_token = $str;
39                 return 1;
40         }
41
42         if($data =~ s/^\r//)
43         {
44                 $com_token = "\n";
45                 return 1;
46         }
47
48         if($data =~ s/^([][\n{})(:,;])//)
49         {
50                 $com_token = $1;
51                 return 1;
52         }
53
54         if($data =~ s/^([^][ \t\r\n{})(:,;]*)//)
55         {
56                 $com_token = $1;
57                 return 1;
58         }
59
60         die "fallthrough?";
61         $com_token = "";
62         return 1;
63 }
64
65 sub normalize_path($)
66 {
67         my ($p) = @_;
68         $p =~ s/\\/\//g;
69         $p =~ s/(?:\.jpg|\.png|\.tga)$//gi;
70         $p = lc $p;
71         return $p;
72 }
73
74 my $find_texture_names = grep { /^-t$/ } @ARGV;
75 my $dump_shaders = grep { /^-d$/ } @ARGV;
76 my @match = grep { !/^-/ } @ARGV;
77
78 my $shadertext;
79 my $curshader;
80
81 while(gettoken 0)
82 {
83         $curshader = normalize_path $com_token;
84         $shadertext = "";
85
86         if(!gettoken(0) || $com_token ne "{")
87         {
88                 die "parsing error - expected \"{\", found \"$com_token\"";
89         }
90         
91         $shadertext .= "{\n";
92
93         while(gettoken 0)
94         {
95                 last if $com_token eq "}";
96
97                 if($com_token eq "{")
98                 {
99                         # shader layer
100                         # we're not actually parsing this
101
102                         $shadertext .= "        {\n";
103
104                         while(gettoken 0)
105                         {
106                                 last if $com_token eq "}";
107                                 next if $com_token eq "\n";
108
109                                 my @parameter = ();
110
111                                 while($com_token ne "\n" && $com_token ne "}")
112                                 {
113                                         push @parameter, $com_token;
114                                         last unless gettoken 1;
115                                 }
116
117                                 $shadertext .= "                @parameter\n";
118
119                                 last if $com_token eq "}";
120                         }
121
122                         $shadertext .= "        }\n";
123                 }
124
125                 my @parameter = ();
126
127                 while($com_token ne "\n" && $com_token ne "}")
128                 {
129                         push @parameter, $com_token;
130                         last unless gettoken 1;
131                 }
132
133                 next if @parameter < 1;
134
135                 $shadertext .= "        @parameter\n";
136         }
137
138         $shadertext .= "}\n";
139
140         if(!@match || grep { $_ eq $curshader } @match)
141         {
142                 printf "%s  %s\n", Digest::MD5::md5_hex($shadertext), $curshader;
143
144                 if($find_texture_names)
145                 {
146                         # find out possibly loaded textures
147                         my @maps = ($shadertext =~ /^(?:clampmap|map|q3r_lightimage|q3r_editorimage) ([^\$].*)$/gim);
148                         for($shadertext =~ /^animmap \S+ (.*)$/gim)
149                         {
150                                 push @maps, split / /, $_;
151                         }
152                         for($shadertext =~ /^skyparms (.*)$/gim)
153                         {
154                                 for(split / /, $_)
155                                 {
156                                         next if $_ eq "-";
157                                         push @maps, "$_"."_lf";
158                                         push @maps, "$_"."_ft";
159                                         push @maps, "$_"."_rt";
160                                         push @maps, "$_"."_bk";
161                                         push @maps, "$_"."_up";
162                                         push @maps, "$_"."_dn";
163                                 }
164                         }
165                         @maps = ($curshader)
166                                 if @maps == 0;
167                         printf "* %s  %s\n", $_, $curshader
168                                 for map { normalize_path $_ } @maps;
169                 }
170
171                 if($dump_shaders)
172                 {
173                         print "| $_\n" for split /\n/, $shadertext;
174                 }
175         }
176 }