| 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 |
$[ = 1; # set array base to 1 |
| 11 |
|
| 12 |
|
| 13 |
# special is a list of what special things we should look for. |
| 14 |
# The value of the array is how many commas we should skip. |
| 15 |
$special{'Attacks'} = 1; |
| 16 |
$special{'Spell abilities'} = 1; |
| 17 |
|
| 18 |
while (<>) { |
| 19 |
chomp; |
| 20 |
($Fld1,$Fld2,$Fld3,$Fld4,$Fld5,$Fld6,$Fld7) = split('\|'); |
| 21 |
# Expl: |
| 22 |
# name - .. |
| 23 |
# comma - Print a comma or not |
| 24 |
# antall - number of (sub)fields in the 'Special' field; antall(Nor) <-> "number of". |
| 25 |
# i - counter. Should start as values 2. |
| 26 |
|
| 27 |
$name = &capitalize($Fld1); |
| 28 |
$s = '_', $name =~ s/$s/ /; |
| 29 |
$comma = 0; |
| 30 |
$first_resist=0; |
| 31 |
# Split on the parens |
| 32 |
@field = split('[():]', $Fld5, 9999); |
| 33 |
|
| 34 |
printf |
| 35 |
'<tr><th>%s</th><td>~~%s~~</td><td>%s</td><td>%s</td><td>%s</td><td>%s</td><td>', |
| 36 |
$name, $Fld6, $Fld7 ? '~~' . $Fld7 . '~~' : '', $Fld2, $Fld3, $Fld4; |
| 37 |
|
| 38 |
for ($i = 1; $i < $#field; $i++) { |
| 39 |
next if ($field[$i] eq "" ); |
| 40 |
|
| 41 |
if (defined $special{$field[$i]}) { |
| 42 |
printf '<br>%s: ', &capitalize($field[$i]); |
| 43 |
$comma =0; |
| 44 |
} |
| 45 |
elsif ($first_resist == 0 && $field[$i] =~/^(resist|armour)/) { |
| 46 |
# We want to put the first reist value on its own line, and |
| 47 |
# capitalize it. |
| 48 |
printf '<br>%s', &capitalize($field[$i]); |
| 49 |
$first_resist=1; |
| 50 |
$comma=1; |
| 51 |
} else { |
| 52 |
if ($comma > 0) { |
| 53 |
print ", $field[$i]"; |
| 54 |
} else { |
| 55 |
print &capitalize($field[$i]); |
| 56 |
$comma = 1; |
| 57 |
} |
| 58 |
} |
| 59 |
} |
| 60 |
print "</td></tr>\n"; |
| 61 |
} |
| 62 |
|
| 63 |
|
| 64 |
sub capitalize { |
| 65 |
local($str) = @_; |
| 66 |
$a = substr($str, 1, 1); |
| 67 |
$a =~ tr/a-z/A-Z/; |
| 68 |
$_ = $a . substr($str, 2, 999999); |
| 69 |
|
| 70 |
} |
| 71 |
|
| 72 |
|
