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 }