#!/usr/bin/perl

#pathfinder
#by David Hutchison
#dave@cameradave.co.uk
#http://cameradave.co.uk
#December 2008
#Random NPC Generator for Pathfinder RPG - 20 point buy

#Routine for determining race
sub race
  {
#Defines races
  @race = qw/dwarf elf gnome halfling halforc halfelf human/;
#Picks race
  $race = @race;
  $decrace = int(rand($race));
  $charrace = $race[$decrace];
  }

#Routine for determining race
sub class
  {
#Defines classes
  @class = qw/barbarian bard cleric druid fighter paladin ranger rogue sorcerer wizard/;
#Picks class
  $class = @class;
  $decclass = int(rand($class));
  $charclass = $class[$decclass];
  }

#Routine for deciding initial stat line, all stat lines are valid 20 points buy lines in pathfinder
sub stats
  {
  $statchoose = int(rand(18));
  if ($statchoose=0)
    {
#Array for statline created. Stats in descending order to aid "shuffling" later
    @statlinea = (17,14,13,13,10,7);
    }
    elsif ($statchoose = 1)
    {
    @statlinea = (17,15,12,10,10,8);
    }
    elsif ($statchoose = 2)
    {
    @statlinea = (17,15,12,11,11,7);
    }
    elsif ($statchoose = 3)
    {
    @statlinea = (16,14,13,12,12,8);
    }
    elsif ($statchoose = 4)
    {
    @statlinea = (16,14,13,12,10,10);
    }
    elsif ($statchoose = 5)
    {
    @statlinea = (16,14,12,12,11,10);
    }
    elsif ($statchoose = 6)
    {
    @statlinea = (15,15,12,12,10,10);
    }
    elsif ($statchoose = 7)
    {
    @statlinea = (15,14,13,13,12,10);
    }
    elsif ($statchoose = 8)
    {
    @statlinea = (15,13,13,13,12,12);
    }
    elsif ($statchoose = 9)
    {
    @statlinea = (15,15,13,13,10,10);
    }
    elsif ($statchoose = 10)
    {
    @statlinea = (15,15,12,12,11,11);
    }
    elsif ($statchoose = 11)
    {
    @statlinea = (15,14,14,12,12,9);
    }
    elsif ($statchoose = 12)
    {
    @statlinea = (14,14,14,12,12,11);
    }
    elsif ($statchoose = 13)
    {
    @statlinea = (14,14,13,13,13,11);
    }
    elsif ($statchoose = 14)
    {
    @statlinea = (14,14,13,13,12,12);
    }
    elsif ($statchoose = 15) 
    {
    @statlinea = (14,14,14,13,13,9);
    }
    elsif ($statchoose = 16)
    {
    @statlinea = (14,13,13,13,13,13);
    }
    elsif ($statchoose = 17)
    {
    @statlinea = (15,14,13,13,12,11); 
    }
  }

#Routine to shuffle numeric stat line, prioritising high values to appropriate stats for class  
sub decidestats  
  {
  if ($charclass eq "barbarian")
    {
    $str = $str + $statlinea[0];
    $dex = $dex + $statlinea[2];
    $con = $con + $statlinea[1];
    $sma = $sma + $statlinea[3];
    $wis = $wis + $statlinea[4];
    $cha = $cha + $statlinea[5];
    }
    elsif ($charclass eq "bard")
    {
    $str = $statlinea[3];
    $dex = $statlinea[1];
    $con = $statlinea[4];
    $sma = $statlinea[0];
    $wis = $statlinea[5];
    $cha = $statlinea[2];
    }
    elsif ($charclass eq "cleric")
    {
    $str = $statlinea[2];
    $dex = $statlinea[5];
    $con = $statlinea[3];
    $sma = $statlinea[4];
    $wis = $statlinea[0];
    $cha = $statlinea[1];
    }
    elsif ($charclass eq "druid")
    {
    $str = $statlinea[5];
    $dex = $statlinea[3];
    $con = $statlinea[4];
    $sma = $statlinea[1];
    $wis = $statlinea[0];
    $cha = $statlinea[2];
    }
    elsif ($charclass eq "fighter")
    {
    $str = $statlinea[0];
    $dex = $statlinea[2];
    $con = $statlinea[1];
    $sma = $statlinea[3];
    $wis = $statlinea[5];
    $cha = $statlinea[4];
    }
    elsif ($charclass eq "paladin")
    {
    $str = $statlinea[1];
    $dex = $statlinea[5];
    $con = $statlinea[2];
    $sma = $statlinea[4];
    $wis = $statlinea[3];
    $cha = $statlinea[0];
    }
    elsif ($charclass eq "ranger")
    {
    $str = $statlinea[3];
    $dex = $statlinea[0];
    $con = $statlinea[4];
    $sma = $statlinea[5];
    $wis = $statlinea[1];
    $cha = $statlinea[2];
    }
    elsif ($charclass eq "rogue")
    {
    $str = $statlinea[5];
    $dex = $statlinea[0];
    $con = $statlinea[3];
    $sma = $statlinea[1];
    $wis = $statlinea[4];
    $cha = $statlinea[2];
    }
    elsif ($charclass eq "sorcerer")
    {
    $str = $statlinea[4];
    $dex = $statlinea[2];
    $con = $statlinea[1];
    $sma = $statlinea[3];
    $wis = $statlinea[5];
    $cha = $statlinea[0];
    }
    elsif ($charclass eq "wizard")
    {
    $str = $statlinea[4];
    $dex = $statlinea[2];
    $con = $statlinea[1];
    $sma = $statlinea[0];
    $wis = $statlinea[5];
    $cha = $statlinea[3];
    }
  }

#Routine to adjust stats according to race of character
sub adjuststats
 
  {
  if ($charrace eq "dwarf")
    {
    $con = $con + 2;
    $wis = $wis + 2;
    $cha = $cha - 2;
    }
    elsif ($charrace eq "elf")
    {
    $dex = $dex + 2;
    $sma = $sma + 2;
    $con = $con - 2;
    }
    elsif ($charrace eq "gnome")
    {
    $con = $con + 2;
    $cha = $cha + 2;
    $str = $str - 2;
    }
    elsif ($charrace eq "halforc")
    {
    $str = $str + 2;
    $wis = $wis + 2;
    $sma = $sma - 2;
    }
    elsif ($charrace eq "halfling")
    {
    $dex = $dex + 2;
    $cha = $cha + 2;
    $str = $str - 2;
    }

#In Pathfinder RPG Humans and Half Elves get +2 to a stat, as NPCs +2 bonus is asigned randomly
    elsif ($charrace eq "human")
    {
    $changestat = int(rand(6));
      if ($changestat eq "0")
      {
      $str=$str + 2;
      }
      elsif ($changestat eq "1")
      {
      $dex = $dex + 2; 
      }
      elsif ($changestat eq "2")
      {
      $con = $con + 2;
      }
      elsif ($changestat eq "3")
      {
      $sma = $sma + 2;
      }
      elsif ($changestat eq "4")
      {
      $wis = $wis + 2;
      }
      elsif ($changestat eq "5")
      {
      $cha = $cha + 2;
      }
                     }
    elsif ($charrace eq "halfelf")
    {
    $changestat = int(rand(6));
      if ($changestat eq "0")
      {
      $str=$str + 2;
      }
      elsif ($changestat eq "1")
      {
      $dex = $dex + 2;
      }
      elsif ($changestat eq "2")
      {
      $con = $con + 2;
      }
      elsif ($changestat eq "3")
      {
      $sma = $sma + 2;
      }
      elsif ($changestat eq "4")
      {
      $wis = $wis + 2;
      }
      elsif ($changestat eq "5")
      {
      $cha = $cha + 2;
      }
    }
  }

#Determines character gender.
sub gender
  {
  @gender = ("male", "female");
  $gender = @gender;
  $sex = $gender[int(rand($gender))];
  }

#Determine which pronoun to use

#sub pronoun
sub pronoun
  {
  @pron = ("He", "She");
  $pron = @pron;
  $pronoun = $pron[int(rand($pron))];
  }

#Generate character name parts
sub name
  {

#Options for first part of the surname
  @surfir = (
    "Amble", "Buck", "Dun", "Even", "Grey", "Black", "White", "Red", "Blue", "Tall", "Short", "Wide",
    "Long", "Far", "Up", "Down", "Under", "Over", "Odd", "Strong", "Deep", "High", "Top", "Gid", "Lang", "Good");

#Decides first part of surname
  $surfir = @surfir;
  $firsur = int (rand($surfir));

#Options for the second part of the surname
  @sursec = (
    "crown", "man", "dragon", "wood", "castle", "stag", "way", "hill", "lake", "forest", "grove", "stud",
    "mare", "griffin", "wyvern", "eagle", "snake", "kin", "adder", "goat", "sheep", "ton", "age", "wich",
    "kestrel", "falcon", "tree", "end", "middle", "ring", "river", "cave", "ox", "leigh", "eon", "ner", "ley", 
    "cia", "try", "ar", "tag", "mers", "ray");

#Decides second part of surname.
  $sursec = @sursec;
  $secsur = int (rand($sursec));

#Determines characters first name after first checking gender of NPC    
  if ($sex eq "male") 
    {
    @boyfir = (
      "Dar", "Dor", "Even", "For", "Gri", "Hel", "Mal", "Mor", "Ran", "Ste", "Ga", "Ni", "Mo", "Fal", "Mir", 
      "Da", "Har", "Bal", "Ed");
    $boyfir = @boyfir;
    $firboy = int (rand($boyfir));

    @boysec = (
      "vin", "n", "dur", "stag", "m", "ark", "dal", "dd", "az", "taz", "vid", "ar", "ak", "vey", "ic", "ik", 
      "rik", "drik", "mund");
    $boysec = @boysec;
    $secboy = int (rand($boysec));
    }
      elsif ($sex eq "female")
        {
        @girlfir = (
          "Arve", "Esv", "Jhes", "Ker", "Lure", "Mi", "Row", "Shan", "Tess", "Sar", "Max", "Dai", "Ali", "Cal",
          "Saw", "Aud");
        $girlfir = @girlfir;
       $firgirl = int (rand($girlfir));

        @girlsec = (
          "ene", "ele", "sail", "ri", "an", "dri", "ah", "ine", "sy", "si", "ee", "li", "i", "ey", "ail", "il");
        $girlsec = @girlsec;
        $secgirl = int (rand($girlsec));
        }
  }

#Subroutines for generating random variables for NPC

#Decide hair colour

sub hair
  {
  @hair = (
    "black", "raven", "raven-black", "dark", "brown", "auburn", "chestnut", "mousy", "light-brown", "yellow", 
    "straw-coloured", "golden", "blonde", "flaxen", "platinum", "dirty-blonde", "strawberry-blonde","red", 
    "ginger", "white", "grey", "greying", "silver", "green", "blue");
  $hair = @hair;
  $haircolour = $hair[int (rand($hair))];
  }

#Decide hair style

sub style
  {
  @style = (
    "long", "short", "thin", "a ponytail of", "spiked", "wind swept", "a mop of", "bushy", "scruffy", 
    "dreadlocks of", "shaved", "a bob of", "parted", "pulled back", "unwashed", "platted", "tidy", "neat", 
    "curly", "flowing locks of", "sharp", "ringlets of", "cropped");
  $style = @style;
  $hairstyle = $style[int (rand($hair))];
  }

#Decide eye colour

sub eye
  {
  @eye = (
    "brown", "hazel", "amber", "golden brown", "chestnut brown", "chocolate-coloured", "copper", "tawny", 
    "blue", "aqua", "sapphire-blue", "azure", "colbolt", "cerulean", "sky-blue", "ice-blue", "baby-blue", 
    "turquoise", "cornflower-blue", "violet", "lavender", "lilac", "indigo", "amethyst", "green", "emerald", 
    "chartreuse", "forest-green", "jade", "moss-green", "grey", "slate-grey", "steel-grey", "black", "red", 
    "yellow", "orange", "coal-black", "gold");
  $eye = @eye;
  $eyecolour = $eye[int (rand($eye))];
  }

#Decide body type

sub body  
  {
  @body = (
    "athletic", "slim", "thin", "rounded", "fat", "lean", "curvy", "chunky", "thickset", "plump", "well-defined", 
    "portly", "muscular", "scrawny", "fit", "powerfully built");
  $body = @body;
  $bodytype = $body[int (rand($body))];
  }

#Decide skin type

sub skin
  {
  @skin = (
    "white", "pale", "pasty", "creamy", "alablaster","tanned", "ruddy", "dark", "golden", "sun-kissed", "dusky", 
    "weathered", "olive", "swarthy", "sallow", "sun-burned", "pox-marked", "jaundiced", "mahogany", "black", 
    "lightly-scarred", "heavily-scarred");
  $skin = @skin;
  $skintype = $skin[int (rand($skin))];
  }

∽̱
&class;
&stats;
&decidestats;
&adjuststats;
&gender;
&pronoun;
&name;
&hair;
&style;
&skin;
&eye;
&body;

#Output
print "\n", $girlfir[$firgirl], $girlsec[$secgirl], $boyfir[$firboy], $boysec[$secboy],
" ", $surfir[$firsur], $sursec[$secsur], " is a $sex $charrace $charclass with stats:\n
Str $str\nDex $dex\nCon $con\nInt $sma\nWis $wis\nCha $cha\n\n";

print  $girlfir[$firgirl], 
$girlsec[$secgirl], $boyfir[$firboy], $boysec[$secboy]," ", $surfir[$firsur], $sursec[$secsur], 
" has $skintype skin and a $bodytype body. $pronoun also has $eyecolour eyes and $hairstyle $haircolour hair.\n\n";