1 |
#!@PERL@ |
2 |
|
3 |
require "util.pl"; |
4 |
|
5 |
$root = $ARGV[0]; |
6 |
$archetypes = "archetypes"; |
7 |
|
8 |
### main |
9 |
&info ("examining $archetypes ..."); |
10 |
|
11 |
open (ARCH,"< $archetypes") || &die ("cannot open $archetypes"); |
12 |
&checkarch; |
13 |
close (ARCH); |
14 |
|
15 |
exit 0; |
16 |
|
17 |
|
18 |
sub checkarch { |
19 |
$warnings = 0; |
20 |
$more = 0; |
21 |
line: while(<ARCH>) { |
22 |
chop; |
23 |
($var,@values) = split; |
24 |
if ($var eq "More") { |
25 |
$more = 1; |
26 |
next line; |
27 |
} |
28 |
if ($var eq "Object") { |
29 |
$arch = $values[0]; |
30 |
$is_alive = 0; |
31 |
$level = 0; |
32 |
$type = 0; |
33 |
$move_apply = 0; |
34 |
$is_not_head = $more; |
35 |
$more = 0; |
36 |
next line; |
37 |
} |
38 |
$more = 0; |
39 |
if ($var eq "end") { |
40 |
if ( ! $is_not_head && $is_alive && $level <= 0) { |
41 |
&warn ("arch $arch is alive, but doesn't have level"); |
42 |
$warnings++; |
43 |
} |
44 |
if ($type == 61 && $level <= 0) { |
45 |
&warn ("arch $arch is a FIRECHEST, but doesn't have level"); |
46 |
$warnings++; |
47 |
} |
48 |
if ($type == 62 && $level <= 0) { |
49 |
&warn ("arch $arch is a FIREWALL, but doesn't have level"); |
50 |
$warnings++; |
51 |
} |
52 |
if ($type == 5 && $level <= 0) { |
53 |
&warn ("arch $arch is a POTION, but doesn't have level"); |
54 |
$warnings++; |
55 |
} |
56 |
if ($move_apply && $type == 0) { |
57 |
&warn ("arch $arch has walk/fly on/off but doesn't have a type"); |
58 |
$warnings++; |
59 |
} |
60 |
next line; |
61 |
} |
62 |
if ($var eq "alive") { |
63 |
$is_alive = $values[0]; |
64 |
next line; |
65 |
} |
66 |
if ($var eq "level") { |
67 |
$level = $values[0]; |
68 |
next line; |
69 |
} |
70 |
if ($var eq "type") { |
71 |
$type = $values[0]; |
72 |
next line; |
73 |
} |
74 |
if ($var eq "walk_on" || $var eq "fly_on" || $var eq "walk_off" |
75 |
|| $var eq "fly_off") |
76 |
{ |
77 |
$move_apply |= $values[0]; |
78 |
next line; |
79 |
} |
80 |
} |
81 |
&info ("$warnings problems found"); |
82 |
} |