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                 unshift @nextline, splice @line, $brace_index || 1;
  42         }
  43
  44         # allow initial { token
  45         if(@line >= 2 && $line[0] eq '{')
  46         {
  47                 unshift @nextline, splice @line, 1;
  48         }
  49
  50         # in level 0, make the map name a separate token
  51         if(@level == 0 && @line >= 2)
  52         {
  53                 unshift @nextline, splice @line, 1;
  54         }
  55
  56         $shadertext .= "@line\n";
  57
  58         if($line[0] eq '{')
  59         {
  60                 die "{ line without shader name"
  61                         unless defined $curshader;
  62                 die "{ line in level $level"
  63                         if $level >= 2;
  64                 ++$level;
  65         }
  66         elsif($line[0] eq '}')
  67         {
  68                 die "} line contains other stuff"
  69                         unless @line == 1;
  70                 die "} line without shader name"
  71                         unless defined $curshader;
  72                 die "{ line in level $level"
  73                         if $level <= 0;
  74                 --$level;
  75                 if($level <= 0)
  76                 {
  77                         $level = 0;
  78
  79                         if(!@match || grep { $_ eq $curshader } @match)
  80                         {
  81                                 printf "%s  %s\n", Digest::MD5::md5_hex($shadertext), $curshader;
  82
  83                                 if($find_texture_names)
  84                                 {
  85                                         # find out possibly loaded textures
  86                                         my @maps = ($shadertext =~ /^(?:clampmap|map|q3r_lightimage|q3r_editorimage) ([^\$].*)$/gim);
  87                                         for($shadertext =~ /^animmap \S+ (.*)$/gim)
  88                                         {
  89                                                 push @maps, split / /, $_;
  90                                         }
  91                                         for($shadertext =~ /^skyparms (.*)$/gim)
  92                                         {
  93                                                 for(split / /, $_)
  94                                                 {
  95                                                         next if $_ eq "-";
  96                                                         push @maps, "$_"."_lf";
  97                                                         push @maps, "$_"."_ft";
  98                                                         push @maps, "$_"."_rt";
  99                                                         push @maps, "$_"."_bk";
 100                                                         push @maps, "$_"."_up";
 101                                                         push @maps, "$_"."_dn";
 102                                                 }
 103                                         }
 104                                         @maps = ($curshader)
 105                                                 if @maps == 0;
 106                                         printf "* %s  %s\n", $_, $curshader
 107                                                 for map { normalize_path $_ } @maps;
 108                                 }
 109
 110                                 if($dump_shaders)
 111                                 {
 112                                         print "| $_\n" for split /\n/, $shadertext;
 113                                 }
 114                         }
 115
 116                         $curshader = undef;
 117                 }
 118         }
 119         elsif($level == 0)
 120         {
 121                 warn "shader name already set"
 122                         if defined $curshader;
 123                 $curshader = normalize_path $line[0];
 124                 $shadertext = "";
 125         }
 126
 127         if(@nextline)
 128         {
 129                 @line = @nextline;
 130                 @nextline = ();
 131                 goto nextline;
 132         }
 133 }
 134
 135 if($level != 0)
 136 {
 137         die "missing } line";
 138 }