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
|
#!/usr/bin/perl
require "util.pl";
$root = $ARGV[0];
$archetypes = "archetypes";
### main
&info ("examining $archetypes ...");
open (ARCH,"< $archetypes") || &die ("cannot open $archetypes");
&checkarch;
close (ARCH);
exit 0;
sub checkarch {
$warnings = 0;
$more = 0;
line: while(<ARCH>) {
chop;
($var,@values) = split;
if ($var eq "More") {
$more = 1;
next line;
}
if ($var eq "Object") {
$arch = $values[0];
$is_alive = 0;
$level = 0;
$type = 0;
$move_apply = 0;
$is_not_head = $more;
$more = 0;
next line;
}
$more = 0;
if ($var eq "end") {
if ( ! $is_not_head && $is_alive && $level <= 0) {
&warn ("arch $arch is alive, but doesn't have level");
$warnings++;
}
if ($type == 61 && $level <= 0) {
&warn ("arch $arch is a FIRECHEST, but doesn't have level");
$warnings++;
}
if ($type == 62 && $level <= 0) {
&warn ("arch $arch is a FIREWALL, but doesn't have level");
$warnings++;
}
if ($type == 5 && $level <= 0) {
&warn ("arch $arch is a POTION, but doesn't have level");
$warnings++;
}
if ($move_apply && $type == 0) {
&warn ("arch $arch has walk/fly on/off but doesn't have a type");
$warnings++;
}
next line;
}
if ($var eq "alive") {
$is_alive = $values[0];
next line;
}
if ($var eq "level") {
$level = $values[0];
next line;
}
if ($var eq "type") {
$type = $values[0];
next line;
}
if ($var eq "walk_on" || $var eq "fly_on" || $var eq "walk_off"
|| $var eq "fly_off")
{
$move_apply |= $values[0];
next line;
}
}
&info ("$warnings problems found");
}
|
