Generate aptitudes.txt as part of the build, remove generated file from repo.

1 files changed, 246 insertions, 0 deletions

diff --git a/crawl-ref/source/util/gen-apt.pl b/crawl-ref/source/util/gen-apt.pl
new file mode 100755
index 0000000000..d19ec8a279
--- /dev/null
+++ b/crawl-ref/source/util/gen-apt.pl
@@ -0,0 +1,246 @@
+#! /usr/bin/env perl
+
+# Generates aptitude table from skills2.cc and the aptitude template file.
+# All species names are discovered from skills2.cc and all skill abbreviations
+# are discovered from the apt template file, so this script should be
+# reasonably insulated from skill and species changes.
+#
+
+use strict;
+use warnings;
+
+my ($target, $template, $expmodfile, $skillfile) = @ARGV;
+die "Usage: $0 <target> <template> player.cc skills2.cc\n"
+  unless ($expmodfile && $skillfile && $template && $target && -r $template
+          && -r $skillfile && -r $expmodfile);
+
+my %ABBR_SKILL;
+my %SKILL_ABBR;
+my %SPECIES_SKILLS;
+my @SPECIES;
+my %SEEN_SPECIES;
+
+main();
+
+sub main {
+  load_skill_abbreviations($template);
+  load_aptitudes($skillfile);
+  load_expmods($expmodfile);
+  create_aptitude_file($template, $target);
+}
+
+sub create_aptitude_file {
+  my ($template, $target) = @_;
+  open my $outf, '>', $target or die "Can't write $target: $!\n";
+  open my $inf, '<', $template or die "Can't read $template: $!\n";
+  my $foundmarkers;
+  my $lastline;
+  while (<$inf>) {
+    print $outf $_;
+    if (/^-{60,}/) {
+      $foundmarkers = 1;
+      print $outf aptitude_table($lastline);
+
+      # Repeat separator and headerline under the table.
+      print $outf $_;
+      print $outf $lastline;
+    }
+    $lastline = $_;
+  }
+  die "Could not find skill table sections in $template\n" unless $foundmarkers;
+}
+
+sub abbr_to_skill {
+  my $abbr = shift;
+  my $skill = $ABBR_SKILL{$abbr};
+  die "Could not find skill corresponding to abbreviation: $abbr\n"
+    unless $skill;
+  $skill
+}
+
+sub fix_draco_species {
+  my ($sp, $rseen) = @_;
+  if ($sp =~ /^(\w+) Draconian/) {
+    my $flavour = $1;
+    if (!$$rseen) {
+      $$rseen = length($sp);
+      $sp = "Draconian $flavour";
+    }
+    else {
+      $sp = sprintf("%*s", $$rseen, $flavour);
+    }
+  }
+  $sp
+}
+
+sub find_skill {
+  my ($species, $skill) = @_;
+  my $sk = $SPECIES_SKILLS{$species}{$skill};
+  die "Could not find skill $skill for $species\n" unless $sk;
+  $sk
+}
+
+sub split_species {
+  my $sp = shift;
+  if ($sp =~ /^(.*) (.*)$/) {
+    return ($2, $1);
+  }
+  return ($sp, $sp);
+}
+
+sub compare_species {
+  my ($a, $b) = @_;
+  return -1 if $a eq 'Human';
+  return 1 if $b eq 'Human';
+
+  my ($abase, $asub) = split_species($a);
+  my ($bbase, $bsub) = split_species($b);
+  my $basecmp = $abase cmp $bbase;
+  return $basecmp if $basecmp;
+  return $asub cmp $bsub;
+}
+
+sub sort_species {
+  sort { compare_species($a, $b) } @_
+}
+
+sub aptitude_table {
+  chomp(my $headers = shift);
+  my @skill_abbrevs = $headers =~ /(\S+)/g;
+
+  my $text = '';
+  my $seen_draconian_length;
+  for my $sp (sort_species(@SPECIES)) {
+    next if $sp eq 'Base Draconian';
+
+    my $line = '';
+    $line .= fix_draco_species($sp, \$seen_draconian_length);
+
+    for my $abbr (@skill_abbrevs) {
+      my $skill = find_skill($sp, abbr_to_skill($abbr));
+
+      my $pos = index($headers, " $abbr");
+      die "Could not find $abbr in $headers?\n" if $pos == -1;
+      $pos++;
+      if ($pos > length($line)) {
+        $line .= " " x ($pos - length($line));
+      }
+      $line .= sprintf("%*d", length($abbr), $skill);
+    }
+    $text .= "$line\n";
+  }
+  $text
+}
+
+sub skill_name {
+  my $text = shift;
+  $text =~ tr/a-zA-Z / /c;
+  $text =~ s/ +/ /g;
+  $text =~ s/s$//i;
+  propercase_string($text)
+}
+
+sub load_skill_abbreviations {
+  my $template = shift;
+  open my $inf, '<', $template or die "Can't read $template: $!\n";
+  my $in_abbr;
+  while (<$inf>) {
+    $in_abbr = 1 if /-{15,}/;
+    next unless $in_abbr;
+    while (/(\S+(?: \S+)*) {1,3}- {1,3}(\S+(?: \S+)*)/g) {
+      my $skill = $2;
+      my $abbr = $1;
+      $skill = skill_name($skill);
+      $SKILL_ABBR{$skill} = $abbr;
+      $ABBR_SKILL{$abbr} = $skill;
+    }
+  }
+  close $inf;
+
+  die "No skill names found in $template\n" unless %SKILL_ABBR;
+}
+
+sub propercase_string {
+  my $s = lc(shift);
+  $s =~ s/\b(\w)/\u$1/g;
+  $s
+}
+
+sub fix_underscores {
+  my $s = shift;
+  $s =~ tr/_/ /;
+  $s
+}
+
+sub load_aptitudes {
+  my $skillfile = shift;
+  open my $inf, '<', $skillfile or die "Can't read $skillfile: $!\n";
+  my $seen_skill_start;
+  my $species;
+
+  while (<$inf>) {
+    last if /\*{40,}/;
+    if (!$seen_skill_start) {
+      $seen_skill_start = 1 if /spec_skills\[/;
+    }
+    else {
+      if (m{//\s*SP_(\w+)\s*$}) {
+        $species = propercase_string(fix_underscores($1));
+        die "$skillfile:$.: Repeated skill def for $species.\n"
+          if $SEEN_SPECIES{$species};
+        $SEEN_SPECIES{$species} = 1;
+        push @SPECIES, $species;
+      }
+      if (m{//\s*SK_(\w+)\s*$} && /^\s*\d+/) {
+        m{//\s*SK_(\w+)\s*$};
+        my $skill = skill_name($1);
+        die "$skillfile:$.: Unknown skill: $skill\n"
+          unless $SKILL_ABBR{$skill};
+        die "$skillfile:$.: Repeated skill def $1 for $species.\n"
+          if $SPECIES_SKILLS{$species}{$skill};
+        ($SPECIES_SKILLS{$species}{$skill}) = /^\s*(\d+)/;
+      }
+    }
+  }
+  die "Could not find aptitudes for species in $skillfile\n"
+    unless %SPECIES_SKILLS;
+}
+
+sub species_for_genus {
+  my $genus = lc(shift);
+  $genus = 'dwarf' if $genus eq 'dwarven';
+  grep(index(lc($_), $genus) != -1, @SPECIES)
+}
+
+sub load_expmods {
+  my $expmodfile = shift;
+  open my $inf, '<', $expmodfile or die "Can't read $expmodfile: $!\n";
+
+  my $inexpmod;
+
+  my @species;
+  while (<$inf>) {
+    $inexpmod = 1 if /static.*species_exp_mod/;
+    next unless $inexpmod;
+
+    if (/GENPC_(\w+)/) {
+      push @species, species_for_genus($1);
+    }
+    if (/SP_(\w+)/) {
+      push @species, propercase_string(fix_underscores($1));
+    }
+
+    if (/return/ && /(\d+)/) {
+      my $exp = $1;
+      last if $exp eq '0';
+      die "$expmodfile:$.: No species associated with xp mod $1\n"
+        unless @species;
+      for my $sp (@species) {
+        $SPECIES_SKILLS{$sp}{Experience} = $1 * 10;
+      }
+      @species = ();
+    }
+  }
+  close $inf;
+  die "Could not find species exp mods in $expmodfile\n" unless $inexpmod;
+}