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
|
#!/usr/bin/perl -w
# Run gather_features -a if you want "A pigsty" rather than "pigsty".
my $art = grep /^-a$/, @ARGV;
# extract(fn, start, end[, per-line)
#
# Gather quoted strings from the file named fn, in the region between the first
# occurrence of the start string and the next line that contains only the end
# string. If per_line is true, take only the first string from each line.
sub extract($$$;$)
{
my ($fn, $start, $end, $per_line) = @_;
open my $in, "util/cpp_version $fn|" or die "Can't read $fn: $!\n";
undef local $/;
my $data = <$in>;
close $in;
$data =~ s/.*\Q$start\E(.*?)\n\Q$end\E\n.*/$1/s
or die "Can't find \"$start\" in $fn\n";
$data =~ s|//.*$||mg;
my $consume = $per_line ? '.*' : '';
return grep {
$_ ne "" and $_ !~ /^<.*>$/
} ($data =~ /"([^"\n]*)"$consume/g);
}
sub articled($)
{
local $_ = $_[0];
return $_ unless $art;
return $_ if /^[A-Z]/ && !/ trap$/;
return "\u$_" if /^(?:the |an |a |some )/i;
return "A $_" if /^one-/i;
# Handle "rough-hewn floor" but not "escape hatch in the floor"
return "The $_" if $_ =~ /^(\S+\s+)?floor$/;
return /^[aeiou]/i ? "An $_" : "A $_";
}
for (extract "directn.cc", "_base_feature_desc(dungeon_feature_type", "}")
{
$features{articled($_)} = 1;
}
for (extract "feature-data.h", "feat_defs[] =", "};", "per-line")
{
$features{articled($_)} = 1;
}
for (extract "describe.cc", "trap_names[] =", "};")
{
$_ .= " trap" unless /^(web|shaft|passage|pressure plate)$/;
$_ .= " of Golubria" if /^passage$/;
$features{articled($_)} = 1;
}
for (grep /\.des|\.des\.disabled|\.lua$/, `git ls-files`)
{
chomp;
open IN, "<", $_ or die "Can't read $_\n";
{ undef local $/; $_ = <IN>; }
close IN;
$features{articled($_)} = 1
for /set_feature_name\s*\(\s*"[^"\n"]+"\s*,[ \n:]*"([^"\n]+)"\s*\)/sg;
$features{articled($_)} = 1
for /\bdesc\s*=\s*"([^"]*)"/g;
}
$features{articled("gleaming silver wall")} = 1;
for (qw(open closed runed sealed))
{
$features{articled("large $_ door")} = 1;
$features{articled("$_ gate")} = 1;
$features{articled("huge $_ gate")} = 1;
}
print join("\n", sort keys %features), "\n";
|
