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
  35         $shadertext .= "@line\n";
  36
  37 again:
  38         if($line[0] eq '{')
  39         {
  40                 die "{ line without shader name"
  41                         unless defined $curshader;
  42                 die "{ line in level $level"
  43                         if $level >= 2;
  44                 ++$level;
  45                 if(@line > 1)
  46                 {
  47                         shift @line;
  48                         goto again;
  49                 }
  50         }
  51         elsif($line[0] eq '}')
  52         {
  53                 die "} line contains other stuff"
  54                         unless @line == 1;
  55                 die "} line without shader name"
  56                         unless defined $curshader;
  57                 die "{ line in level $level"
  58                         if $level <= 0;
  59                 --$level;
  60                 if($level <= 0)
  61                 {
  62                         $level = 0;
  63
  64                         if(!@match || grep { $_ eq $curshader } @match)
  65                         {
  66                                 printf "%s  %s\n", Digest::MD5::md5_hex($shadertext), $curshader;
  67
  68                                 if($find_texture_names)
  69                                 {
  70                                         # find out possibly loaded textures
  71                                         my @maps = ($shadertext =~ /^(?:clampmap|map|q3r_lightimage|q3r_editorimage) ([^\$].*)$/gim);
  72                                         for($shadertext =~ /^animmap \S+ (.*)$/gim)
  73                                         {
  74                                                 push @maps, split / /, $_;
  75                                         }
  76                                         for($shadertext =~ /^skyparms (.*)$/gim)
  77                                         {
  78                                                 for(split / /, $_)
  79                                                 {
  80                                                         next if $_ eq "-";
  81                                                         push @maps, "$_"."_lf";
  82                                                         push @maps, "$_"."_ft";
  83                                                         push @maps, "$_"."_rt";
  84                                                         push @maps, "$_"."_bk";
  85                                                         push @maps, "$_"."_up";
  86                                                         push @maps, "$_"."_dn";
  87                                                 }
  88                                         }
  89                                         @maps = ($curshader)
  90                                                 if @maps == 0;
  91                                         printf "* %s  %s\n", $_, $curshader
  92                                                 for map { normalize_path $_ } @maps;
  93                                 }
  94
  95                                 if($dump_shaders)
  96                                 {
  97                                         print "| $_\n" for split /\n/, $shadertext;
  98                                 }
  99                         }
 100
 101                         $curshader = undef;
 102                 }
 103         }
 104         elsif($level == 0)
 105         {
 106                 die "shader name already set"
 107                         if defined $curshader;
 108                 $curshader = normalize_path $line[0];
 109                 $shadertext = "";
 110         }
 111 }
 112
 113 if($level != 0)
 114 {
 115         die "missing } line";
 116 }