#!/usr/bin/perl ####################################################################### # # WordSynth - Randomly generate words from a language rules file # # Copyright (C) 2000 Ken St-Cyr # # This program is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the # Free Software Foundation; either version 2 of the License, or (at your # option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 675 Mass Ave, Cambridge, MA 02139, USA. # # # Version 1.3 # ####################################################################### use Getopt::Std; %tableExec = ( 'syllableStressPatterns' => \&parse_std_table, 'initialSyllables' => \&parse_std_table, 'internalSyllables' => \&parse_std_table, 'terminalSyllables' => \&parse_std_table, 'assimilationFilters' => \&parse_pair_table, 'wordInitialConsonants' => \&parse_std_table, 'wordInitialVowels' => \&parse_std_table, 'internalInitialConsonants' => \&parse_std_table, 'internalStressedVowels' => \&parse_std_table, 'internalUnstressedVowels' => \&parse_std_table, 'internalFinalConsonants' => \&parse_std_table, 'wordFinalVowels' => \&parse_std_table, 'wordFinalConsonants' => \&parse_std_table, ); %indexByLetter = ( 'C' => 'wordInitialConsonants', 'c' => 'internalInitialConsonants', 'A' => 'wordInitialVowels', 'a' => 'wordFinalVowels', 'V' => 'internalStressedVowels', 'v' => 'internalUnstressedVowels', 'k' => 'internalFinalConsonants', 'K' => 'wordFinalConsonants', ); ######################################################################## # language file parse routines # The table parsing functions return hash references to data loaded # from a single table read from the language file. # parse_std_table: # The std_table is an element,weight pair; the weights are totalled by # this function # sub parse_std_table { my %tmphash = (); my $hashref = $tmphash; my $totalweight = 0; while () { chomp; next if /^\s*(#|$)/; # skip comments and newlines last if /END/; # done reading this table ($tmpvalue, $tmpkey) = split /,/, $_; next if ($tmpkey eq ""); # skip if key has no value $totalweight += $tmpkey; $hashref->{$totalweight} = $tmpvalue; } return $hashref; } # parse_pair_table: # The pair_table is a pair of elements; no weights are totalled # sub parse_pair_table { my %tmphash = (); my $hashref = $tmphash; my $tmpkey = 0; while () { chomp; next if /^\s*(#|$)/; # skip comments and newlines last if /END/; # done reading this table ($tmpval1, $tmpval2) = split /,/, $_; # use tmpkey to maintain order of list $hashref->{$tmpkey} = [ $tmpval1, $tmpval2 ]; ++$tmpkey; } return $hashref; } # read_language_file: # Open the language rules file for reading, find the start of each # table specification, then call the appropriate parsing function # sub read_language_file { my $filename = shift; my $type = ""; open INF, "$filename" or die "Can't open input file"; while () { # get TYPE, later use this to determine which variable holds hash chomp; if (/TYPE/) { ($junk, $type) = split; # set value of appropriate hash table if ($tableExec{$type}) { $tableRefs{$type} = &{$tableExec{$type}}; } } } close(INF); } ####################################################################### # utility subroutines ### # consult_table (name of table) # tests each key against die roll, returning the first key # that is lower than the threshold sub consult_table { my $table = shift; my @keylist = (sort { $a <=> $b } keys(%{$tableRefs{$table}})); my $threshold = 0; my $index = 0; # randomly generate a lookup index my $lookup = int (rand($keylist[-1]) + 1); # sort weights from lowest to highest # then return entry corresponding to dieroll foreach $threshold (@keylist) { if ($lookup <= $threshold) { $index = $threshold; last; } } return ($tableRefs{$table}->{$index}); } ####################################################################### # word building routines ### # build_syllable(list-of-letter-types) # builds a syllable by letter-types # e.g., build_syllable('C','V','K') # returns a randomly generated syllable in which # the first character will be an initial stressed # consonant, the second a stressed vowel, and the # third a word final consonant # sub build_syllable { my $stress = shift; my @letterList = @_; my $syllable = ""; my $ltridx = ""; foreach $ltridx (@letterList) { if ($stress eq 'H') { $ltridx =~ s/v/V/; } else { $ltridx =~ s/V/v/; } $syllable .= consult_table($indexByLetter{$ltridx}); } return $syllable; } sub filter_word { my $word = shift; my @rexlist = sort { $a <=> $b } keys(%{$tableRefs{'assimilationFilters'}}); foreach $idx (@rexlist) { $rex = ${$tableRefs{'assimilationFilters'}->{$idx}}[0]; $nrex = ${$tableRefs{'assimilationFilters'}->{$idx}}[1]; $word =~ s/$rex/$nrex/g; } return $word; } sub build_word { my $word = ""; my $stress = 'H'; # future work: make syllableStressPatterns table also the # syllableStress table, using L and H to represent low and high # stress syllables. A single syllable word might be simply 'H', but # a three syllable word could be LHL, LHH, HLH, LLL, etc. # @syllableStress = split //, consult_table('syllableStressPatterns'); $numSyllables = scalar @syllableStress; if ($numSyllables == 1) { @myletterlist = consult_table('terminalSyllables'); $word = build_syllable($syllableStress[0], split //, consult_table('terminalSyllables')); } elsif ($numSyllables == 2) { $word = build_syllable($syllableStress[0], split //, consult_table('initialSyllables')); $word = $word . build_syllable($syllableStress[1], split //, consult_table('terminalSyllables')); } else { $word = build_syllable($syllableStress[0], split //, consult_table('initialSyllables')); for ($ns = 1; $ns < $numSyllables - 1; $ns++) { $word = $word . build_syllable($syllableStress[$ns], split //, consult_table('internalSyllables')); } $word = $word . build_syllable($syllableStress[$ns], split //, consult_table('terminalSyllables')); } $word = filter_word($word); return $word; } ######################################################################## # application start ### sub usage { print < -N number of words to print EOT exit 1; } sub parse_args { if ($#ARGV < 0) { usage() } getopts('N:h'); if (defined $opt_h) { usage() } $NUMBER_OF_WORDS = defined $opt_N ? $opt_N : 1; $LANGUAGE_FILE = $ARGV[0]; } sub mainApp { parse_args(); srand (time() ^ ($$ + ($$ << 15))); read_language_file($LANGUAGE_FILE); for ($qty = 0; $qty < $NUMBER_OF_WORDS; $qty++) { print build_word(), "\n"; } } ### mainApp();