misc/tools/shader-checksums.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Digest::MD5;
   6
   7 sub normalize_path($)
   8 {
   9         my ($p) = @_;
  10         $p =~ s/\\/\//g;
  11         $p =~ s/(?:\.jpg|\.png|\.tga)$//gi;
  12         $p = lc $p;
  13         return $p;
  14 }
  15
  16 my $find_texture_names = grep { /^-t$/ } @ARGV;
  17 my $dump_shaders = grep { /^-d$/ } @ARGV;
  18 my @match = grep { !/^-/ } @ARGV;
  19
  20 my $shadertext = "";
  21 my $level = 0;
  22 my $curshader;
  23 while(<STDIN>)
  24 {
  25         s/\r//gs;
  26         chomp;
  27
  28         s/\/\/.*//s;
  29         s/^\s+//;
  30         s/\s+$//;
  31         next if /^$/;
  32
  33         my @line = map { s/"//g; $_; } split /\s+/, $_;
  34         my @nextline = ();
  35
  36 nextline:
  37         # allow trailing } token
  38         my $brace_index = [grep { $line[$_] eq "}" } 0..@line-1]->[0];
  39         if(defined $brace_index)
  40         {
  41                 @nextline = splice @line, $brace_index || 1;
  42         }
  43
  44         # allow initial { token
  45         if(@line >= 2 && $line[0] eq '{')
  46         {
  47                 @nextline = splice @line, 1;
  48         }
  49
  50         $shadertext .= "@line\n";
  51
  52         if($line[0] eq '{')
  53         {
  54                 die "{ line without shader name"
  55                         unless defined $curshader;
  56                 die "{ line in level $level"
  57                         if $level >= 2;
  58                 ++$level;
  59         }
  60         elsif($line[0] eq '}')
  61         {
  62                 die "} line contains other stuff"
  63                         unless @line == 1;
  64                 die "} line without shader name"
  65                         unless defined $curshader;
  66                 die "{ line in level $level"
  67                         if $level <= 0;
  68                 --$level;
  69                 if($level <= 0)
  70                 {
  71                         $level = 0;
  72
  73                         if(!@match || grep { $_ eq $curshader } @match)
  74                         {
  75                                 printf "%s  %s\n", Digest::MD5::md5_hex($shadertext), $curshader;
  76
  77                                 if($find_texture_names)
  78                                 {
  79                                         # find out possibly loaded textures
  80                                         my @maps = ($shadertext =~ /^(?:clampmap|map|q3r_lightimage|q3r_editorimage) ([^\$].*)$/gim);
  81                                         for($shadertext =~ /^animmap \S+ (.*)$/gim)
  82                                         {
  83                                                 push @maps, split / /, $_;
  84                                         }
  85                                         for($shadertext =~ /^skyparms (.*)$/gim)
  86                                         {
  87                                                 for(split / /, $_)
  88                                                 {
  89                                                         next if $_ eq "-";
  90                                                         push @maps, "$_"."_lf";
  91                                                         push @maps, "$_"."_ft";
  92                                                         push @maps, "$_"."_rt";
  93                                                         push @maps, "$_"."_bk";
  94                                                         push @maps, "$_"."_up";
  95                                                         push @maps, "$_"."_dn";
  96                                                 }
  97                                         }
  98                                         @maps = ($curshader)
  99                                                 if @maps == 0;
 100                                         printf "* %s  %s\n", $_, $curshader
 101                                                 for map { normalize_path $_ } @maps;
 102                                 }
 103
 104                                 if($dump_shaders)
 105                                 {
 106                                         print "| $_\n" for split /\n/, $shadertext;
 107                                 }
 108                         }
 109
 110                         $curshader = undef;
 111                 }
 112         }
 113         elsif($level == 0)
 114         {
 115                 die "shader name already set"
 116                         if defined $curshader;
 117                 $curshader = normalize_path $line[0];
 118                 $shadertext = "";
 119         }
 120
 121         if(@nextline)
 122         {
 123                 @line = @nextline;
 124                 @nextline = ();
 125                 goto nextline;
 126         }
 127 }
 128
 129 if($level != 0)
 130 {
 131         die "missing } line";
 132 }