1 |
root |
1.1 |
#!/usr/bin/perl |
2 |
|
|
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' |
3 |
|
|
if $running_under_some_shell; |
4 |
|
|
# this emulates #! processing on NIH machines. |
5 |
|
|
# (remove #! line above if indigestible) |
6 |
|
|
|
7 |
|
|
eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift; |
8 |
|
|
# process any FOO=bar switches |
9 |
|
|
|
10 |
|
|
# items-extract - parse the archetypes-file and output the |
11 |
|
|
# artifacts in a structured format. |
12 |
|
|
|
13 |
|
|
# Variables passed when invoked: |
14 |
|
|
# living_c - filename where the array attacks is defined. |
15 |
|
|
|
16 |
|
|
$[ = 1; # set array base to 1 |
17 |
|
|
|
18 |
|
|
# These stats will be added to the "magik" string according |
19 |
|
|
# to the pattern. "%s" should be "%+d", but that isn't |
20 |
|
|
# portable. |
21 |
|
|
$magic{'Str'} = 'strength %s'; |
22 |
|
|
$magic{'Dex'} = 'dexterity %s'; |
23 |
|
|
$magic{'Con'} = 'constitution %s'; |
24 |
|
|
$magic{'Int'} = 'intelligence %s'; |
25 |
|
|
$magic{'Wis'} = 'wisdom %s'; |
26 |
|
|
$magic{'Cha'} = 'charisma %s'; |
27 |
|
|
$magic{'Pow'} = 'power %s'; |
28 |
|
|
|
29 |
|
|
$magic{'luck'} = 'luck %s'; |
30 |
|
|
$magic{'exp'} = 'speed %s'; |
31 |
|
|
$magic{'sp'} = 'spell-point regeneration %s'; |
32 |
|
|
$magic{'hp'} = 'hit-point regeneration %s'; |
33 |
|
|
# magic["dam"] = "damage %s"; |
34 |
|
|
|
35 |
|
|
$magic{'reflect_spell'} = 'reflect spells'; |
36 |
|
|
$magic{'xrays'} = 'X-ray vision'; |
37 |
|
|
$magic{'stealth'} = 'stealth'; |
38 |
|
|
$magic{'flying'} = 'flying'; |
39 |
|
|
|
40 |
|
|
# Read the attack-types (and immune/protection) |
41 |
|
|
while ((($buff = &Getline3($living_c),$getline_ok)) == 1) { |
42 |
|
|
if ($buff =~ /attacks\[/) { |
43 |
|
|
$att = 0; |
44 |
|
|
while (1) { |
45 |
|
|
$buff = &Getline3($living_c); |
46 |
|
|
if ($buff =~ '^}') { |
47 |
|
|
last; |
48 |
|
|
} |
49 |
|
|
$s = "[ \t]*\"", $buff =~ s/$s//g; |
50 |
|
|
$nr = (@arr = split(/,/, $buff, 9999)); |
51 |
|
|
for ($i = 1; $i <= $nr && $arr[$i]; $i++) { |
52 |
|
|
$attack{++$att} = $arr[$i]; |
53 |
|
|
} |
54 |
|
|
} |
55 |
|
|
last; |
56 |
|
|
} |
57 |
|
|
} |
58 |
|
|
delete $opened{$living_c} && close($living_c); |
59 |
|
|
|
60 |
|
|
# These types are always artifacts: |
61 |
|
|
$artifact{99} = $artifact{14} = $artifact{16} = $artifact{33} = 1; |
62 |
|
|
$artifact{34} = $artifact{100} = $artifact{113} = $artifact{915} = 1; |
63 |
|
|
|
64 |
|
|
$weapons{15} = $weapons{915} = 1; |
65 |
|
|
$armours{16} = $armours{33} = $armours{34} = $armours{99} = 1; |
66 |
|
|
|
67 |
|
|
$worthless{'chair'} = $worthless{'table'} = $worthless{'bed'} = 1; |
68 |
|
|
|
69 |
|
|
while (<>) { |
70 |
|
|
chomp; # strip record separator |
71 |
|
|
@Fld = split(' ', $_); |
72 |
|
|
if (/^Object (.*)/) { |
73 |
|
|
$slay = $magik = ''; |
74 |
|
|
$name = $obj = $1; |
75 |
|
|
$xmin = $xmax = $ymin = $ymax = 0; |
76 |
|
|
$More = 0; |
77 |
|
|
$att = $dam = $type = $magical = $ac = $armour = $weight = $last_sp = 0; |
78 |
|
|
$prot = ""; |
79 |
|
|
} |
80 |
|
|
|
81 |
|
|
if (defined $magic{$Fld[1]}) { |
82 |
|
|
if ($Fld[1] eq 'sp' && $type == 14) { |
83 |
|
|
$ac = $Fld[2]; |
84 |
|
|
} |
85 |
|
|
else { |
86 |
|
|
&add_magik($magic{$Fld[1]}, $Fld[2]); |
87 |
|
|
} |
88 |
|
|
} |
89 |
|
|
|
90 |
|
|
if (/^type/) { |
91 |
|
|
$type = $Fld[2]; |
92 |
|
|
} |
93 |
|
|
if (/^last_sp/) { |
94 |
|
|
$last_sp = $Fld[2]; |
95 |
|
|
} |
96 |
|
|
if (/^dam/) { |
97 |
|
|
$dam = $Fld[2]; |
98 |
|
|
} |
99 |
|
|
if (/^ac/) { |
100 |
|
|
$ac = $Fld[2]; |
101 |
|
|
} |
102 |
|
|
if (/^armour/) { |
103 |
|
|
$armour = $Fld[2]; |
104 |
|
|
} |
105 |
|
|
if (/^resist_physical/) { |
106 |
|
|
$armour = $Fld[2]; |
107 |
|
|
} |
108 |
|
|
if (/^weight/) { |
109 |
|
|
$weight = $Fld[2]; |
110 |
|
|
} |
111 |
|
|
if (/^attacktype/) { |
112 |
|
|
$att = $Fld[2]; |
113 |
|
|
} |
114 |
|
|
if (/^immune/) { |
115 |
|
|
$immune = $Fld[2]; |
116 |
|
|
} |
117 |
|
|
if (/^vulnerable/) { |
118 |
|
|
$vulnerable = $Fld[2]; |
119 |
|
|
} |
120 |
|
|
if (/^slaying/) { |
121 |
|
|
$slay = $Fld[2]; |
122 |
|
|
} |
123 |
|
|
if (/^magic/) { |
124 |
|
|
$magical = $Fld[2]; |
125 |
|
|
} |
126 |
|
|
if (/^name /) { |
127 |
|
|
$name = substr($_, 6, 999999); |
128 |
|
|
} |
129 |
|
|
if (/^resist_([a-z]+) (-*\d+)/) { |
130 |
|
|
if ($1 ne "physical") { |
131 |
|
|
if ($2 > 0) { $n = "+$2"; } else {$n = "$2"; } |
132 |
|
|
if ($prot eq "") { |
133 |
|
|
$prot = "$1 $n"; |
134 |
|
|
} else { |
135 |
|
|
$prot .= ", $1 $n"; |
136 |
|
|
} |
137 |
|
|
} |
138 |
|
|
} |
139 |
|
|
|
140 |
|
|
if (/^end/) { |
141 |
|
|
# Type 15 are artifacts if they are magical |
142 |
|
|
if ($type == 15 && $magical) { |
143 |
|
|
$type += 900; |
144 |
|
|
# It can also be chairs and beds, but they are in the worthless |
145 |
|
|
# array... |
146 |
|
|
; |
147 |
|
|
} |
148 |
|
|
if ($artifact{$type} || ($type == 15 && !$worthless{$name})) { |
149 |
|
|
if ($dam && !(defined $weapons{$type})) { |
150 |
|
|
&add_magik('damage %s', $dam); |
151 |
|
|
} |
152 |
|
|
if ($ac && !(defined $armours{$type})) { |
153 |
|
|
&add_magik('ac %s', $ac); |
154 |
|
|
} |
155 |
|
|
if ($armour && !(defined $armours{$type})) { |
156 |
|
|
&add_magik('armour %s', $armour); |
157 |
|
|
} |
158 |
|
|
$magik = $magik . &attacktype($att, 'Attacks:'); |
159 |
|
|
$magik = $magik . "<br>Protections: $prot" if ($prot ne ""); |
160 |
|
|
if ($slay eq "wall") { |
161 |
|
|
$magik = $magik . "<br>Excavation"; |
162 |
|
|
} elsif ($slay ne "" ) { |
163 |
|
|
$magik = $magik . "<br> ". &capitalize("$slay" . "-slaying"); |
164 |
|
|
} |
165 |
|
|
|
166 |
|
|
if ($magical) { |
167 |
|
|
$name = $name . ' +' . $magical; |
168 |
|
|
} |
169 |
|
|
$s = '^<br> ', $magik =~ s/$s//; |
170 |
|
|
$magik = &capitalize($magik); |
171 |
|
|
$name = &capitalize($name); |
172 |
|
|
$s = '_', $name =~ s/$s/ /; |
173 |
|
|
|
174 |
|
|
if (defined $armours{$type}) { |
175 |
|
|
$speed = $last_sp / 10; |
176 |
|
|
} |
177 |
|
|
elsif (defined $weapons{$type}) { |
178 |
|
|
# Horrible, I know. Blame vidarl@ifi.uio.no -- Fy Vidar! |
179 |
|
|
# I assume the player has max Str and Dex |
180 |
|
|
# and speed of 6 here. |
181 |
|
|
|
182 |
|
|
# weapon_speed = (last_sp*2 - magical) / 2; |
183 |
|
|
# if (weapon_speed < 0) weapon_speed = 0; |
184 |
|
|
|
185 |
|
|
# M = (300-121)/121.0; |
186 |
|
|
# M2 = 300/100.0; |
187 |
|
|
# W = weight/20000.0; |
188 |
|
|
# s = 2 - weapon_speed/10.0; |
189 |
|
|
|
190 |
|
|
# D = (30-14)/14.0; |
191 |
|
|
# K = 1 + M/3.0 - W/(3*M2) + 6/5.0 + D/2.0; |
192 |
|
|
# K *= (4 + 99)/(6 + 99) * 1.2; |
193 |
|
|
# if ( K <= 0) K = 0.01 |
194 |
|
|
|
195 |
|
|
# W = weight/20000; s = 2 - ((last_sp*2 - magical) / 2)/10; |
196 |
|
|
# K = 1.177*(4 - W/30 + 6/5) |
197 |
|
|
# if (K <= 0) K = 0.01; |
198 |
|
|
|
199 |
|
|
# speed = 6/(K*s); |
200 |
|
|
|
201 |
|
|
$speed = $last_sp; |
202 |
|
|
} |
203 |
|
|
else { |
204 |
|
|
$speed = 0; |
205 |
|
|
} |
206 |
|
|
printf "%d &%s &%s &%s &%d &%.1f &%d &%d &%d &~~%s~~ &%.2f\n", |
207 |
|
|
$type, $obj, $name, $magik, $dam, ($weight / 1000), $ac, |
208 |
|
|
$armour, $magical, $obj, $speed; |
209 |
|
|
} |
210 |
|
|
} |
211 |
|
|
|
212 |
|
|
# Given a bitmask, give a string enumerating the meaning of the bits. |
213 |
|
|
} |
214 |
|
|
|
215 |
|
|
delete $opened{'items'} && close('items'); |
216 |
|
|
|
217 |
|
|
sub attacktype { |
218 |
|
|
local($at, $type, $i, $str) = @_; |
219 |
|
|
for ($i = 1; defined $attack{$i}; $i++) { |
220 |
|
|
if ($at % 2) { |
221 |
|
|
$str = ($str ? $str . ', ' : '') . $attack{$i}; |
222 |
|
|
} |
223 |
|
|
$at = int($at / 2); |
224 |
|
|
} |
225 |
|
|
($str ? '<br> ' . $type . ' ' . $str : ''); |
226 |
|
|
} |
227 |
|
|
|
228 |
|
|
sub add_magik { |
229 |
|
|
local($str, $val) = @_; |
230 |
|
|
|
231 |
|
|
if ($str =~ /%[0-9-]*s/) { |
232 |
|
|
$str = sprintf($str, $val < 0 ? $val : "+". $val); |
233 |
|
|
} |
234 |
|
|
$magik = $magik ? $magik . ', ' . $str : $str; |
235 |
|
|
} |
236 |
|
|
|
237 |
|
|
sub capitalize { |
238 |
|
|
local($str) = @_; |
239 |
|
|
$a = substr($str, 1, 1); |
240 |
|
|
$a =~ tr/a-z/A-Z/; |
241 |
|
|
$_ = $a . substr($str, 2, 999999); |
242 |
|
|
|
243 |
|
|
} |
244 |
|
|
|
245 |
|
|
sub Getline3 { |
246 |
|
|
&Pick('',@_); |
247 |
|
|
local($_); |
248 |
|
|
if ($getline_ok = (($_ = <$fh>) ne '')) { |
249 |
|
|
chomp; # strip record separator |
250 |
|
|
} |
251 |
|
|
$_; |
252 |
|
|
} |
253 |
|
|
|
254 |
|
|
sub Pick { |
255 |
|
|
local($mode,$name,$pipe) = @_; |
256 |
|
|
$fh = $name; |
257 |
|
|
open($name,$mode.$name.$pipe) unless $opened{$name}++; |
258 |
|
|
} |