| … | |
… | |
| 199 | while (my ($k, $v) = each %attack_mask) { |
199 | while (my ($k, $v) = each %attack_mask) { |
| 200 | $ob->{"resist_$k"} = min 100, max -100, $ob->{"resist_$k"} + $value if $mask & $v; |
200 | $ob->{"resist_$k"} = min 100, max -100, $ob->{"resist_$k"} + $value if $mask & $v; |
| 201 | } |
201 | } |
| 202 | } |
202 | } |
| 203 | |
203 | |
|
|
204 | my %MATERIAL = reverse |
|
|
205 | paper => 1, |
|
|
206 | iron => 2, |
|
|
207 | glass => 4, |
|
|
208 | leather => 8, |
|
|
209 | wood => 16, |
|
|
210 | organic => 32, |
|
|
211 | stone => 64, |
|
|
212 | cloth => 128, |
|
|
213 | adamant => 256, |
|
|
214 | liquid => 512, |
|
|
215 | tin => 1024, |
|
|
216 | bone => 2048, |
|
|
217 | ice => 4096, |
|
|
218 | |
|
|
219 | # guesses |
|
|
220 | runestone => 12, |
|
|
221 | bronze => 18, |
|
|
222 | "ancient wood" => 20, |
|
|
223 | glass => 36, |
|
|
224 | marble => 66, |
|
|
225 | ice => 68, |
|
|
226 | stone => 70, |
|
|
227 | stone => 80, |
|
|
228 | cloth => 136, |
|
|
229 | ironwood => 144, |
|
|
230 | glacium => 260, |
|
|
231 | blood => 544, |
|
|
232 | ; |
|
|
233 | |
| 204 | # object as in "Object xxx", i.e. archetypes |
234 | # object as in "Object xxx", i.e. archetypes |
| 205 | sub normalize_object($) { |
235 | sub normalize_object($) { |
| 206 | my ($ob) = @_; |
236 | my ($ob) = @_; |
|
|
237 | |
|
|
238 | # convert material bitset to materialname, if possible |
|
|
239 | if (exists $ob->{material}) { |
|
|
240 | if (!$ob->{material}) { |
|
|
241 | delete $ob->{material}; |
|
|
242 | } elsif (exists $ob->{materialname}) { |
|
|
243 | if ($MATERIAL{$ob->{material}} eq $ob->{materialname}) { |
|
|
244 | delete $ob->{material}; |
|
|
245 | } else { |
|
|
246 | warn "object $ob->{_name} has both materialname ($ob->{materialname}) and material ($ob->{material}) set.\n"; |
|
|
247 | delete $ob->{material}; # assume materilname is more specific and nuke material |
|
|
248 | } |
|
|
249 | } elsif (my $name = $MATERIAL{$ob->{material}}) { |
|
|
250 | delete $ob->{material}; |
|
|
251 | $ob->{materialname} = $name; |
|
|
252 | } else { |
|
|
253 | warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; |
|
|
254 | } |
|
|
255 | } |
| 207 | |
256 | |
| 208 | # nuke outdated or never supported fields |
257 | # nuke outdated or never supported fields |
| 209 | delete @$ob{qw( |
258 | delete @$ob{qw( |
| 210 | can_knockback can_parry can_impale can_cut can_dam_armour |
259 | can_knockback can_parry can_impale can_cut can_dam_armour |
| 211 | can_apply pass_thru can_pass_thru |
260 | can_apply pass_thru can_pass_thru |
