Vivtek Fantasy Name Generator

OK, so, like, I really didn't have time to write this -- so the Muse decreed it should be written. And thus it was.

What we have here is a simple Perl script based on a notion put forth (and once written) by Jo Walton and linked on Making Light. It takes a simple description of a language (a naive lexical description) and rolls dice to give you ten words in that language. Handy-dandy name generator, and you can edit the parameters and get more names until you're blue in the face. Took me, well, I look in dismay at the clock and realize that even though I'm doomed as far as Monday's deadline is concerned, here I sat for about two hours writing this and then wrapping it in a Tcl page for easy calling.

But when the Muse speaks, one listens -- especially if it's the code Muse, because she can be dangerous when thwarted.

Look here to run the beast.

Drop me a line if you like it, hate it, want to change it, etc.


# Being a simplistic way to generate lots and lots
# of names.
$lang{'vowels'} = 'a, e, i, o, u, y';
$lang{'accents'} = 'a, e';
$lang{'consonants'} = 'b, c, d, f, g, h, j, k, l, m, n, p, qu, r, s, t, v, w, x, y, z, th';
$lang{'like'} = 'a, e, e, v';
$lang{'choices'} = 'b.v, v.w, w.r, m.n=n, b.m, c.k=k, c.g, c.s, s.sh, ch.sh, tt.th'; 
$lang{'hard'} = "cv.v";
$lang{'syllables'} = 'vcv, cvc, ccv, v';
$lang{'max_syllables'} = 3;
$lang{'prefixes'} = 'la-, ?, ?';
$lang{'suffixes'} = 'ia, lund';

$number_of_words = 10;

sub getrand { return @_[int(rand(scalar(@_)))]; }
sub getlist { return split /, */, $lang{@_[0]}; }
sub is_in { my $i = shift; return grep {$i eq $_} @_; }

# Modify the above defaults based on input.
while (<>) {
   chomp;
   last unless ($_);
   ($kw, $value) = split(/ /, $_, 2);
   $lang{$kw} = $value;
}

# Tell the user what language we're using.
foreach $kw ('vowels', 'consonants', 'like',
             'accents', 'hard', 'choices',
             'syllables', 'max_syllables',
             'prefixes', 'suffixes') {
   print "$kw $lang{$kw}\n";
}
print "\n";

# Now a little preprocessing.
@v = getlist('vowels');
@c = getlist('consonants');
foreach $accent (getlist('accents')) {
   next if $accent eq '-';
   if (is_in ($accent, @v)) {
      push @v, "$accent'";
   } elsif (is_in ($accent, @c)) {
      push @c, "$accent'";
   }
}
foreach $like (getlist('like')) {
   next if $like eq '-';
   if (is_in ($like, @v)) {
      push @v, $like;
   } elsif (is_in ($like, @c)) {
      push @c, $like;
   }
}
foreach $choice (getlist('choices')) {
   next if $choice eq '-';
   ($ch, $r) = split /=/, $choice;
   ($from, $to) = split /\./, $ch;
   if ($r) {
      $eliminate = $from;
      $eliminate = $to unless $r eq $to;
      @c = grep { $_ ne $eliminate } @c;
   }
}

# Now the fun: we generate words from that language.
while ($number_of_words--) {
   $word = "";

   $syllables = int(rand($lang{'max_syllables'})) + 1;
   while ($syllables--) {
      $syllable = getrand (split /, /, $lang{'syllables'});
      foreach $vc (split //, $syllable) {
         if ($vc eq 'v') {
            $word .= getrand (@v);
         } elsif ($vc eq 'c') {
            $word .= getrand (@c);
         }
      }
   }

   foreach $hard (getlist('hard')) {
      ($from, $to) = split /\./, $hard;
      $word =~ s/$from/$to/g;
   }

   if ($lang{'prefixes'}) {
      $word = getrand (getlist ('prefixes')) . $word;
   }
   if ($lang{'suffixes'}) {
      $word .= getrand (getlist ('suffixes'));
   }

   $word =~ s/\?//g;

   print ucfirst($word) . "\n";
}







Copyright © 1996-2009 Vivtek. All Rights Reserved. Read the disclaimer.
Read our privacy statement, too, if you are concerned.
Problems? Try webmaster@vivtek.com or our answer page.