#!/usr/bin/perl
# Turn HTML on for use on web. 0 is off.
$htmlstatus = "0";
# Verbose reporting variables. 0 is off.
# verbose reporting is for debugging purposes and displays only
# in shell mode. HTML must be off for shell mode to work.
$verbose_name ="1";
$verbose_prefix = "0";
$verbose_suffix = "0";
# Configuration variables
$dirprefix = "prefix";
$dirsuffix = "suffix";
# How many names do we want to generate?
$num_names = "2";
#$num_names = $FORM('num_names'); #uncomment if getting num from webform
# Choosing to start with a consonant or a vowel prefix
@consvow = ("cons","vows","cons","cons");
# Arrays for choosing which vowels or consonants to use for prefixes
@prevows = ("A","E","I","O","U","Qvow","Yvow");
@precons = ("B","C","D","F","G","H","J","K","L","M","N","P","Q","R","S","T","V","W","X","Y","Z");
@pre2vows = ("A","a","E","e","I","i","O","o","U","u","Qvow","qvow","Yvow","yvow");
@pre2cons = ("B","b","C","c","D","d","F","f","G","g","H","h","J","j","K","k","L","l","M","m","N","n","P","p","Q","q","R","r","S","s","T","t","V","v","W","w","X","x","Y","y","Z","z");
# Number of wordparts array
#@syllables = ("1","2","3","4");
@syllables = ("2","2","2","3","3","3","4","4","4","5","5","6","6");
sub do_apostcheck {
@apostrophe = ("no","no","yes","no");
$doapost = rand(@apostrophe);
$apostyes = $apostrophe[$doapost];
}
sub do_wordparts {
$syllnum = rand(@syllables);
$wordparts = "$syllables[$syllnum]";
}
sub do_prefix {
$cvselect = rand(@consvow);
$cvchoice = "$consvow[$cvselect]";
# if ($FORM['$letter'] && $FORM['$convow'] eq "cons") {
# $begin = "$dirprefix/$FORM['$letter'].txt";
# $cvchoice = "cons";
# }
# if ($FORM['$letter'] && $FORM['$convow'] eq "vows") {
# $begin = "$dirprefix/$FORM['$letter'].txt";
# $cvchoice = "cons";
# }
if ($cvchoice eq "vows"){
$choice = rand(@prevows);
$begin = $prevows[$choice];
open (PRE, "$dirprefix/$prevows[$choice].txt");
while (defined($predata = <PRE>)) {
push @pre, $predata;
$prenum = rand(@pre);
$prefix = $pre[$prenum];
$prefix =~ s/\n//g;
$prefix =~ s/ //g;
}
close (PRE);
}
if ($cvchoice eq "cons") {
$choice = rand(@precons);
$begin = $precons[$choice];
open (PRE, "$dirprefix/$precons[$choice].txt");
while (defined($predata = <PRE>)) {
push @pre, $predata;
$prenum = rand(@pre);
$prefix = $pre[$prenum];
$prefix =~ s/\n//g;
$prefix =~ s/ //g;
}
close (PRE);
}
}
sub do_2ndprefix {
if ($pre2choice eq "vows"){
$pre2choice = rand(@pre2vows);
$pre2begin = $prevows[$pre2choice];
open (PRE2, "$dirprefix/$pre2vows[$pre2choice].txt");
while (defined($pre2data = <PRE>)) {
push @pre2, $pre2data;
$pre2num = rand(@pre2);
$prefix2 = $pre2[$prenum];
$prefix2 =~ s/\n//g;
$prefix2 =~ s/ //g;
}
close (PRE);
}
if ($pre2choice eq "cons") {
$pre2choice = rand(@pre2cons);
$pre2begin = $pre2cons[$pre2choice];
open (PRE2, "$dirprefix/$precons[$pre2choice].txt");
while (defined($pre2data = <PRE2>)) {
push @pre2, $pre2data;
$pre2num = rand(@pre2);
$prefix2 = $pre2[$pre2num];
$prefix2 =~ s/\n//g;
$prefix2 =~ s/ //g;
}
close (PRE);
}
}
sub getpart2 {
open (PART2, "$part2.txt");
while (defined($part2data = <PART2>)) {
push @part2, $part2data;
$part2num = rand(@part2);
$wordpart2 = "$part2[$part2num]";
$wordpart2 =~ s/\n//g;
$wordpart2 =~ s/ //g;
}
close (PART2);
}
sub getpart3 {
open (PART3, "$part3.txt");
while (defined($part3data = <PART3>)) {
push @part3, $part3data;
$part3num = rand(@part3);
$wordpart3 = "$part3[$part3num]";
$wordpart3 =~ s/\n//g;
$wordpart3 =~ s/ //g;
}
close (PART3);
}
sub getpart4 {
open (PART4, "$part4.txt");
while (defined($part4data = <PART4>)) {
push @part4, $part4data;
$part4num = rand(@part4);
$wordpart4 = "$part4[$part4num]";
$wordpart4 =~ s/\n//g;
$wordpart4 =~ s/ //g;
}
close (PART4);
}
sub getpart5 {
open (PART5, "$part5.txt");
while (defined($part5data = <PART5>)) {
push @part5, $part5data;
$part5num = rand(@part5);
$wordpart5 = "$part5[$part5num]";
$wordpart5 =~ s/\n//g;
$wordpart5 =~ s/ //g;
}
close (PART5);
}
sub do_suffix {
open (SUFFIX, "$dirsuffix/$suftype.txt");
while (defined ($suffixdata = <SUFFIX>)) {
push @suffix, $suffixdata;
$suffixnum = rand(@suffix);
$suffix = "$suffix[$suffixnum]";
$suffix =~ s/\n//g;
$suffix =~ s/ //g;
}
close (SUFFIX);
}
sub do_rulecheck {
if ($wordparts eq "2" && $cvchoice eq "cons" && $apostyes eq "no") {
$suftype="vow";
&do_suffix;
$name = "$prefix$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "2 A";
}
if ($wordparts eq "2" && $cvchoice eq "vows" && $apostyes eq "no") {
$suftype="con";
&do_suffix;
$name = "$prefix$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "2 B";
}
if ($wordparts eq "2" && $cvchoice eq "cons" && $apostyes eq "yes") {
$suftype="vow";
&do_suffix;
$name = "$prefix'$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "2 C";
}
if ($wordparts eq "2" && $cvchoice eq "vows" && $apostyes eq "yes") {
$suftype="con";
&do_suffix;
$name = "$prefix'$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "2 D";
}
if ($wordparts eq "3" && $cvchoice eq "cons" && $apostyes eq "no") {
$part2 = "vow";
&getpart2;
$suftype="con";
&do_suffix;
$name = "$prefix$wordpart2$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "3 A";
}
if ($wordparts eq "3" && $cvchoice eq "vows" && $apostyes eq "no") {
$part2 = "con";
&getpart2;
$suftype="vow";
&do_suffix;
$name = "$prefix$wordpart2$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "3 B";
}
if ($wordparts eq "3" && $cvchoice eq "cons" && $apostyes eq "yes") {
$part2 = "vow";
&getpart2;
$suftype="con";
&do_suffix;
$name = "$prefix'$wordpart2$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "3 C";
}
if ($wordparts eq "3" && $cvchoice eq "vows" && $apostyes eq "yes") {
$part2 = "con";
&getpart2;
$suftype="vow";
&do_suffix;
$name = "$prefix'$wordpart2$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "3 D";
}
if ($wordparts eq "4" && $cvchoice eq "cons" && $apostyes eq "no") {
$part2 = "vow";
&getpart2;
$part3 = "con";
&getpart3;
$suftype="vow";
&do_suffix;
$name = "$prefix$wordpart2$wordpart3$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "4 A";
}
if ($wordparts eq "4" && $cvchoice eq "vows" && $apostyes eq "no") {
$part2 = "con";
&getpart2;
$part3 = "vow";
&getpart3;
$suftype="con";
&do_suffix;
$name = "$prefix$wordpart2$wordpart3$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "4 B";
}
if ($wordparts eq "4" && $cvchoice eq "cons" && $apostyes eq "yes") {
$part2 = "vow";
&getpart2;
$part3 = "con";
&getpart3;
$suftype="vow";
&do_suffix;
$name = "$prefix$wordpart2'$wordpart3$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "4 C";
}
if ($wordparts eq "4" && $cvchoice eq "vows" && $apostyes eq "yes") {
$part2 = "con";
&getpart2;
$part3 = "vow";
&getpart3;
$suftype="con";
&do_suffix;
$name = "$prefix$wordpart2'$wordpart3$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "4 D";
}
if ($wordparts eq "5" && $cvchoice eq "cons" && $apostyes eq "no") {
$part2 = "vow";
&getpart2;
$part3 = "con";
&getpart3;
$part4 = "vow";
&getpart4;
$suftype="con";
&do_suffix;
$name = "$prefix$wordpart2$wordpart3$wordpart4$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "5 A";
}
if ($wordparts eq "5" && $cvchoice eq "cons" && $apostyes eq "yes") {
$pre2choice = "cons";
&do_2ndprefix;
$part2 = "vow";
&getpart2;
$part3 = "con";
$part4 = "vow";
&getpart4;
$suftype="con";
&do_suffix;
$name = "$prefix$wordpart2'$prefix2$wordpart4$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "5 C";
}
if ($wordparts eq "5" && $cvchoice eq "vows" && $apostyes eq "no") {
$part2 = "con";
&getpart2;
$part3 = "vow";
&getpart3;
$part4 = "con";
&getpart4;
$suftype="vow";
&do_suffix;
$name = "$prefix$wordpart2$wordpart3$wordpart4$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "5 B";
}
if ($wordparts eq "5" && $cvchoice eq "vows" && $apostyes eq "yes") {
$pre2choice = "vows";
&do_2ndprefix;
$part2 = "con";
&getpart2;
$part3 = "vow";
$part4 = "con";
&getpart4;
$suftype="vow";
&do_suffix;
$name = "$prefix$wordpart2$prefix2$wordpart4$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "5 B";
}
if ($wordparts eq "6" && $cvchoice eq "cons" && $apostyes eq "no") {
$part2 = "vow";
&getpart2;
$part3 = "con";
&getpart3;
$part4 = "vow";
&getpart4;
$part5 = "con";
&getpart5;
$suftype="vow";
&do_suffix;
$name = "$prefix$wordpart2$wordpart3$wordpart4$wordpart5$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "6 A";
}
if ($wordparts eq "6" && $cvchoice eq "vows" && $apostyes eq "no") {
$part2 = "con";
&getpart2;
$part3 = "vow";
&getpart3;
$part4 = "con";
&getpart4;
$part5 = "vow";
&getpart5;
$suftype="con";
&do_suffix;
$name = "$prefix$wordpart2$wordpart3$wordpart4$wordpart5$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "6 B";
}
if ($wordparts eq "6" && $cvchoice eq "vows" && $apostyes eq "yes") {
$pre2choice = "vows";
&do_2ndprefix;
$part2 = "con";
&getpart2;
$part3 = "vow";
&getpart3;
$part4 = "con";
&getpart4;
$part5 = "vow";
&getpart5;
$suftype="con";
&do_suffix;
$name = "$prefix$wordpart2$wordpart3'$prefix2$wordpart4$wordpart5$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "6 C";
}
if ($wordparts eq "6" && $cvchoice eq "cons" && $apostyes eq "yes") {
$pre2choice = "cons";
&do_2ndprefix;
$part2 = "vow";
&getpart2;
$part3 = "con";
&getpart3;
$part4 = "vow";
&getpart4;
$part5 = "con";
&getpart5;
$suftype="vow";
&do_suffix;
$name = "$prefix$wordpart2'$prefix2$wordpart4$wordpart5$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
$rulematch = "6 D";
}
}
sub BuildWeb {
print "Content-type: text/html\n\n";
print<<EndHTML;
<html>
<head>
<title>aXis of Time Name GeneratorX-NG v2.0</title>
<style type="text/css">
body{
background-color : #efefef;
font-family : Verdana, Arial, Helvetica, sans-serif;
font-size : 12px;
color: #363636;
}
hr {
color: #999999;
height: 2px;
width: 400px;
}
</style>
</head>
<body bgcolor=white text=black>
<font class=option><b>aXis of Time Name Generator </b> - (X-NG v2.0)</font>
<p>The X-NG engine works from random sets of vowel and consonant
sounds. Due to the nature of the beast, it will return lots
of words that are plain useless. Keep clicking and you'll find
a gem eventually. It may take a few minutes, but if your brain
worked better than X-NG, you'd be using it instead.</p>
<br><hr><br><br><br><br>
<p align="center"><font size="5"><b>Name:</b> $name</font></p>
<p align="center">
<form action="x-ng.pl" METHOD="Post">
<b>
<INPUT TYPE="submit" VALUE="Create Name">
</form></b>
<br><br><br><br>
<hr height="1" width="60%">
<br></p>
<p align="center"><font size="2">X-NG is © 2003 Axis of Time MUD</p>
<hr height="1" width="60%">
EndHTML
}
sub do_output {
if ($htmlstatus eq "1") {
&BuildWeb;
}
else
{
&check_verbose;
}
}
sub check_verbose {
if ($verbose_name eq "1") {
&do_verbose_output_name;
}
else
{
print "Name: $name\n";
}
if ($verbose_prefix eq 1) {
&do_verbose_output_prefix;
}
if ($verbose_suffix eq 1) {
&do_verbose_output_suffix;
}
}
sub do_verbose_output_name {
print "[__________ X-NG 2.0 Output__________]\n\n";
print "Name: $name\n\n";
print "[ Name Data ]\n";
print "Wholename: $name\n";
print "CVTest: $cvchoice\n";
print "Wordparts: $wordparts\n";
print "Apostrophe decision: $apostyes\n";
# print "Prefix File used: $begin.txt\n";
print "Prefix chosen: $prefix\n";
print "Rule Matched: $rulematch\n";
if ($prefix2 ne "") {
print "Second prefix chosen: $prefix2\n";
}
if ($wordpart2 ne "") {
print "Part 2: $wordpart2 \| \[$part2\]\n";
}
if ($wordpart3 ne "") {
print "Part 3: $wordpart3 \| \[$part3\] \n";
}
if ($wordpart4 ne "") {
print "Part 4: $wordpart4 \| \[$part4\]\n";
}
if ($wordpart5 ne "") {
print "Part 5: $wordpart5 \| \[$part5\]\n";
}
print "Suffix chosen: $suffix\n";
}
sub do_verbose_output_prefix {
print "[ Prefix Data ] \n";
print "Cons/Vow Choice: $cvchoice\n";
print "Prenum: $prenum\n";
print "Prefix: $prefix\n";
print "Prefix Filename/path: $dirprefix/$begin.txt\n";
print "Prefix file contents:\n @pre\n";
print "\n";
}
sub do_verbose_output_suffix {
print "[ Suffix Data ]\n";
print "Suffix Type: $suftype\n";
print "Suffix File: $suftype.txt\n";
print "Suffix Chosen: $suffix\n";
print "\n";
}
#if ($form['$function'] eq "") {
#$function = "create";
# }
# else
# {
#if ($form['$function'] eq "create") {
# $function eq "create";
# }
# else
# {
#if ($form['$function'] eq "scramble" {
# $function eq "scramble"
# }
#if ($function eq "create") {
&do_apostcheck;
&do_wordparts;
&do_prefix;
&do_rulecheck;
&do_output;
#}
#if ($function eq "scramble") {
# Name Scrambling routines
sub checkrule {
@ruleset = ("1","2","3","4","5");
$numruleset = rand(@ruleset);
$rule = "$ruleset[$numruleset]";
}
sub scramblerules {
if ($rule eq "1") {
$name = "$prefix$wordpart2'$prefix2$wordpart4$wordpart5$suffix";
$name =~ s/\n//g;
$name =~ s/ //g;
}
}