#!/usr/bin/perl -w # Run gather_mons -d if you want dbname: to be heeded (descs, etc). my $db = grep /^-d$/, @ARGV; open IN, "util/cpp_version mon-data.h|" or die "Can't read mon-data.h\n"; while () { $mons{$1}=1 if /^\ +MONS_[A-Z0-9_]+, +'.', +[A-Z0-9_]+, +"([^"]+)",/; #" } close IN; sub vault_mon() { s/^ */ /; # easier to parse this way return unless /name:/; # not interesting to us s/ spells:[^ ]+//g; # can have ; s/;.*//s; # items my %tags; $tags{$1}=$2 while (s/ (\w+):([^ ]+)//); s/ generate_awake//; s/ patrolling//; s/ actual_spells//; s/ priest_spells//; s/ seen//; my %flags; $flags{$1}=1 while (s/ n_(\w+)//); $flags{$1}=1 while (s/ name_(\w+)//); s/^ *//; s/ *$//; $_="$tags{'name'} $_" if $flags{'adj'} || $flags{'adjective'}; $_.=" $tags{'name'}" if $flags{'suf'} || $flags{'suffix'}; $_=$tags{'name'} if $flags{'rpl'} || $flags{'replace'}; $_=$tags{'dbname'} if $db && $tags{'dbname'}; s/_/ /g; $mons{$_} = 1; } for (grep /\.des$/, `git ls-files`) { chomp; open IN, "<", $_ or die "Can't read $_\n"; { undef local $/; $_ = ; } close IN; for (/^ *(?:MONS:|KMONS: *[^=:]+[=:]) *((?:.*\\\n)*.*)/mg) { s/\\\n *//g; vault_mon() for split m{/|,}; #/ } for (/(?:mons *\("|kmons *\(" *[^=:]+[=:])(.+?)\)$/smg) { s/"\s*\.\.(?:\n:)?\s*"//g; s/"[^"]*"/LUA/g; s/"$//; s/"[^"]*$/LUA/; vault_mon() for split m{/|,}; #/ } for (/(?:mon_set|bs\[\d+\])\s+=\s+\{([^}]+)}/sg) { s/^\s*"//s; s/"\s*,\s*$//sg; s/\\\n *//g; s/--[^\n]*\n//sg; s|"\s*,\s*"|/|sg; vault_mon() for split m{/|,}; #/ } for (/local \w+ =\s*"([^"]+)"$/smg) { s/\\\n\s+//g; vault_mon(); } } $mons{"freed slave"} = 1; # Unlike genus-only monsters, these are not even up to name translations. delete $mons{$_} for ("base draconian", "greater demon"); if ($db) { # No description needed, but they still should present translated # names for purposes of glyph redefinition. delete $mons{$_} for (split /\n/, <) { $mons{$1} = 1 if (/^ { MONS_[A-Z0-9_]+, "([A-Za-z0-9 ']+)" },$/); } close IN; } print "$_\n" for sort keys %mons;