| 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 |
|
|
} |
