Random quest generator

quest.pl

#!/usr/bin/perl

use strict;
use warnings;

my %data = (
  subject => [
    'A <modifier> <person> named <name>',
    'A <modifier> <person> named <name>',
    '<title> <name>',
  ],
  person => [qw[
    merchant
    ex-adventurer
    elf
    dwarf
    aristocrat
    sage
    farmer
    wizard
    gnome
    peasant
    mercenary
    pirate
    traveler
  ]],
  object => [
    'a rival',
    'the remorseless killer <name>',
    'the <group> of <name>',
    'the pirates of the <name> Sea',
    'the <monster> of <place>',
    '<name>, the <monster> <title>',
  ],
  monster => [qw[ Demon Dragon Leviathan Vampire Goblin Orc Troll Kobold ]],
  group => [qw[ warlocks cultists theives traitors ]],
  modifier => [qw[
    shady
    wealthy
    cunning
    cryptic
    mysterious
    dying
    disgruntled
    hoary
    skittish
    frantic
    mysterious
    worried
    vacant
    crippled
    stocky
    peg-legged
    one-eyed
    lecherous
    destitute
    ghostly
  ]],
  title => [qw[
    Lord
    Lady
    King
    Queen
    Prince
    Princess
    Count
    Countess
    Duke
    Dutchess
  ]],
  adventure => [
    'expose the corruption of <title> <name>',
    'assassinate <title> <name>',
    'steal <item> from <object>',
    'recover <item> from <object>',
    'transport <item> to <place>',
    'hunt down and capture <object>',
    'hunt down and kill <object>',
    'explore <place>',
    'slay <object> and retrieve <item>',
    'slay <object> and destroy <item>',
    'rescue <title> <name> from <object>',
    'investigate a star which fell into <place>',
    'thwart the monstrous plan of <object>',
    'find and explore <place>',
    'discover who is assassinating his peers and why',
    'escort <escort> safely to <place>',
    'recover and destroy <item> from <place>',
    'deliver <item> to <name> in <place>',
    'travel to <place> and retrieve <item>',
    'search <place> for treasure',
    'collect <number> <garbage> from <place>',
    'kill <number> of the nearby <beasts>',
    'travel to <place> and defeat <subject>',
    'make peace with the people of <place>',
    'aid the people of <place> against <subject>',
  ],
  item => [
    'the Relic of <name>',
    'the Sword of <name>',
    'the Amulet of <name>',
    'a <adjective> device',
    'a <adjective> artifact',
  ],
  number => [qw[ 12 20 25 40 50 75 100 200 250 500 1000]],
  garbage => [qw[ berries hides feathers ]],
  beasts => [qw[
    bears
    rabbits
    deer
    fish
    birds
    wolves
    foxes
    pigs
    boars
  ]],
  place => [
    '<name> <name>',
    'the <name> <geo2>',
    'the <geo> of <name>',
    'Lake <name>',
    'the town of <name>',
    'the lost city of <name>',
    'the ancient ruins of <name>',
  ],
  geo => [qw[Isle Sea Swamp Forest Mountains Caverns]],
  geo2 => [qw[Veldt Tundra Savannah Woodlands Caldera <geo>]],
  escort => [
    'a caravan of <adjective> goods',
    'his daughter',
    'his son',
    'his family',
    'her daughter',
    'her son',
    'her family',
  ],
  adjective => [qw[
    powerful
    magical
    exotic
    sacred
    valuable
  ]],
  name => [ '<C><v><c><v><cc>' ],
  C => [qw[ B D F G H J K L M N P R S T V W Wh Y Z Th Ch Sh Zh <V><c>]],
  V => [qw[ A E I O U Ae Ee Ie Oe Ue Oo Au Oi Ai Ea]],
  c => [qw[ b d f g h j k l m n p r s t v w z th ch sh ng]],
  v => [qw[ a e i o u ae ee ie oe ue oo au oi ai ea]],
  cc => [ '', '', '', '', 'y', '<c>', '<c><v>', '<c><v>', '<c><v><cc>' ],
);

my $starting = '<subject> wants you to <adventure>.';

sub choose {
  my ($ref) = @_;
  return $ref->[rand() * @$ref];
}

my $count = 10;
while ($count--) {
  my $quest = $starting;
  while ($quest =~ /<(\w+)>/) {
    my $replace = choose $data{$1};
    $quest =~ s/<\Q$1\E>/$replace/;
  }
  print "$quest\n"
}