List of spells/parse-spl-data

#! /usr/bin/perl -w
# parse-spl-data, by http://crawl.chaosforge.org/index.php?title=User:Neil
# Copyright (C) 2011.  No rights reserved.
#
# You may use, distribute, modify, study, fold, spindle, or mutilate this
# software as you see fit, but know that there is NO WARRANTY, EXPRESS
# OR IMPLIED (to the extent permitted by law).
#
# The latest version of this program may be found at:
#  http://crawl.chaosforge.org/List_of_spells/parse-spl-data

use strict;
use Getopt::Long qw(:config gnu_getopt);

our ($PROGNAME, $DATE, $CRAWL_VERSION);
our $VERSION = "0.1.0";

# Input directory.
my $indir = "./";

# Map from letter, school, flag, book name, or level to list of spells.
my %by_letter = ();
my %by_school = ();
my %by_flag = ();
my %by_book = ();
my %by_level = ();

# Map from ID or name to spell
my %by_id = ();
my %by_name = ();

# Map from spell name to list of book names.
my %book_spells = ();

# Descriptions of spell flags
my %flag_descs = (
	ALLOW_SELF => <<"EOF",
The spell is not helpful, but you will not receive a "Really target yourself?"
prompt.  You may still receive "That beam is likely to hit you." for
"[[#Dir or target|dir or target]]" spells such as Mephitic Cloud.
EOF
	AREA => <<"EOF",
The spell harms an area.  Pacified fleeing monsters will not use emergency
spells with this flag.
EOF
	BATTLE => <<"EOF",
The spell is a non-[[Conjuration]] spell disliked by [[Elyvilon]].  There is no
piety penalty for using such spells, but a randart spellbook containing one of
these spells will never have Elyvilon's name on it.
EOF
	CHAOTIC => <<"EOF",
The spell is hated by [[Zin]], who will impose penance on any player casting
it, and reward killing monsters who can cast it.
EOF
	CORPSE_VIOLATING => <<"EOF",
The spell is hated by [[Fedhas Madash]], who will impose penance on any player
casting it.
EOF
	DIR => <<"EOF",
The spell requires choosing a direction (and not a target).
EOF
	DIR_OR_TARGET => <<"EOF",
The spell requires choosing a direction or target, and is stopped by
interposing creatures.
EOF
	ESCAPE => <<"EOF",
The spell helps you get out of trouble.  Xom considers such spells boring, and
will not gift spellbooks containing them.  Furthermore, the spell is an option
when control-clicking yourself in tiles mode.
EOF
	GRID => <<"EOF",
The spell targets a grid square, disregarding any creatures in the way.  This
is a form of smite targeting that does not require a target.
EOF
	HASTY => <<"EOF",
The spell is hated by [[Cheibriados]], who will impose penance on any player
casting it.
EOF
	HELPFUL => <<"EOF",
The spell helps you or the target; if targeted, the targeting commands
cycle through friendlies rather than hostiles.  Xom considers such spells
boring, and will not gift spellbooks containing them.
EOF
	NEUTRAL => <<"EOF",
The spell is neither harmful nor helpful; if targeted, the targeting
commands cycle through all creatures, not just hostiles.  Xom considers
such spells boring, and will not gift spellbooks containing them.
EOF
	NONE => <<"EOF",
The spell has no special flags.  Such spells are always untargeted.
EOF
	NOT_SELF => <<"EOF",
The spell may not target you or your square.
EOF
	RECOVERY => <<"EOF",
The spell helps you recover from ill effects.  Xom considers such spells
boring, and will not gift spellbooks containing them.  Furthermore, the spell
is an option when control-clicking yourself in tiles mode.
EOF
	TARGET => <<"EOF",
The spell targets a creature, disregarding any other creatures in the way.
This is a form of smite targeting that requires a target creature.
EOF
	TARG_OBJ => <<"EOF",
The spell targets an object, disregarding any other creatures in the way.
This is a form of smite targeting that requires a target object.
EOF
	UNCLEAN => <<"EOF",
The spell is hated by [[Zin]], who will impose penance on any player casting
it, and reward killing monsters who can cast it.
EOF
	UNHOLY => <<"EOF",
The spell is a non-necromantic unholy spell.  It is hated by [[good]] gods
([[Elyvilon]], [[The Shining One]], and [[Zin]]), who will impose penance on
any player casting it.
EOF
);

sub crawl_version {
	# Look for util/release_ver first
	if (open VERSION, "<", "${indir}util/release_ver") {
		my $ver = <VERSION>;
		chomp $ver;
		close VERSION;
		return $ver;
	}
	# TODO: maybe try running git
	return "<unknown>";
}

# Translate a range into something friendlier for display.  -1 (no range)
# becomes the empty string, while "LOS_RADIUS" becomes just LOS.
# TORNADO_RADIUS becomes 5 (its value), but maybe we should use "Tornado"
# instead.
sub xlate_range {
	my $range = shift;
	return "LOS" if $range eq "LOS_RADIUS";
	return 6 if $range eq "TORNADO_RADIUS";
	return "" if $range eq "-1";
	return $range;
}

# Wiki-format a list of spell schools, linking to the corresponding
# magic skill.
sub format_schools {
	join "/", map {
		my $school = ucfirst(lc $_);

		# Convert school names to skill names for linking
		my $skill = $school;
		if ($school =~ /^(Poison|Air|Fire|Ice|Earth)$/) {
			$skill = "$school Magic";
		} elsif ($school !~ /[ys]$/) {
			# "Necromancy" isn't pluralised as a skill,
			# and "Hexes" and "Charms" are already
			# pluralized as a magic school.  The others
			# are singular as a school, plural as a skill.
			$skill = "${school}s";
		}

		$skill eq $school ? "[[$school]]" : "[[$skill|$school]]";
	} @_;
}

sub ucfirst_array {
    my $items = join ",", map {
        my $name = ucfirst(lc $_);
        "\"$name\"";
    } @_;
    "{ $items }";
}

# Add a spell if it exists
sub maybe_add_spell($) {
	my $spell = shift;
	return undef unless $spell->{name};

	# Ignore spells that do not occur in any book
	return "" unless scalar @{$spell->{books}};
	# ..and NO_SPELL, which "occurs" in books but not really.
	return "" if $spell->{id} eq "NO_SPELL";

	# Sanity checks: abort if we encounter one of these, as it means
	# something funny is up with our book-parsing.

	# Spells that belong to certain monster-only schools.
	for my $school (@{$spell->{schools}}) {
		die "SPTYP_NONE for $spell->{name}" if $school eq "NONE";
	}
	# Spells that don't belong to a school at all, even SPTYP_NONE.
	die "No school for $spell->{name}" unless scalar @{$spell->{schools}};

	# Monster and testing spells.
	for my $flag (@{$spell->{flags}}) {
		die "Monster spell $spell->{name}" if $flag eq "MONSTER";
		die "Testing spell $spell->{name}" if $flag eq "TESTING";
	}

	# It's worth keeping.
	$by_id{$spell->{id}} = $spell;
	$by_name{$spell->{name}} = $spell;
	push @{$by_level{$spell->{level}}}, $spell;

	my $let = uc(substr $spell->{name}, 0, 1);
	push @{$by_letter{$let}}, $spell;


	for my $school (@{$spell->{schools}}) {
		push @{$by_school{$school}}, $spell;
	}
	for my $flag (@{$spell->{flags}}) {
		push @{$by_flag{$flag}}, $spell;
	}
	return 1;
}

# Sorting functions
sub sort_by_name {
	$a->{name} cmp $b->{name}
}

sub sort_by_level {
	$a->{level} <=> $b->{level} or sort_by_name
}

sub sort_by_school {
	# A Schwartzian transform would be more efficient, but we have
	# few enough spells that it's not necessary.
	join("/", @{$a->{schools}}) cmp join("/", @{$b->{schools}})
		or sort_by_name
}

### MAIN

my $sortkey = "alpha";
my $sortfn = \&sort_by_name;
my $module = "default";
GetOptions(
	"a|alphabetic" => sub { $sortkey = "alpha"; $sortfn = \&sort_by_name },
	"b|book" => sub { $sortkey = "book"; $sortfn = undef },
	"f|flag" => sub { $sortkey = "flag"; $sortfn = \&sort_by_level },
	"l|level" => sub { $sortkey = "level"; $sortfn = \&sort_by_school },
	"s|school" => sub { $sortkey = "school"; $sortfn = \&sort_by_level },
        "m|module-book" => sub { $module = "book"; },
        "k|module-spell" => sub { $module = "spell"; },
	"h|help" => sub {
		print <<"EOF";
Usage: $0 [options] [directory]

Produce a wiki table of DCSS spells.  The specified directory should contain
spl-data.h an book-data.h.  If omitted, the current directory is used.

Options include:
  -a, --alphabetic    Arrange alphabetically (default).
  -b, --book          Arrange by book, then level.
  -f, --flag          Arrange by flag, then level.
  -l, --level         Arrange by level, then schools.
  -m, --module-book   Generate a Lua table of spellbooks.
  -k, --module-spell  Generate a Lua table of spells.
  -s, --school        Arrange by school, then level.
  -h, --help          Display this help.

Spells of the same schools and level are sorted by name.  With the --book,
--school, and --flag option, spells may appear multiple times.
EOF
		exit 0;
	},
);

if (@ARGV) {
	$indir = shift @ARGV;
	$indir .= "/" unless $indir eq "" or $indir =~ m!/$!;
}

$DATE = gmtime;
$CRAWL_VERSION = crawl_version;
($PROGNAME = $0) =~ s!.*/!!;


# Name of current book.
my $book = "bug" ;
open BOOKS, "${indir}book-data.h"
	or die "could not open ${indir}book-data.h: $!";
while (<BOOKS>) {
	# Skip conditional sections.  Really we need to look at
	# the condition, but that requires the C preprocessor and
	# I'd rather avoid that.
	next if /^#if/../^#endif/;

	# Kind of hackish --- quit at the first rod
	last if m!// Rod!;

	if (m!^{\s*// (.*)!) {
		# Get the spell name from the comment.
		$book = $1;
		# Disambiguation for Conjuration
		my $extra = "";

		# Remove parenthesized bits
		$book =~ s/\s+\([^)]*\)//g;

		# Remove extra description
		if ($book =~ s/ - (.*)//) {
			# But remember it for Conjuration
			if ($1 =~ /Fire and Earth/) {
				$extra = " (fire+earth)";
			} elsif ($1 =~ /Air and Ice/) {
				$extra = " (ice+air)";
			}
		}

		# Remove roman numeral counter
		$book =~ s/\s+[IVX]+$//;

		# Replace "Tome of" with "Book of" (special case for Dragon)
		$book =~ s/^Tome of/Book of/;

		# And special-case Minor Magic.
		$book =~ s/^Minor/Book of Minor/;

		# Append disambiguation
		$book .= $extra;
	} else {
		while (/SPELL_(\w+)/g) {
			push @{$book_spells{$1}}, $book;
			push @{$by_book{$book}}, $1;
		}
	}
}
close BOOKS;

# Current spell.  Members are
#   {name}    : Spell name
#   {id}      : SPELL_* identifier (without the SPELL_)
#   {schools} : List of SPTYP_* constants (without the SPTYP_)
#   {flags}   : List of SPFLAG_* constants (without the SPFLAG_)
#   {books}   : List of book names.
#   {level}   : Level
#   {cap}     : Power cap
#   {minrange}: Minimum range, or "LOS" or ""
#   {maxrange}: Maximum range, or "LOS" or ""
#   {noisy}   : Noise modifier
#
#   {data}    : List of extra data; converted to {level}-{noise} at the end
#               of the spell block.
my $spell = {};
open SPELLS, "${indir}spl-data.h"
	or die "could not open ${indir}spl-data.h: $!";
while (<SPELLS>) {
	chomp;
	if (/^{/) {
		$spell = {};
	} elsif (/^}/) {
		# Unpack data
		my (
			$sch, $flag, $lev, $cap, $minr, $maxr, $nm, @rest
		) = @{$spell->{data}};

		# Parse out schools and flags
		$spell->{schools} = [
			map { s/SPTYP_//; $_ } split /\s*\|\s*/, $sch
		];
		$spell->{flags} = [
			map { s/SPFLAG_//; $_ } split /\s*\|\s*/, $flag
		];

		# Include the rest of the data
		$spell->{level} = $lev;
		$spell->{cap} = $cap;
		$spell->{minrange} = xlate_range $minr;
		$spell->{maxrange} = xlate_range $maxr;
		$spell->{noisy} = $nm;

		maybe_add_spell($spell);
	} elsif (/^\s*SPELL_(\w+),\s+"([^"]*)",/) {
		$spell->{id} = $1;
		$spell->{name} = $2;
		if (exists $book_spells{$1}) {
			$spell->{books} = [ @{$book_spells{$1}} ];
		} else {
			$spell->{books} = [];
		}
	} else {
		# Strip comments first.
		s!\s*//.*!!;
		# Get comma-delimited sections
		while (/\s*([^,]+)(,|$)/g) {
			if (substr($1, 0, 1) eq "|") {
				# Continuation line; really we should check
				# whether the previous line ended with a
				# comma, but this is probably good enough.
				$spell->{data}[-1] .= $1
			} else {
				push @{$spell->{data}}, $1;
			}
		}

	}
}
close SPELLS;

for my $k (keys %by_book) {
	# Convert the list of spell ids to a list of spells, but
	# remove those that aren't in %by_id because maybe_add_spell
	# skipped them.
	my @spells =  map { $by_id{$_} || () } @{$by_book{$k}};
	if (@spells) {
		$by_book{$k} = \@spells;
	} else {
		# Remove the book if it has no spells.
		delete $by_book{$k};
	}
}

# Print data
if ($module eq "default") {

print <<"EOF";
==Spells== <!-- We *must* have a heading before the table, or the TOC will end up inside the table! -->

<!-- Automatically generated by $PROGNAME $VERSION
     from Dungeon Crawl Stone Soup version $CRAWL_VERSION
     on $DATE
  -->
{| class="prettytable"
!rowspan=2|Image
!rowspan=2|Name
!rowspan=2|Schools
!rowspan=2|Level
!rowspan=2|Power<br>cap
! colspan=2 |Range
!rowspan=2|Flags
!rowspan=2|Books
|----
!min
!max
EOF

my %by_key;
if ($sortkey eq "alpha") {
	%by_key = %by_letter
} elsif ($sortkey eq "book") {
	%by_key = %by_book
} elsif ($sortkey eq "level") {
	%by_key = %by_level
} elsif ($sortkey eq "school") {
	%by_key = %by_school
} elsif ($sortkey eq "flag") {
	%by_key = %by_flag
}

# TODO: allow sorting by other criteria
for my $key (sort keys %by_key) {
	my @spells = @{$by_key{$key}};
	@spells = sort $sortfn @spells if $sortfn;

	print "|----\n! colspan=9 style=\"text-align:left\"|\n====";

	# Format and link the key appropriately
	if ($sortkey eq "book") {
		print "[[$key]]";
	} elsif ($sortkey eq "school")  {
		print format_schools $key;
	} elsif ($sortkey eq "level") {
		print "level $key";
	} elsif ($sortkey eq "flag") {
		my $fl = ucfirst lc $key;
		$fl =~ s/_/ /g;
		print $fl;
	} else {
		print $key;
	}
	print "====\n";
	if ($sortkey eq "flag") {
		my $desc = $flag_descs{$key};
		if ($desc) {
			$desc =~ s/\n/ /g;
			print "|----\n| colspan=9|$desc\n";
		}
	}
	for my $spell (@spells) {
		# Format schools and flags
		my $schools = format_schools @{$spell->{schools}};

		my $flags = join ", ", map {
			s/_/ /g; lc $_
		} @{$spell->{flags}}, ($spell->{noisy} ? "noise $spell->{noisy}" : ());
		my $books = join "<br>", map { "[[$_]]" } @{$spell->{books}};


		print <<"EOF";
|----
|[[File:{{lc:$spell->{name}.png}}]]
|style="padding-left:1em"|[[$spell->{name}]]
|$schools
|$spell->{level}
|$spell->{cap}
|$spell->{minrange}
|$spell->{maxrange}
|$flags
|$books
EOF
	}
}

print <<"EOF";
|----
|}
EOF

}

if ($module eq "book") {
    print <<"EOF";
--[=[
     Table of spellbooks
 ]=]--

local m = {}
EOF

    my @letters = qw(a b c d e f g);
    my $i = 0;
    for my $key (sort keys %by_book) {
        print "m[\"$key\"] = {\n";
        my @spells = @{$by_book{$key}};
        $i = 0;
        for my $spell (@spells) {
            my $schools = format_schools @{$spell->{schools}};
            print "  {\n";
            print "    [\"letter\"] = \"$letters[$i++]\", \n";
            print "    [\"name\"] = \"$spell->{name}\", \n";
	    my $lc_name = lc($spell->{name});
            print "    [\"image\"] = \"[[File:${lc_name}.png]]\", \n";
            print "    [\"level\"] = \"$spell->{level}\", \n";
            print "    [\"schools\"] = \"$schools\", \n";
            print "  },\n";
        }
        print "}\n"
    }
    print "return m\n";
}

if ($module eq "spell") {
# Table of spells
    print <<"EOF";
--[=[
     Table of spells
 ]=]--

local m = {}
EOF

    for my $key (sort keys %by_letter) {
        my @spells = @{$by_letter{$key}};
        @spells = sort $sortfn @spells if $sortfn;
        for my $spell (@spells) {
            my $schools = ucfirst_array @{$spell->{schools}};
            my $flags = ucfirst_array @{$spell->{flags}};
            $flags =~ s/_/ /g;
            $flags =~ s/Mr check/MR check/; # special case
            $flags =~ s/^{ \"None\" }$/nil/; # special case
            my $books = join ",", map { "\"$_\"" } @{$spell->{books}};
            my $range;
            if ($spell->{minrange} eq "") {
                $range = "nil";
            } elsif ($spell->{minrange} eq "LOS") {
                $range = "\"LOS\"";
            } elsif ($spell->{minrange} eq $spell->{maxrange}) {
                $range = $spell->{minrange};
            } else {
                $range = "{$spell->{minrange}, $spell->{maxrange}}";
            }
            print "m[\"$spell->{name}\"] = {\n";
            print "    [\"schools\"] = $schools, \n";
            print "    [\"flags\"] = $flags, \n";
            print "    [\"books\"] = { $books }, \n";
            print "    [\"level\"] = $spell->{level}, \n";
            print "    [\"cap\"] = $spell->{cap}, \n";
            print "    [\"range\"] = $range, \n";
            print "    [\"noise\"] = $spell->{noisy}, \n";
        }
    }
    print "return m\n";
}