#!/usr/bin/perl -w
# $Id$

use lib '.';
use utf8;
use Verbatim;
use Util;
use FancyName;
use ObjFlags;
use ObjName;

my %tsval = ObjName::object_names();
my %power_talents = (
  'detect curses'		=> 'T_PRIEST_DET_CURSE',
  'create food'			=> 'T_HOBBIT_CREATE_FOOD',
  'blink'			=> 'T_GNOME_BLINK',
  'find secret passages'	=> 'T_DWARF_PASSWALL',
  'remove fear'			=> 'T_ORC_REMOVE_FEAR',
  'berserk'			=> 'T_TROLL_BERZERK',
  'set explosive rune'		=> 'T_HALF_OGRE_RUNE',
  'turn into a bear'		=> 'T_BEORNING_BEARFORM',
  'poison dart'			=> 'T_KOBOLD_POISON_DART',
  'detect doors and traps'	=> 'T_PETTY_DWARF_DETECT_TRAPS',
  'magic missile'		=> 'T_DARK_ELF_MISSILE',
  'grow trees'			=> 'T_ENT_GROW_TREES',
  "Rohan Knight's Powers"	=> { 1 => [ 'T_ROHAN_FLASH_AURA' ],
				     30 => [ 'T_ROHAN_SPEED' ] },
  "Thunderlord's Powers"	=> { 1 => [ 'T_THUNDER_STRIKE' ],
				     3 => [ 'T_THUNDER_ROAD' ],
				     7 => [ 'T_THUNDER_RECALL' ] },
  "Death Mold's Powers"		=> [ 'T_DEATHMOLD_TELEPORT',
				     'T_DEATHMOLD_FETCH',
				     'T_DEATHMOLD_CHANGE_LEVEL' ],
);

if (open IN, '<t2-src/src/tables.c') {
  while (<IN>) { last if /^power_type powers_type_init/ }
  my $pow_name = undef;
  while (<IN>) {
    last if /^};/;
    if (/^\s*"([^"]+)",/ && exists $power_talents{$1}) {
      $pow_name = $1;
      next;
    }
    if ($pow_name && /^\s*(\d+), (\d+), A_(\w+), (\d+),/) {
      my ($level, $cost, $stat, $diff) = ($1, $2, $3, $4);
      my $ids = $power_talents{$pow_name};
      $ids = [ $ids ] unless ref $ids && ref $ids eq 'ARRAY';
      $power_talents{$pow_name} = { $level => $ids };
      $pow_name = undef;
    }
    if ($pow_name && /^\s*0, 0, 0, 0,/) {
      my $ids = $power_talents{$pow_name};
      next if ref $ids && ref $ids eq 'HASH';
      $ids = [ $ids ] unless ref $ids && ref $ids eq 'ARRAY';
      $power_talents{$pow_name} = { 1 => $ids };
      $pow_name = undef;
    }
  }
  close IN;
}
else {
  die "Cannot open tables.c:  $!\n";
}

my @STATS = qw(STR INT WIS DEX CON CHA);
my @ABILS = qw(DISARMING MAGIC_DEVICE SAVING_THROW STEALTH SEARCHING
	       PERCEPTION MELEE_HIT RANGE_HIT);
my @BODY = qw(MAIN_HAND OFF_HAND BODY CLOAK LAUNCHER QUIVER GLOVES BOOTS
	      HELM RING AMULET LITE TOOL SYMBIOTE);

my %display = (
  'Half-Elf'	=> [ 'h', 'W' ],
  'Elf'		=> [ 'h', 'W' ],
  'Hobbit'	=> [ 'h', 's' ],
  'Gnome'	=> [ 'h', 'U' ],
  'Dwarf'	=> [ 'h', 'U' ],
  'Orc'		=> [ 'o', 'U' ],
  'Troll'	=> [ 'T', 'g' ],
  'High-Elf'	=> [ 'h', 'w' ],
  'Half-Ogre'	=> [ 'O', 'o' ],
  'Beorning'	=> [ 'q', 'u' ],
  'Kobold'	=> [ 'k', 'g' ],
  'Petty-Dwarf'	=> [ 'h', 'o' ],
  'Dark-Elf'	=> [ 'h', 'D' ],
  'Ent'		=> [ '#', 'G' ],
  'Thunderlord'	=> [ 'B', 'G' ],
  'DeathMold'	=> [ 'm', 'D' ],
  'Yeek'	=> [ 'y', 'u' ],
  'Wood-Elf'	=> [ 'h', 'G' ],
  'Vampire'	=> [ 'V' ],
  'Spectre'	=> [ 'G' ],
  'Skeleton'	=> [ 's' ],
  'Zombie'	=> [ 'z' ],
);

my %birth_equip = (
  class => {
    'Rogue' => [
      # From player_outfit() in src/birth.c
      q(name='IRON_SHOT', qty={1,11,4}, no_auto_equip=true),
    ],
    # Everything from here down is from __birth_hook_objects in
    # lib/scpt/player.lua
    'Ranger' => [
      q(name='SPELLBOOK_OF', resolve={ force_spell=ActorTalents.T_PHASE_DOOR }),
    ],
    'Geomancer' => [
      q(name='SPELLBOOK_OF', resolve={ force_spell=ActorTalents.T_GEYSER }),
    ],
    'Priest(Eru)' => [
      q(name='SPELLBOOK_OF', resolve={ force_spell=ActorTalents.T_SEE_THE_MUSIC }),
    ],
    'Priest(Manwe)' => [
      q(name='SPELLBOOK_OF', resolve={ force_spell=ActorTalents.T_MANWE_BLESSING }),
    ],
    'Druid' => [
      q(name='SPELLBOOK_OF', resolve={ force_spell=ActorTalents.T_CHARM_ANIMAL }),
    ],
    'Dark-Priest' => [
      q(name='SPELLBOOK_OF', resolve={ force_spell=ActorTalents.T_CURSE }),
    ],
    'Paladin' => [
      q(name='SPELLBOOK_OF', resolve={ force_spell=ActorTalents.T_DIVINE_AIM }),
    ],
    'Mimic' => [
      q(name='MIMICRY_CLOAK', resolve={ force_mimic_form='Mouse' }),
    ],
  },
);

my @P = ();
my %R = ();
my %CG = ();
my %H = ();
sub accum (\%) {
  my $p = $_[0];
  return if scalar keys %$p == 0 || $$p{name} =~ /\b[Tt]est$/ ||
	    $$p{name} =~ /^xxx/;
  if ($$p{type} eq 'race' || $$p{type} eq 'subrace' || $$p{type} eq 'class') {
    my $q = $$p{type} eq 'class' ? $CG{$$p{group}} : $p;
    my %s = map { ($_ => 0) } @STATS;
    if (exists $$q{stat_adj}) {
      for (@{$$q{stat_adj}}) { $s{$$_[0]} = $$_[1] }
    }
    my $sl1 = join ', ', map { sprintf "\%+d $_", $s{$_} } @STATS[0..2];
    my $sl2 = join ', ', map { sprintf "\%+d $_", $s{$_} } @STATS[3..5];
    my $hp = sprintf '%+d', $$q{hit_die};
    my $exp = sprintf '%+d%%', $$q{xp_mult};
    $$p{desc} .= <<EOF;


#GOLD#Stat modifiers:
#LIGHT_BLUE#$sl1
$sl2#LAST#
HP per level:  #LIGHT_BLUE#$hp#LAST#
Exp penalty:  #LIGHT_BLUE#$exp#LAST#
EOF
    chomp $$p{desc};
  }
  if (exists $birth_equip{$$p{type}} && exists $birth_equip{$$p{type}}{$$p{name}})
  {
    $$p{starts_with} ||= [];
    push @{$$p{starts_with}}, @{$birth_equip{$$p{type}}{$$p{name}}};
    $$p{copy} = 1;
  }
  push @P, { %$p };
  $R{$$p{name}} = $P[-1] if $$p{type} eq 'race';
  $CG{$$p{name}} = $P[-1] if $$p{type} eq 'class_group';
  %$p = ();
}

$ObjFlags::dump_field_hook = sub ($@) {
  my ($field, @ff) = @_;
  return [ map { "'$_'" } @ff ] if $field eq 'abilities';
  return [ map { "ActorTalents.$_" } @ff ] if $field eq 'talents';
  return undef
};

sub output (\%) {
  my $p = $_[0];
  my %flags = ();

  FancyName::substitute $$p{name};
  FancyName::substitute $$p{desc};

  my $hack_key = "$$p{type}/$$p{name}";
  my $verbatim = exists $verbatim{$hack_key} ? $verbatim{$hack_key} : undef;

  print <<EOF;

newBirthDescriptor {
  type = '$$p{type}',
  name = '$$p{name}',
  -- verbatim_hack = '$hack_key',
  desc = [[${\( $$p{desc} || '' )}]],
EOF
  print "  name_mod = '$$p{name_mod}',\n" if $$p{name_mod};
  print "  group = '$$p{group}',\n" if $$p{group};
  if (exists $display{$$p{name}}) {
    local $dd = $display{$$p{name}};
    print "  opt_display = '$$dd[0]',\n";
    print "  opt_color = colors.C_$$dd[1],\n" if scalar @$dd > 1;
  }
  if ($$p{copy} || $$p{type} eq 'base') {
    print "  copy = {\n";
    if ($$p{type} eq 'base') {
      print <<EOF;
    xp_mult = 100,
    base_mana_mult = 1,
    birth_adj_luck = 0,
    base_flags = {},
    starting_quest = 'necromancer',
    ahw = {
      age = { base=0, mod=0 },
      height = {
	Male = { mean=0, std=0 },
	Female = { mean=0, std=0 },
	Neuter = { mean=0, std=0 },
      },
      weight = {
	Male = { mean=0, std=0 },
	Female = { mean=0, std=0 },
	Neuter = { mean=0, std=0 },
      },
    },
    resolvers.birth_ahw(),
    resolvers.birth_luck(),
    resolvers.birth_stat_apply(),
    resolvers.birth_hp_precalc(),
    resolvers.birth_equip {
      { name='RATION_OF_FOOD', qty={1,5,2} },
      { name='WOODEN_TORCH', qty={1,5,2}, no_auto_equip=true },
    },
EOF
    }
    printf "    resolvers.birth_mana_mult(\%4.2f),\n", $$p{mana_mult}/100
      if $$p{mana_mult};
    if ($$p{skill_adj}) {
      print "    resolvers.birth_skill_adj {\n";
      for (@{$$p{skill_adj}}) {
	next if $$_[0] eq 'Spell-learning';
	my $tag = uc $$_[0];
	$tag =~ s/[^A-Za-z0-9_]/_/g;
	my @sk = ();
	push @sk, "base_$$_[1]=$$_[2]" if $$_[1] eq 'set' || $$_[2] != 0;
	push @sk, "mod_$$_[3]=$$_[4]" if $$_[3] eq 'set' || $$_[4] != 0;
	my $sk = join ', ', @sk;
	print "      $tag = { $sk },\n" if $sk;
      }
      print "    },\n";
    }
    print "    resolvers.birth_skill_finalize(),\n" if $$p{type} eq 'base';
    if ($$p{blows}) {
      print "    weapon_blows = { base_wgt=$$p{blows}[0], wgt_mult=$$p{blows}[1] },\n";
    }
    if ($$p{pseudo_id}) {
      my $w = $$p{pseudo_id}[0] eq 'H' ? 'true' : 'false';
      my $m = $$p{pseudo_id}[1] eq 'H' ? 'true' : 'false';
      print "    pseudo_id = { weapon_heavy=$w, magic_heavy=$m },\n";
    }
    if ($$p{flags} && scalar @{$$p{flags}} > 0) {
      %flags = map { ($_ => 1) } @{$$p{flags}};
      print "    base_flags = {\n";
      for (@{$$p{flags}}) { print "      $_ = true,\n" }
      print "    },\n";
    }
    if ($$p{gain_at_level}) {
      print "    resolvers.birth_gain_at_lev {\n";
      for my $lev (sort { $a <=> $b } keys %{$$p{gain_at_level}}) {
	my $ff = flag_dump $$p{gain_at_level}{$lev}, '      ';
	# Slight Hack(TM):  Change Maia's DRAIN_EXP flag to MAIA_DRAIN_EXP
	# to get a different status effect.
	$ff =~ s/\bDRAIN_EXP\b/MAIA_DRAIN_EXP/;
	print "      [$lev] = {$ff},\n";
      }
      print "    },\n";
    }
    if ($$p{starts_with}) {
      print "    resolvers.birth_equip {\n      full_id=true,\n";
      # Slight Hack(TM):  Archers start with a bow, a sling and arrows; we
      # want them to start with the bow and arrows wielded, so we need to
      # mark the sling as no-auto-wield.
      my $has_bow = 0;
      for (@{$$p{starts_with}}) {
	if (ref $_) {
	  my $key = "$$_[0]:$$_[1]";
	  warn "??? $key\n" and next unless exists $tsval{$key};
	  my $amt = $$_[3] == 1 ? $$_[2] : "{$$_[2],$$_[3]}";
	  my $num = $$_[2] == 1 && $$_[3] == 1 ? '' : ", qty=$amt";
	  my $name = $tsval{$key};
	  $has_bow = 1 if $name eq 'SHORT_BOW';
	  my $sfx = $name eq 'SLING' && $has_bow ? ', no_auto_equip=true' : '';
	  $_ = "name='$name'$num$sfx";
	}
	print "      { $_ },\n";
      }
      print "    },\n";
    }
    print "  },\n";
  }
  if ($$p{copy_add}) {
    print "  copy_add = {\n";
    for my $f (qw(hit_die xp_mult infravision birth_adj_luck)) {
      print "    $f = $$p{$f},\n" if defined $$p{$f};
    }
    if ($$p{stat_adj}) {
      my $adj = join ', ', map { "$$_[0] = $$_[1]" } @{$$p{stat_adj}};
      print "    adj_stat = { $adj },\n" if $adj;
    }
    if ($$p{fluff}) {
      my $F = $$p{fluff};
      my $any_age = $$F[0] || $F[1];
      my $any_ht = $$F[2] || $$F[3] || $$F[6] || $F[7];
      my $any_wt = $$F[4] || $$F[5] || $$F[8] || $F[9];
      if ($any_age || $any_ht || $any_wt) {
	my $n_b_ht = int(($$F[2] + $$F[6])/2);
	my $n_m_ht = int(($$F[3] + $$F[7])/2);
	my $n_b_wt = int(($$F[4] + $$F[8])/2);
	my $n_m_wt = int(($$F[5] + $$F[9])/2);
	print "    ahw = {\n";
	print "      age = { base=$$F[0], mod=$$F[1] },\n" if $any_age;
	if ($any_ht) {
	  print "      height = {\n";
	  print "\tMale = { mean=$$F[2], std=$$F[3] },\n"
	    if $$F[2] || $$F[3];
	  print "\tFemale = { mean=$$F[6], std=$$F[7] },\n"
	    if $$F[6] || $$F[7];
	  print "\tNeuter = { mean=$n_b_ht, std=$n_m_ht },\n"
	    if $n_b_ht || $$n_m_ht;
	  print "      },\n";
	}
	if ($any_wt) {
	  print "      weight = {\n";
	  print "\tMale = { mean=$$F[4], std=$$F[5] },\n"
	    if $$F[4] || $$F[5];
	  print "\tFemale = { mean=$$F[8], std=$$F[9] },\n"
	    if $$F[8] || $$F[9];
	  print "\tNeuter = { mean=$n_b_wt, std=$n_m_wt },\n"
	    if $n_b_wt || $$n_m_wt;
	  print "      },\n";
	}
	print "    },\n";
      }
    }
    print "  },\n";
  }
  $$p{allowed_gods} = [ 'Nobody' ] if $flags{NO_GOD} && !$$p{allowed_gods};
  for my $f (qw(allowed_gods allowed_subraces allowed_classes forbidden_classes))
  {
    if ($$p{$f} && scalar @{$$p{$f}} > 0) {
      print "  $f = {\n";
      for (@{$$p{$f}}) {
	FancyName::substitute $_;
	print "    ['$_'] = true,\n";
      }
      print "  },\n";
    }
  }
  if ($$p{body}) {
    my $any = 0;
    for (values %{$$p{body}}) { $any ||= $_ }
    if ($any) {
      my $a = join ', ', map { "$_=$$p{body}{$_}" } @BODY;
      print "  body = { $a, INVEN=23 },\n";
    }
  }
  if (defined $$p{history}) {
    print "  history_start_idx = $$p{history},\n";
  }
  elsif ($$p{type} eq 'race') {
    warn "??? No history defined for race descriptor '$$p{name}'\n";
  }
  print "  -- BEGIN VERBATIM\n$verbatim  -- END VERBATIM\n" if $verbatim;
  print "}\n";
}

sub output_history ($) {
  my $idx = $_[0];
  my $h = $H{$idx};
  print <<EOF;

newBackground {
  idx = $idx,
  text = {
EOF
  for my $l (@{$$h{lines}}) {
    print "    { prob=$$l{prob}, next=$$l{next}, social=$$l{soc}, text=[[$$l{text}]] },\n";
  }
  print "  },\n}\n";
}

sub touch_gain_at_lev (\%$) {
  my ($p, $lev) = @_;
  $$p{gain_at_level} ||= {};
  $$p{gain_at_level}{$lev} ||= {};
}

my %types = (
  C	=> 'class_group',
  'C:a'	=> 'class',
  R	=> 'race',
  S	=> 'subrace',
);

my %p = ();
my ($gain_lev, $gain_pval, $cur_grp) = (0, 0, '');
open IN, '<t2-src/lib/edit/p_info.txt' or die "Ack:  $!\n";;
while (<IN>) {
  chomp;
  s/\s*\|\s*$//;
  if (/^([CRS](?::a)?):N(?::\d+)?:(.*)$/) {
    accum %p;
    warn "??? $1 type?\n" and next unless exists $types{$1};
    %p = ( type => $types{$1}, name => $2 );
    $cur_grp = $p{name} if /^C:N:/;
    $p{group} = $cur_grp if /^C:a:N:/;
    $p{name} = 'Base' if /^S:N:\d+: $/;
    next;
  }
  if (/^(?:C:D:0|C:a:D|R:D):(.*)$/) {
    $p{desc} = $p{desc} ? "$p{desc} $1" : $1;
    next;
  }
  if (/^S:D:([AB]):(.*)$/) {
    $p{desc} = $p{desc} ? "$p{desc} $2" : $2;
    $p{name_mod} = $1 eq 'A' ? 'suffix' : 'prefix';
    delete $p{name_mod} if $p{name} eq 'Base';
  }
  if (/^C:D:1:(.*)/) {
    $p{titles} ||= [];
    push @{$p{titles}}, $1;
    next;
  }
  if (/^([CRS]):S:(-?\d+(?::-?\d+)+)$/) {
    my ($pfx, $stats) = ($1, $2);
    my @s = split /:/, $stats;
    $p{stat_adj} = [
      grep { $$_[1] != 0 } map { [ $STATS[$_], $s[$_] ] } 0..$#STATS
    ];
    $p{mana_mult} = $s[6] if $pfx eq 'C' && $s[6] != 0;
    $p{mana_mult} = $s[7] if $pfx eq 'S' && $s[7] != 0;
    $p{birth_adj_luck} = $s[6] if $pfx =~ /[RS]/ && $s[6] != 0;
    $p{mana_mult} += 100 if $p{mana_mult} && /^C:/;
    for (@s[0..5]) { $p{copy_add} ||= $_ }
    $p{copy_add} ||= $p{birth_adj_luck};
    $p{copy} ||= $p{mana_mult};
    next;
  }
  if (/^([GCRS](?::a)?):k:([+=-]\d+):([+=-]\d+):(\S+)$/) {
    my ($pfx, $base, $mod, $name) = ($1, $2, $3, $4);
    if ($pfx eq 'G' && (!$p{type} || $p{type} ne 'base')) {
      accum %p;
      %p = ( type => 'base', name => 'base', desc => '' );
    }
    my $base_adj = $base =~ /^=/ ? 'set' : 'adj';
    $base =~ s/^[+=]//;
    my $mod_adj = $mod =~ /^=/ ? 'set' : 'adj';
    $mod =~ s/^[+=]//;
    $p{skill_adj} ||= [];
    push @{$p{skill_adj}}, [ $name, $base_adj, $base, $mod_adj, $mod ];
    $p{copy} = 1;
    next;
  }
  if (/^[CRS]:P:(-?\d+):(\d+)(?::(\d+)(?::(\d+))?)?$/) {
    my ($hp, $xp, $infra, $hist) = ($1, $2, $3, $4);
    $xp -= 100 if /^R:/;
    @p{qw(hit_die xp_mult)} = ($hp, $xp);
    $p{infravision} = $infra if defined $infra;
    $p{history} = $hist if defined $hist;
    $p{copy_add} ||= $hp || $xp || $infra;
    next;
  }
  if (/^C:B:\d+:(\d+):(\d+)$/) {
    $p{blows} = [ $1/10, $2 ];
    $p{copy} = 1;
    next;
  }
  if (/^C:C:([HL]):([HL]):\d+:\d+:\d+$/) {
    $p{pseudo_id} = [ $1, $2 ];
    $p{copy} = 1;
    next;
  }
  if (/^[CRS](?::a)?:G:(.*)$/) {
    $p{flags} ||= [];
    push @{$p{flags}}, split /\s*\|\s*/, $1;
    $p{copy} ||= scalar @{$p{flags}} > 0;
    next;
  }
  if (/^[CRS]:R:(\d+):(-?\d+)$/) {
    ($gain_lev, $gain_pval) = ($1, $2);
    touch_gain_at_lev %p, $gain_lev;
    $p{copy} = 1;
    next;
  }
  if (/^[CRS]:F:(.*)$/) {
    for my $f (split /\s*\|\s*/, $1) {
      my ($group, $field) = flag_loc $f;
      if ($group eq 'stat_flags' || $group eq 'pval_flags') {
	flag_put($p{gain_at_level}{$gain_lev}, $f, undef, undef, $gain_pval);
      }
      else {
	flag_put($p{gain_at_level}{$gain_lev}, $f);
      }
    }
    next;
  }
  if (/^[RC]:Z:(.*)$/) {
    my $pw = $1;
    warn "Unrecognized power '$pw'\n" and next unless exists $power_talents{$pw};
    my $def = $power_talents{$pw};
    for my $lvl (keys %$def) {
      touch_gain_at_lev %p, $lvl;
      $p{gain_at_level}{$lvl}{talents} ||= [];
      push @{$p{gain_at_level}{$lvl}{talents}}, @{$$def{$lvl}};
      $p{copy} = 1;
    }
    next;
  }
  if (/^[CRS](?::a)?:O:(\d+):(\d+):(\d+)d(\d+)$/) {
    $p{starts_with} ||= [];
    push @{$p{starts_with}}, [ $1, $2, $3, $4 ];
    $p{copy} = 1;
    next;
  }
  if (/^[CRS](?::a)?:b:(\d+):(.*)$/) {
    my ($lev, $abil) = ($1, uc $2);
    $abil =~ s/\((\d)\)$/ $1/;
    $abil =~ s/[^A-Za-z0-9_]/_/g;
    touch_gain_at_lev %p, $lev;
    $p{gain_at_level}{$lev}{abilities} ||= [];
    push @{$p{gain_at_level}{$lev}{abilities}}, $abil;
    $p{copy} = 1;
    next;
  }
  if (/^C:a:g:(.*)$/) {
    $p{allowed_gods} ||= [];
    my $g = $1;
    if ($g eq 'All Gods') {
      push @{$p{allowed_gods}}, ('Nobody', 'Eru Iluvatar', 'Manwe Sulimo',
				 'Tulkas', 'Melkor Bauglir',
				 'Yavanna Kementari');
    }
    else {
      push @{$p{allowed_gods}}, $g;
    }
    next;
  }
  if (/^[CRS](?::a)?:E:(\d+):(\d+):(\d+):(\d+):(\d+):(\d+)$/) {
    my @body = ( $1, $2, $3, $4, $5, $6 );
    $p{body} ||= {};
    $p{body}{MAIN_HAND} = $body[0];
    @{$p{body}}{qw(OFF_HAND GLOVES)} = ($body[2]) x 2;
    $p{body}{LAUNCHER} = $body[0] > 0 ? 1 : 0;
    @{$p{body}}{qw(BODY CLOAK LITE QUIVER SYMBIOTE)} = ($body[1]) x 5;
    $p{body}{RING} = $body[3];
    @{$p{body}}{qw(HELM AMULET)} = ($body[4]) x 2;
    $p{body}{TOOL} = $body[2] > 0 ? 1 : 0;
    $p{body}{BOOTS} = $body[5];
    next;
  }
  if (/^S:A:(.*)$/) {
    next unless exists $p{name_mod};	# All races can have no subrace.
    for (split /\s*\|\s*/, $1) {
      warn "??? no race $_\n" and next unless exists $R{$_};
      $R{$_}{allowed_subraces} ||= [];
      push @{$R{$_}{allowed_subraces}}, $p{name}
    }
  }
  if (/^(?:R:C|S:C:A):(.*)$/) {
    $p{allowed_classes} ||= [];
    push @{$p{allowed_classes}}, split /\s*\|\s*/, $1;
    next;
  }
  if (/^S:C:F:(.*)$/) {
    $p{forbidden_classes} ||= [];
    push @{$p{forbidden_classes}}, split /\s*\|\s*/, $1;
    next;
  }
  if (/^[RS]:M:(.*)$/) {
    my $tmp = $1;
    $p{fluff} = [ split ':', $tmp ];
    for (@{$p{fluff}}) { $p{copy_add} ||= $_ }
    next;
  }
  if (/^H:(\d+):(\d+):(\d+):(\d+):(\d+):(.*)$/) {
    my ($idx, $prob, $chart, $next, $soc, $text) = ($1, $2, $3, $4, $5, $6);
    $H{$chart} ||= {};
    my $h = $H{$chart};
    FancyName::substitute $text;
    $$h{lines} ||= [];
    push @{$$h{lines}}, {
      prob => $prob,
      next => $next,
      soc => $soc - 50,
      text => $text,
    };
  }
}
close IN;
accum %p;

my $filename = 'data/birth/race-class.lua';
load_verbatim $filename, key => 'verbatim_hack';
open OUT, ">$filename" or die "Ack: $!\n";
select OUT;
binmode OUT, ':utf8';
print_file_hdr 'gen_plyr', "Player descriptors generated from T2's p_info.txt.";
print "\nlocal DamageType = require 'engine.DamageType'\n";
for my $p (@P) { output %$p }
close OUT;

open OUT, ">data/background_data.lua" or die "Ack: $!\n";
select OUT;
binmode OUT, ':utf8';
print_file_hdr 'gen_plyr', "Player background text generated from T2's p_info.txt.";
for my $idx (sort { $a <=> $b } keys %H) { output_history $idx }
close OUT;