crawl-ref/source/misc/featname.pl

   1 #!/usr/bin/perl
   2 #
   3 # featname.pl
   4 #
   5 # Checks that the DNGN feature names in luadgn.cc match up with the enum
   6 # constants in enum.h.
   7 #
   8
   9 use strict;
  10 use warnings;
  11
  12 my $FEATFILE = "enum.h";
  13 my $FNAMEFILE = "luadgn.cc";
  14 my ($features, $fnummap) = read_features($FEATFILE);
  15 my @fnames = read_feature_names($FNAMEFILE);
  16
  17 verify_names($features, $fnummap, \@fnames);
  18
  19 sub read_feature_names {
  20   my $file = shift;
  21   my $text = do { local(@ARGV, $/) = $file; <> };
  22   my ($array) = $text =~
  23     /dngn_feature_names.*?=.*?{([^}]+)}/xs;
  24   my @names = $array =~ /"([^"]*)"/gs;
  25   return @names;
  26 }
  27
  28 sub verify_names {
  29   my ($farr, $fmap, $fnames) = @_;
  30   for (my $i = 0; $i < @$fnames; ++$i) {
  31     my $name = $$fnames[$i];
  32     next unless $name;
  33     my $feat = "DNGN_\U$name";
  34     $$fmap{$feat} = -1 unless exists $$fmap{$feat};
  35     if ($$fmap{$feat} != $i) {
  36       die "$name is at $i, was expecting $$fmap{$feat} as in enum.\n";
  37     }
  38   }
  39   print "Feature names in $FNAMEFILE and $FEATFILE match ok.\n";
  40 }
  41
  42 sub read_features {
  43   my $file = shift;
  44   my @lines = do { local (@ARGV) = $file; <> };
  45
  46   my @features = ([]) x 500;
  47   my $in_enum;
  48   my %fnummap;
  49   my $currval = 0;
  50   for my $line (@lines) {
  51     if (!$in_enum) {
  52       $in_enum = 1 if $line =~ /enum\s+dungeon_feature_type/;
  53     }
  54     else {
  55       last if $line =~ /^\s*};/;
  56
  57       s/^\s+//, s{//.*}{}, s/\s+$// for $line;
  58       next unless $line =~ /\S/;
  59
  60       my ($key, $val) = $line =~ /(DNGN\w+)(?:\s*=\s*(\w+))?/;
  61       next unless $key;
  62
  63       if (defined $val) {
  64         if ($val =~ /^DNGN/) {
  65           $val = $fnummap{$val};
  66         }
  67       }
  68       else {
  69         $val = $currval;
  70       }
  71       $currval = $val + 1;
  72
  73       $fnummap{$key} = $val;
  74       push @{$features[$val]}, $key;
  75     }
  76   }
  77   return (\@features, \%fnummap);
  78 }