1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
#!/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 (<IN>)
{
$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 $/; $_ = <IN>; }
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/, <<END);
small zombie
large zombie
small skeleton
large skeleton
small simulacrum
large simulacrum
END
}
unless ($db)
{
open IN, "util/cpp_version spl-summoning.cc|" or die "Can't read spl-summoning.cc\n";
while (<IN>)
{
$mons{$1} = 1 if (/^ { MONS_[A-Z0-9_]+, "([A-Za-z0-9 ']+)" },$/);
}
close IN;
}
print "$_\n" for sort keys %mons;
|
