| What: | generator - Gaming Generators in Tcl |
| Description: | A program for generating text description and sound-alike wordlists given syntactical or examplary input. A technique for Procedural Generation. |
Many people are familiar with MadLibs [L1 ] which generate funny stories given set syntactical elements such as "insulting adjective" or "odd activity". These are actually a subset of much more powerful Generators of the type that are useful in Gaming -- both pencil and paper [L2 ] and in computers with Procedural Generation Wiki[L3 ] and Procedural Generation[L4 ].
Tcl is ideally suited to this as it is essentially a macro language designed for text substitution. Unfortunately, Tcl has built-in recursion limitsinterp recursionlimit which you need to adjust or use a Non-Recursive Interpreter Engine NRE to circumvent. Because of this, I actually implemented a little language to do the job with a non-recursive engine in Tcl. I also combined this with the Markov Chains from Create words from a text file (list) to generate sound-alike words for names and the like. The resulting system is very useful.
Essentially, you define a series of tables, where each table has a list of potential replacements chosen at random, each of which may include references to the same or another table.
table first second third
result { {Use the <table> table.>} }This is two tables, the second of which has only one choice (hence the double brackets -- anything with embedded spaces will need brackets). Evaluating: <result> might give you: "Use the third table." Another evaluation might give the same, or one of the alternatives.
This in itself is not so interesting, the fun part comes in when you start combining productions and nesting tables very deeply. Here is an insult generator written using this same system:
insultadj {
aberrant abhorrent abject abnormal abominable abrupt absurd abusive acerebral addled
addlepated afflictive agelastic aggressive agonizing airheaded anarcho-syndicalist
anchronistic angry annoying antiquated apish appalling arrogant artless assinine
atrocious audacious avaricious awful babbling back-biting back-handed back-stabbing
backward bald baleful balmy banal baneful barbaric barbarous barmy barnacled base
base-court bat-fowling batty bawdy beastly bedevilled beef-brained beef-witted
beer-swilling beetle-headed beetleheaded befooled beggerly beguiled belligerent
belly-aching benighted beslubbering besotted bestial bewildered bilgey bilious bitter
black black-hearted blameable blameworthy blaspheming blasted bleak blear-eyed
blear-witted bleeding blinkered blistered blithering block blockheaded blockish
bloodthirsty bloody-minded blundering boastful Boeotian boil-brained boneheaded
boorish bootlegging bootless boring born bottom-of-the-barrel bovine bragging
brainless brazen bribable brutal brutalized brutalizing brute brutish buffoonish
bullying bumptious bullheaded burdensome cage-rattling calculating calumnious
cankerous cannibalistic cantankerous capricious careless catty cave-crawling
cave-dwelling charmless cheap cheating cheeky cheesy chicken-hearted chuckleheaded
chumpish churlish clabber-brained clammy clapper-clawed clay-brained clod cloddish
close-minded clot clouted cluck clumsy coarse cockamamie cockered cockeyed cocky
cold common-kissing conceited congenital conniving contemptible contemptuous contrary
contumelious corrupt cotton-picking couthless cowardly cowish crafty crass craven
crawling crazy credulous creeping creepy cretinous criminal critical crook-pated crude
cruel crummy crying cuckoo culpable cunning currish cursed cusswocomplaining cynical
daffy daft damnable damned dankish dark dazed deadbeat debased debauched deceitful
decrepit defaulting defective deficient degraded degrading deleterious delinquent
demoniacal demonic dense deplorable depraved depressing derelict derisive derogatory
desolate desperate despicable detestable deviant devilish devoid diabolical dilapidated
dim dim-witted dimwit dimwitted dingbat dingy dire dirty dirty-rotten disappointing
discontented discreditable discredited disgraceful disgusting dishonest disloyal dismal
dismal-dreaming disobliging disparaging displeasing disreputable dissembling distasteful
distressing dizzy dizzy-eyed dodgy doghearted dogmatic dolt doltish donkey dope dopey
dorky doting dozy drab draconian dread-bolted dreadful dreary droning drooling drunken
dubious dull dull-witted dullard dullhead dumb dumbbell dummkopf dummy dunce duncical
duncish dunderheaded dweebish dysfunctional earth-vexing egg-sucking egregious
elf-skinned empty-headed erinaceous errant erratic eructating evil evil-smelling
exasperating excessive excoriating excruciating execrable exhausting expendable
false fat fat-kidneyed fatheaded fatuitous fatuous fault-finding fawning fear-mongering
feckless feculent feeble feeble-minded fell felonious fen-sucked feral ferine ferocious
festering fetid fickle fiendish fifth-rate filthy fishy flagitious flagrant flakey
flaky flap-mouthed flat-beer-drinking flat-lined flea-bitten flea-ridden flint-chipping
fly-bitten fobbing folly-fallen fool-born foolhardy foolheaded foolish forgetful
forgettable forlorn forward foul foul-tongued fourth-rate freakish freaky
french-blabbing frightening frightful frivolous frothy frog-eating froward frustrated
fuddled full-gorged fuming futile gaga geeky genocidal ghastly gimlet-eyed glaring
gleeking glib gnawing goatish goblinoid god-cursed golem good-for-nothing goofy goosey
gorbellied gormless gossiping gowk greedy grevous grim griping grisly gross grotesque
grotty grovelling grudging gruesome grumpy guff-spewing gulled gutless guts-gripin
hadean half-assed half-baked half-faced half-wit half-witted halitotic hard harebrained
harmful harrowing harsh hasty-witted hateful heartless hedge-born heinous hell-hated
hellish heretical hideous high-maintenance ho-hum honeyfugling horrendous horrible
horrid horrific horrifying hubristic humdrum humiliating hurtful hyperbolic hypocritical
icky idiot idiotic idle-headed ignoble ignominious ignoramus ignorant ill-advised
ill-bred ill-humored ill-informed ill-nurtured illegal illegitimate illiterate imbecile
imbecilic immature immoral impertinent impotent improbable improper impudent impure
inaccurate inane inaniloquent inappropriate inarticulate inauspicious incapable
incompetent incomprehensible inconceivable incorrect incorrigible incredible indecorous
indefensible indiscreet indolent ineducable ineffectual inept inexcusable inexpressable
infamous infantile infatuated infectious inferior infernal inglorious inhospitable
inhuman inhumane iniquitous initiativeless insalubrious insane insensate insensitive
insignificant insincere insipid insolent insufferable insulting intolerable intolerant
irrational irrelevant irresponsible jarring jealous jejune jerky jobbernowl judgemental
juggins jumped-up kleptomaniacal klutzy knavish knee-knocking knockkneed knotty-pated
knuckle-dragging kooky lackwit lame lamebrain lamentable laughable lazy learing
left-handed leprous libelous lickspittle lightweight lily-livered listless loathsome
loggerheaded looby loon loony lousy low low-born low-down ludicrous lugubrious
lumbering lumpen lumpish lurid lying macabre mad malarious maleficent malevolent
malicious malign malignant malingering maloderous mammering mangled mangy manipulative
manky maudlin mean measily megalomaniacal mendacious mephitic merciless mewling
microcephalic mildewed milk-livered mindless misbegotten miserable miserly misogynistic
misshapen mollycoddled mongoloid monotonous monstrous morbid moribund moron moronic
motley motley-minded mouldering mundane murderous mutinous naffy namby-pamby narcoleptic
nasty nattering natural natural-born naughty nauseating nefarious neglectful negligent
niais nincompoop ninny ninnyhammer nit-picking nitwit no-account no-good noddy noisome
nonsensical notorious nugatory numskulled nutty oafish obnoxious obscene obstreperous
obtrusive obtuse odious off-base off-color off-putting offensive onerous onion-eyed
opaque opprobrious orcish outrageous over-bearing over-weening painful paltry paranoid
paroxysmal pasty-faced pathetic paunchy peccant perverted pestilential petty
petty-fogging petulant philistine piercing pinhead piratical pishy pitiable pitiful pitiless
plume-plucked plundering pokey poor porcine possessed pottle-deep powerless pox-marked
poxy predictable preposterous presuming presumptuous pretentious prevaricating pribbling
prickly prideful primitive procrastinating profane prosaic proud puerile puking puling
pungent puny pushy pusillanimous pustulent putrid quailing racking rambunctious rancid
rancorous rank ranting ratty recreant reeky reeling-ripe regrettable renownless
repetitive reprehensible reproachful reprobate reptilian repugnant repulsive resentful
retarded revolting ridiculous risible rock-headed roguish rotten rough rough-hewn rude
rude-growing rummy ruthless ruttish sacrilegious sad sadistic sappy satanic saucy savage
scabby scabrous scandal-mongering scandalous scatterbrained scheming schlocky scrawny
screwy scrubby scruffy scummy scurrile scurrilous scurvy second-rate self-absorbed
selfish senseless sentimental septic severe sewer-crawling shabby shallow shameful
shameless shard-borne sharkish sheep-biting shiftless shifty shocking shoddy sickening
silly simp simple simpleton simplistic sinful sinister skanky slack-jawed slandering
slavering slimey slinking slobbering slothful slovenly slow slow-witted sluggish slum-
born sly small smirking smutty sneaking snearing snooty snotty snotty-faced soiled
sophomoric sordid sorry sottish spasmatic spineless spivy spleeny spoiled spongy spotty
spur-gall spurious squalid squandering stabbing sticky-fingered stinging stingy stinking
stolid stoney strange stubborn stumbling stupid subhuman subnormal sun-burned
superficial surly swabby swag-bellied sweaty swindling swinish syphilitic tacitern
tardy-gaited tarnished tasteless tedious terrible testudineous thick thick-skulled
thick-witted thickheaded thickwit thieving third-rate thoughtless tickle-brained timid
tiresome toad-spotted tormenting torpid tortuous tottering toxic tragic traitorous
treacherous trouble-making truculent twerpy two-faced two-timing ugly ump-fed
unappreciative unbearable unbelievable unchristian uncivilized unclean uncomely
unconvincing uncouth underhanded undue unenlightened unfit unfitting unfocused
unforgivable unforgiving ungentle ungrateful unimaginative uninspired unintelligent
uninteresting unjust unkempt unlawful unlikely unmentionable unmuzzled unpardonable
unpleasant unprincipled unrealistic unreasonable unreliable unrighteous unruly
unsanitary unsavoury unscrupulous unseemly unsound unspeakable unsuitable untamed
unteachable unthinking untrustworthy unvirtuous unwarranted unworthy uppish uppity
urchin-snouted uremic useless vacuous vain vainglorious vapid varicose venal venomed
venomous vicious vile villainous vindictive violent virtueless vitriolic vituperative
vomitous vulgar vulpine wacky warped wasteful wayward weak-minded weather-bitten weedy
weeping weevil-crunching weird wet whining whore-mongering wicked widdiful wild wimpish
witless witling wobbly woeful woggish wolfish worm-eaten worst worthless wretched wrong
wrongful wrongheaded yeasty yellow-bellied zany
}
insultnoun {
addlepate affliction airhead anarcho-syndicalist apple-john back-stabber baggage
bane barnacle barbarian beatnik biddy bimbo bird-brain bladder blatherskite blockhead
boar-pig bollock bonehead boob boor bounder bow-wow braggart broad brute budgerigar
buffoon bugbear bully bum-bailey bungler bushwhacker cad canine canker-blossom
castigating caveman chicken clack-dish clod clotpole clown cockalorum cockroach codpiece
conman cow coxcomb creep cretin cur curmudgeon deadbeat death-token deck-ape derelict
dewberry dickwad dimwit dingbat dodger dog dolt doorknob dope dork dowdy dullard
dumbbell dummy dunce dweeb filly flake flap-dragon flax-wench flirt-gill floozy fool
foot-licker freak fruitcake frump fuss-budget fustilarian gallows-bait gasbag geek
geezer giglet git goblin goldbrick goof goose goth gourd gudgeon gutter-snipe gyp gypsy
haggard halfwit hamster harlot harpy harridan headache heathen hedge-pig heifer hen hick
hind hippy hobbledehoy hobgoblin hockey-puck hog hooker horn-beast hornswoggler horror
hugger-mugger hussy hysteromaniac idiot idler ignoramus ignorer imbecile insect
jackanape jade jellyfish jenny jerk jerkface jezebel jobbernowl Joe jolthead klutz
knuckle-dragger kook lamebrain lap lewdster lickspittle litterbug lollygagger loon
loser loudmouth louse lout lunatic madman maggot maggot-pie maladroit malapert
malingerer malkin malt-worm mammet mare measle meathead milksop milquetoast minnow minx
miscreant moldwarp mollusk monkey-masher mooch mook moron muggle mumble-news nanny
ne'er-do-well neanderthal nerd nincompoop nitwit novice nut nut-hook nutter omadhaun orc
pagan pansy pantywaist peahen parrot peasant pedestrian pervert petty-fogger phlegmball
pickup pig pigeon-egg pignut piker Philistine plebe plebian poltroon pooch popinjay
poser prat primate procrastinator psycho pumpion pup puppy pustule puttock putz
Quasimodo quisling ragamuffin rat rat-bag ratsbane reprobate reptile rotter rubbernecker
saliva-breath saucebox savage scallway scarecrow schlemiel schlep schlimazzel schlump
schnook scollywop scoundrel scrub scum scut she-bear she-goat shih-tzu shirker shlep
shmuck showboat shyster sicko simian simpleton skainsmate skinflint slacker slangwanger
slattern slob sloppy sloven slubberdegullion slut smart-ass snake snake-in-the-grass
snip snollygoster sow squash street-rat streetwalker strumpet stumblebum swine tart
toady traipse tramp trife troglodyte troll trollop trull turd-burgler twerp twit
ultracrepidarian vamp vandal varlet vassal visigoth vixen waffleboy wagtail wanker wart
weaselboy weenie weevil weirdo wench whelp whey-face whore whoreson wimp wisenheimer wog
woman wuss yahoo yob yokel zero {ambulance chaser} {banana biter} {beaver bugger}
{bottle cap} {broccoli banger} {brood mare} {candidate for retroactive birth control}
{carpet crawler} {chicken chomper} {chowder head} {clod hopper} {cob gobbler} {crumb
cruncher} {dip stick} {dodgy duck} {fraidy cat} {frog feeler} {gizzard grinder} {guinea
fowl} {guinea hen} {hay baler} {heap of parrot droppings} {hog caller} {horn honker}
{kennel keeper} {lint licker} {mental case} {mental defective} {monkey moocher} {mouth
breather} {muckraking mallard} {mush-for-brains} {nanny goat} {nerf herder} {offspring
of a dog} {pork chop} {pus bucket} {rug rat} {sleeze bag} {snooty poot} {snot snooter}
{steaming pile of droppings} {trouble-maker} {turkey taster} {walking belly-cramp}
{weiner waster} {yeasty codpiece}
}
comment -x {
#10<{}>
{...you, AND the horse you rode in on}
{...you, and ANYBODY who LOOKS LIKE you}
{, <simpleinsult>! <insultadj>, <insultadj>, <simpleinsult>}
{, and the offspring of <!a-or-an <simpleinsult>>}
{- you're the GOLD STANDARD for it}
{, and your MOTHER's ANOTHER one!}
{, I hope your <insultadj>, <insultadj> DOG dies}
{, you, AND your WHOLE GRADUATING CLASS}
}
simpleinsult {
#3<{<insultadj> <insultnoun>}>
{<insultnoun>}
{<insultadj>, <insultadj> <insultnoun>}
}
insult {
#10<{YOU are <!a-or-an <simpleinsult>><comment>!}>
{Your MOTHER is <!a-or-an <simpleinsult>>!}
}This gem spits out insults such as:
YOU are a gimlet-eyed, awful pignut, and your MOTHER's ANOTHER one!! YOU are a filthy jobbernowl...you, AND the horse you rode in on! YOU are an evil-smelling petty-fogger, and the offspring of a cockeyed turd-burgler! YOU are a spur-gall braggart! YOU are a barmy fraidy cat- you're the GOLD STANDARD for it! YOU are a stabbing wagtail, I hope your venomous, dazed DOG dies! YOU are an exasperating knuckle-dragger, you, AND your WHOLE GRADUATING CLASS! YOU are a cuckoo peahen! YOU are a venomed, traitorous candidate for retroactive birth control! YOU are a shlep!
With a large vocabulary and several different productions available, it actually generates quite a wide selection of insults.
To use this thing you need generate.tcl (listed below), the above specification (in Insult.txt) and a program that will produce and use the output.
source generate.tcl initgen demo desc "Insult.txt"
This creates generator "demo" from "Insult.txt" -- a desc"ription" generator. To get an insult, you evaluate:
demo gen <insult>
Notice the object-orientedness here. Once initialized, the generator becomes self-contained and accessed by name using a normal ensemble command. You can ask for any production by naming the table in <...> to evaluate it.
In the event that you would like to be able to repeat a sequence (to reconstruct a description, say) you can use a "tape".
demo record demo gen <insult> set history [demo gettape] demo loadtape $history demo reset demo playback demo gen <insult>
...should produce the same result as the first run. At least, if there are no bugs. The insult generator does this to avoid using the same comment in one run.
There are two types of table, the normal, inexhaustable table that may return anything, or an exhaustable table that will not repeat itself until it runs out of options and resets. You specify which a table is using the "-x" switch as the first table entry.
You can tune the probability of a given result in a table by repeating it. If you have two entries and you want one of them to be chosen 90% of the time:
table {
#9<{choose me}>
{or choose me}
}Is equivalent to:
table {
{choose me}
{choose me}
{choose me}
{choose me}
{choose me}
{choose me}
{choose me}
{choose me}
{choose me}
{or choose me}
}So you get {choose me} nine times - on average - for every time you get {or choose me}.
If your generator uses another generator, you can include it with "uses":
uses RacialEpithet.txt JobRelatedInsults.txt
This loads all the tables in the listed files into the generator being built. If there are naming clashes - both of the uses files containing a table named ReallyNasty, for example, they will be combined into a single table capable of returning anything from either table.
The word generator swiped wholesale from Create words from a text file (list) takes in input list of words that sound similar to the kind of word you want. For example:
Elfish-f.txt
Aelrue Aelynthi Aerilaya Ahrendue Ahskahala Alaglossa Alais Alavara Alea Alerathla Allannia Allisa Alloralla Allynna Almithara Alvaerele Alyndra Amara Amaranthae Amkissra Amlaruil Amnestria Amra Anarzee Aneirin Anhaern Ara Araushnee Aravae Arcaena Arielimnda Arlayna Arnarra Artin Auluua Aurae Ava Axilya Azariah Blythswana Bonnalurie Braerindra Caerthynna Calarel Chaenath Chalsarda Chandrelle Chasianna Chomylla Cilivren Ciyradyl Claire Daratrine Darshee Dasyra Dathlue Delimbiyra Delshandra Deularla Duilya Eallyrl Ecaeris Edraele Elanalue Elanil Elasha Elenaril Eletha Ellarian Eloen Elora Eshenesra Essaerae Esta Esyae Faunalyn Fhaertala Fieryat Filaurel Filauria Fildaerae Gaelira Gaerradh Gaylia Gemstarzah Ghilanna Glynnii Gweyr Gwynnestri Gylledha Hacathra Halaema Halanaestra Hamalitia Haramara Helartha Holone Huquethae Hycis Ialantha Ikeshia Ildilyntra Ilmadia Ilsevel Ilyrana Ilythyrra Imizael Immianthe Imra Imryll Ioelena Irhaal Isilfarrel Itiireae Itylra Jastra Jeardra Jhanandra Jhaumrithe Jhiilsraa Kavrala Kaylessa Keerla Keishara Kethryllia Keya Kythaela Laamtora Laerdya Lazziar Leilatha Liluth Llamryl Lorelei Maelyrra Maeralya Makaela Malruthiia Mariona Martainn Meira Melarue Merethyl Merialeth Meriel Merlara Mladris Mnuvae Morgwais Moryggan Muerlara Mylaela Mylaerla Myriani Naevys Nakiasha Nambra Nanthleene Naumys Nlaea Nuala Nueleth Nuovis Nushala Nylaathria Ochyllyss Phaerl Phelorna Phuingara Phyrra Quamara Raejiisa Raerauntha Rathiain Renestrae Rubrae Ryllae Saélihn Saelihn Saida Sakaala Sariandi Sarya Seirye Seldanna Selussa Shadowmoon Shalana Shalendra Shalheira Shandalar Shanyrria Sharaera Sheedra Sheera Shialaevar Shyael Sinnafain Soliania Soora Sorsasta Susklahava Sylmae Symrustar Syndra Syviis Taenya Talanashta Talila Talindra Tarasynora Teharissa Teryani Thaola Thasitalia Tiatha Tiriara Tisharu Tsarra Ulelesse Urmicca Uschymna Valindra Vashti Velatha Verrona Vestele Viansola Yaereene Yalanilue Yathlanae Ygrainne Ynshael Yrlissa Yrneha Yrthraethra Ysmyrlda Yulmanda Zoastria
Using:
initgen demo word "Elfish-f.txt"
You get a generator where calls of:
demo gen
Can produce results like:
Allorala Makaelyrra Ghilaya Arnarrel Elanna Filatha Amarantha Leila Nylaathrian Hacathlue
However, the system can be more sophisticated than this. A production <...> can include a number of different operations.
For example:
<save:=<Table>>
Will evaluate <Table> and save the result in "save". Later evaluations of <@save> will always return the saved result in "save". You can have any number of stored variables from a table. <save2:=Table> will do the same thing, thereafter <save:=Table> will give you the first result and <save2:Table> the second. This is useful to save state from productions in process to alter productions yet in the cue. In my spell ingredients table, there is <save:=critter> which will save the name of the critter which is called for first. Later on, I call: <<@critter>-bits> where I have a series of tables, fish-bits, mammal-bits, bat-bits and so on, so the system will never call for the wing of a fish or a scale of a cow.
You can access Tcl functions using "()". <()a-or-an <critter>> will return "a bat" or "an eland" according to the first letter of the critter. Any Tcl function can be accessed this way. Some other built-ins include, "nth" which will give you "First, Second, Third..." or "1st, 2nd, 3rd..." followed by "Level" or "Circle" to give you a rank. <()range 5 9> will give you a random number in the specified range. <()cap <critter>> would give you "Cow" or "Eland" instead of "cow" or "eland".
You can check strings for equality or inequality -- notice that since this is a text substitution engine, you need extra levels of <> to evaluate variables -- for example:
<<critter>==cow:moo>
Will give you "moo" if <critter> evaluates to "cow". Notice that the operator is "==" - the < and > delimit table substitutions. You can do else clauses too:
<<save:critter>==cow|moo/baa>
You will get "baa" if <critter> is NOT cow.
You can invert this operator:
<<critter>!=cow:baa/moo>
And, since I swapped the then for the else, you will still get "baa" if <critter> is NOT cow.
The notation ?? also gets the value of a variable - the @ is processed by the scanner, the ?? is an operation, but they work the same:
<save??> cow
The @-notion came later, it's easier to read and type, but ?? follows the command pattern.
As mentioned earlier, you can access another generator you have added with "uses"
Racialepithet.txt:
race Elf Human Dwarf Elf-epithet tiny points Spock Human-epithet dummy round-ear Dwarf-epithet shorty grumpy
somethingelse.txt
uses RacialEpithet.txt
racechoice {
{ You're a <species:=race>, <species??-epithet> }
}This is why I left in both ?? and @ - this will retrieve the value of "species" and then evaluate <species-epithet>, whereas <@species-epithet> will try to retrieve the value stored as species-epithet and will fail (though, as with the "critter" example above, you can get around this with an extra level of evaluation).
<racechoice> You're an Elf, Spock!
You can directly consult the dice generator with "!?"
<10?!> - random number from 0 to 9
You can replicate strings with **:
<3**foo> foofoofoo
Notice that if you try to do:
<3**<foo>> expecting to get <foo><foo><foo> you won't get it. <foo> is evaluated before the command is carried out, giving you 3 copies of one access of table "foo". There is a "delayed" evaluation option (()) <3**((foo))>
Will return ((foo))((foo))((foo)), which is then rescanned 'after' the command is evaluated, resulting <foo><foo><foo> giving you 3 'different' calls on table "foo".
You can use :: for indexing:
<3::a|b|c|d|e|f> c
You can also use the special index 1of:
<1of::a|b|c|d|e|f>
Which will give you any of the possible choices at random - this let's you build up tables dynamically.
Finally,
<50%:<something>>
will evaluate to <something> fifty percent of the time and null "" the other 50. This let's you tune percentages for generating a particular result. The insult generator uses
{<insultadj><50%:, <insultadj>> <insultnoun>}to construct the insult giving you a fifty percent chance of an insult with two adjectives rather than one.
A special table called "adjustment" can be used to post-process results. Suppose you had a pair of tables that were working okay except for a lamentable tendency to produce doubled "a"'s in certain constructed words. You can, of course, adjust the overall system to eliminate this tendency, but the nature of the product being what it is, you can also add:
adjustment {
{aa->a}
}to correct this.
The special table "init" is evaluated before any run of the generator - this allows you to reset the generator between runs or not according to whether you want to save the state or not. Some helper functions:
rmvars var1 var2 ...
This will eliminate any values stored from the previous run.
rmtables table1 ...
Will remove entire tables.
Some of the functions included for use with () are:
()a-or-an <string> # outputs "a <string>" or "an <string>" according to whether string starts with a consonant or a vowel.
()cap # capitalizes the 1st character.
()plural <str> # right now, sticks an "s" onto the str
()setcase how <str> # "how" being upcase, dncase, 1stch or proper - upcase caps the whole str, dncase downcases it, 1st caps the 1st char, proper
# downcases everything and caps the first character of each word.
()range max min # random number in given range, inclusive.
()nth num label which # randomly gives you a "num" "label" between 1 and 9 inclusive. For example <()nth 3 Circle sfx> may give you "3rd Circle".
# <()nth 3 Circle xth> will return "Third Circle". If the arguments are left off, it varies the format and number randomly,
# 1st Circle, Eighth Level, etc.
()junk whatever # throws away the arguments, replacing it with a null.Here is the actual code for the generator:
set verbose 0 set warning 1 # Use dummy will make non-existent tables return dummy1..dummy6, if you see these words in the output you are missing a # table. If warning is 1, it will tell you what tables are missing when they are accessed. set usedummy 1 set trace 0
# namespaces are used to group all the tables of one generator. You can have multiple generators # each with their own versions of tables. The procs are either given the namespace to work in, # or use the global ::curgen. To do this, two helper procs allow importing vars from the proc's # local scope and accessing the variables unique to the given namespace.
# vars takes a list of variables needed in the proc from the calling namespace. proc vars { args } {
foreach var $args {
uplevel "variable $var"
}}
# import brings into a namespace copies of variables from the surrounding scope - usually local variables # in the proc calling it. import a will bring a available from the proc executing the namespace code into # the namespace. The special form x>y allows renaming - that is, local var x is imported as y in the namespace. proc import { args } {
foreach var $args {
lassign [split $var >] left right
if {$right eq ""} {set right $left}
set temp "[uplevel uplevel set $left]"
regsub -all {\"} $temp {\"} temp
set cmd "set $right \"$temp\""
uplevel $cmd
}}
set curgen "" set stack {} proc initgen { self type file } {
lappend $::stack $::curgen
lappend ::genlist $self
set ::curgen $self
set body {
set cmd [ lindex $args 0 ]
set args [ lrange $args 1 end ]
if { $args eq "" } {
namespace eval $self $cmd
} else {
namespace eval $self $cmd {*}$args
}
}
set body "set self $self\n$body"
proc $self { args } $body
namespace eval $self {
import self>myself type>mytype file>fname
variable name $myself
variable type $mytype
variable file $fname
variable play 0
variable rec 0
variable tape {}
variable readhd 0
variable filelist {}
variable tablelist {}
proc include { fname } {
vars filelist
if {[string first "." $fname] == -1} {
set fname ${fname}.txt
}
if { [lsearch $filelist $fname] != -1 } {
lappend filelist $fname
namespace eval [namespace current] { source $fname }
}
}
proc reset { } {
vars readhd rec play tablelist save type
set readhd 0
set rec 0
set play 0
if { $type eq "word" } return
foreach thetable $tablelist {
if [info exists save($thetable)] {
set table($thetable) $save($thetable)
}
}
}
proc gettape { } {
vars tape
return $tape
}
proc loadtape { s } {
vars tape readhd rec play
set tape $s
set readhd 0
set rec 0
set play 0
}
proc showtape { } {
vars tape
puts "gen: [namespace current] tape is:\n$tape"
}
proc record { } {
vars play tape readhd rec
set play 0
set tape {}
set readhd 0
set rec 1
}
proc playback { } {
vars play
reset
set play 1
}
proc playrec { varname {norec 0} } {
vars rec tape play readhd
upvar $varname var
if { $rec && !$norec } { lappend tape $var
} elseif $play {
set recval [lindex $tape $readhd] ; incr readhd
set var $recval
if { $readhd > [ llength $tape ] } { set play 0 }
return 1
}
return 0
}
if { $type eq "desc" } {
variable used {}
variable table ; set table() {}
variable save ; set save() 0
variable memory ; set memory() 0
variable tablelist ; set tablelist {}
proc clear { varname } {
vars memory
catch {unset memory($varname)}
return ""
}
proc dice { tablename } {
vars table save
set choices {}#puts ">>>>>>>Dicing tablename $tablename"
if { [catch {set choices $table($tablename)} err ] != 0 } {
if $::warning {
puts "no such table $tablename"
if $::usedummy {
set choices { %unknown1 %unknown2 %unknown3 %unknown4 %unknown5 %unknown6 }
}
}
}#puts "choices: $choices"
set numchoices [ llength $choices ]
#puts "numchoices: $numchoices"
set index [ expr {int(rand()*$numchoices)} ]#puts "index of choice: $index"
playrec index
set value [ lindex $choices $index ]#puts ">>>>>>>Dicing returns '$value'"
if { [info exists save($tablename)]
&& ([ llength $save($tablename) ] != 0) } {#puts "table $tablename is exhaustable"
set table($tablename) [ lreplace $table($tablename) $index $index ]
if { [ llength $table($tablename) ] == 0 } {
set table($tablename) $save($tablename)
}#puts "table $tablename: $table($tablename)" #catch { puts "save $tablename: $save($tablename)" }
}
return $value
}
proc scanfunc { str delimiter } {
upvar from from ; upvar to to ; upvar replace replace
set from $to
incr from -1
set replace ""
while 1 {
set ch [ string index $str $from ]
if { $ch eq $delimiter } break
if { $from < 0 } { puts "> without < in '$replace'"; exit }
incr from -1
set replace $ch$replace
}
}
proc usegen { left right } {
if { $right eq "" } { set right pattern }
return [ $left gen <$right> ]
}
proc lookup { value } {
if {[string index $value 0] ne "@"} { return $value }
vars memory
# we can handle any number of redirections
while 1 {
if {[ set idx [string last "@" $value ] ] == -1} {
return $value
}
set pfx [string range $value 0 $idx-1]
set value [string range $value $idx+1 end]
catch { set value $memory($value) }
}
}
proc dofunc { replace cmd cmdidx } {
vars memory
set l [ string range $replace 0 $cmdidx-1 ]
set args [ string range $replace $cmdidx+2 end ]
set args [split [join $args " "] "|"]
set r [lindex $args 0]
set args [lrange $args 1 end]
set l [lookup $l ] ; set r [ lookup $r ]
switch $cmd {
:= { set memory($l) $r ; set value $r }
!! { set value [usegen $l $r]}
:: { if {$l eq "1of"} {
set args [linsert $args 0 $r]
set l [expr {(int(rand()*([llength $args])))}]
}
set value [lindex $args $l]
}
() { set value [subst \[$r\]] }
?? { set value $memory($l) }
?! { set value [ expr {int(rand()*$l)} ] }
== { set value [lindex $args 0]
if { $l eq $r } { set value [lindex $args 1] }
}
!= { set value [lindex $args 0]
if { $l ne $r } { set value [lindex $args 1] }
}
%: { set value ""
set percent [expr {(int(rand()*100))}]
playrec percent
if {$percent < $l} { set value $r }
} for {set j 0} {$j < $l} {incr j} {
set value "$value $r"
}
}
}
return $value
}
proc substitute { str } {
set passlimit 10
set oldstr ""
while 1 {
if $::trace { puts ">>> $str" }
while { [ set to [ string first > $str ] ] != -1 } {
scanfunc $str <
if $::trace { puts "===($str) from='$from' to='$to' replace='$replace'" }
set cmd ""
if { [string index $replace 0 ] == "@" } {
set str [ string replace $str $from $to [ lookup $replace ] ]
} else {
foreach sy { !! () ?? == != %: ** :: := } {
set cmdidx [ string first $sy $replace ]
if { $cmdidx != -1 } break
}
if { $cmdidx == -1 } {
if $::trace { puts "dice $replace" }
set str [ string replace $str $from $to [ dice $replace ] ]
} else {
set str [ string replace $str $from $to [ dofunc $replace $sy $cmdidx ] ]
}
}
}#puts "looping in substitute, oldstr='$oldstr' ; str='$str'"
if { $oldstr eq $str } {
if $::trace { puts "no cmd, no sub, replacing (( and ))" }
regsub -all {\(\(} $str {<} str
regsub -all {\)\)} $str {>} str
if { $oldstr eq $str } {
if $::trace { puts "<<< $str" }
return $str
}
if $::trace { puts "no change, looping" }
}
set oldstr $str
incr passlimit -1
if {$passlimit == 0} {
puts "endless substitution $str"
exit
}
}
}
proc gen { {result <pattern>} } {#puts "Starting with $result"
set result [string trim [ substitute $result ]]
#puts "Finished with $result"
vars table
set initcode ""
catch {set initcode $table(init)}
if $::verbose { puts "initcode is $initcode"}
catch { eval {*}$initcode }
if { [catch {set adjust $table(adjust)} err ] == 0 } {
set adjust [split $adjust " "]
foreach adjustment $adjust {
set oldresult $result
regsub -all -- "->" $adjustment " \$result " adjustment#puts "regsub -all -- $adjustment result"
eval regsub -all -- $adjustment result
if {$oldresult ne $result} {#puts "regsub -all -- $adjustment result"
set result [string trim [ substitute $result ]]
}
}
}
regsub -all -- {\( } $result {(} result
regsub -all -- { \)} $result {)} result
regsub -all -- "- " $result "-" result
regsub -all "_" $result "" result
regsub -all \{ $result "" result
regsub -all \} $result "" result
regsub -all { \.} $result "." result
regsub -all " +" $result " " result
return $result
}
source $file
} else {
variable new
variable line
variable startline 1
proc K {x y} {set x}
proc shuffle4 { list } {
set n [llength $list]
while {$n>0} {
set j [expr {int(rand()*$n)}]
lappend slist [lindex $list $j]
incr n -1
set temp [lindex $list $n]
set list [lreplace [K $list [set list {}]] $j $j $temp]
}
return $slist
}
proc gen { { linklength 3 } } {
vars new line
set new ""
if {[playrec new 1]} { return $new }
set startline 1
set line [shuffle4 $line]
# pick the first word on the textfile
while 1 {
set pick [lindex $line $startline+2]; set idx 0
set pos -1
# loop: word length
for {set i 1} {$i<=100} {incr i} {
# take the first [linklength] letters of the word picked
set chain [string range $pick $pos+1 $pos+$linklength]
# idx is the variable that contains the line of the current word
set idx [lsearch $line $pick]
# find another word that matches the first [linklength] letters of the word
# set pick [lsearch -start $idx+1 -inline $line *$chain*]
set pick [lsearch -inline $line *$chain*]
# save the position of the matched letters
set pos [string first $chain $pick]
# get the letters of the current word
set add [string index $pick $pos+$linklength]
if {$i==1} {set new $chain}
set new $new$add
if {$add eq ""} break
}
# if the created word is in the textfile don't print and make another one
if { ([lsearch $line $new] == -1) & ([string length $new] < 15) } {
playrec new
return $new
} else {
incr j -1; incr startline
}
}
}
set f [open $file r]
set line [split [read -nonewline $f] \n]
close $f
}
}
set $::curgen [ lindex $::stack end ]
set $::stack [ lreplace $::stack end end ]}
proc stacktrace {} {
set stack "Stack trace:\n"
for {set i 1} {$i < [info level]} {incr i} {
set lvl [info level -$i]
set pname [lindex $lvl 0]
append stack [string repeat " " $i]$pname
foreach value [lrange $lvl 1 end] arg [info args $pname] {
if {$value eq ""} {
info default $pname $arg value
}
append stack " $arg='$value'"
}
append stack \n
}
return $stack}
set files {} rename unknown prev_unknown proc unknown { tablename args } {
if $::verbose {puts "In unknown"}
if {$tablename eq "uses"} {
foreach file $args {
if {[lsearch $::files $file] == -1} {
lappend ::files $file
if $::verbose { puts ">>>Sourcing $file" }
source ${file}.txt
if $::verbose { puts "<<<Done $file" }
}
}
return
}
if {$tablename eq "\}"} { puts "unbalanced braces" }
if { [llength $args] == 1 } {
set args [ lindex $args 0 ]
} elseif { ([ lindex $args 0 ] eq "-x") && ([llength $args] == 2) } {
set args [ lindex $args 1 ]
set args [ linsert $args 0 -x ]
}
set addin {}
for {set j 0} {$j < [llength $args]} {incr j} {
set arg [lindex $args $j]
if { $arg eq "-i" } {
set addtables [lindex $args $j+1]
foreach table $addtables {
if $::verbose {puts "adding table $table to $tablename"}
lappend addin {*}[set ${::curgen}::table($table)]
}
set args [lrange $args $j+2 end]
set args [lappend $args {*}$addin]
break
}
}
namespace eval $::curgen {
vars tablelist table save
import tablename args addin
set tablelist [lsort -nocase -unique [list {*}$tablelist $tablename]]
while { [ set idx [ string first "#" $args ] ] != -1 } {
set from $idx
incr idx
set reps ""
while 1 {
set ch [ string index $args $idx]
if { [ string first $ch "0123456789" ] >= 0 } {
set reps $reps$ch
incr idx
} else {
break
}
}
set depth 1
set repeat ""
while { $depth > 0 } {
incr idx
set ch [ string index $args $idx]
if { $ch eq "<" } then { incr depth } elseif { $ch eq ">" } then { incr depth -1 }
if { $depth <= 0 } break
set repeat "$repeat$ch"
}
set to $idx
set repeatstr [ string repeat "$repeat " $reps ]
set args [ string replace $args $from $to $repeatstr ]
}
set needsave 0
if { ([set flag [lsearch $args "-x"]]) != -1 } {
set needsave 1
set args [lreplace $args $flag $flag ]
}
set oldlen 0
catch {set oldlen [llength $table($tablename)]}
set table($tablename) $args
if {$::warning && ([llength $table($tablename)] == 0) } {puts "Table $tablename is null!!!"}
if $::verbose { puts "Defining $tablename" }
if {[llength $args] == 1} {set args [join $args " "]}
set args [ string trim $args ]
set table($tablename) [lsort -nocase $table($tablename)]
if {$oldlen == [llength $table($tablename)]} {
if $::verbose { puts "$tablename is same length, probably a duplicate" }
}
set save($tablename) {}
if { $needsave } {
set save($tablename) $table($tablename)
}
if $::verbose { puts "$tablename = $table($tablename)" }
}}
proc a-or-an { args } {
set word [ lindex $args 0 ]
set args [ lrange $args 1 end ]
if {$word eq ""} { return "a-or-an null args" }
for {set j 0} {$j <= [string length $word]} {incr j} {
set 1stltr [ string index $word $j ]
if {[string first $1stltr "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"] != -1} break
}
set result ""
if { [ string first $1stltr "aeiouAEIOU" ] == -1 } {
set result "a"
} else {
set result "an"
}
set text [ join $args " " ]
return [string trim "$result $word $text" ]}
proc cap { args } {
set str [string trim [ join $args " " ]]
if { $str ne "" } {
set str [string replace $str 0 0 [string toupper [string index $str 0]]]
}
return $str}
proc range { from to } {
set myrange [ expr { $to - $from } ]
set result [ expr {$from + (int( rand() * $myrange)) } ]
$::curgen playrec result
return $result}
proc junk { args } {
return ""
}
proc nth { { num "" } {label ""} {which ""} } {
if {$num eq "" } { set num [expr {int(rand()*10)}]}
set how { xth sfx }
if {$which eq ""} { set which [ lindex $how [ expr int(rand()*2) ] ] }
set circle { Circle Level Round Step Sphere Year }
if {$label eq ""} { set label [ lindex $circle [ expr int(rand()*4) ] ] }
set xth { First Second Third Fourth Fifth Sixth Seventh Eighth Ninth }
set sfx { st nd rd th th th th th th }
# $::curgen playrec label
# $::curgen playrec which
set prefix [lindex [set $which] [expr {$num-1}]]
if {$which eq "sfx"} {set prefix ${num}$prefix}
set result "$prefix $label"
return $result}
proc rmtables { args } {
namespace eval $::curgen {
vars tablelist table save
import args
foreach arg $args {
set tableidx [lsearch $tablelist $arg]
if {$tableidx != -1} {
set tablelist [lreplace $tablelist $tableidx $tableidx]
unset table($arg) ; unset save($arg)
}
}
}}
proc rmvars { args } {
namespace eval $::curgen {
vars memory
import args
foreach arg $args {
if [ info exists memory($arg) ] {
if $::verbose { puts "Removing var $arg" }
unset memory($arg);
}
}
}}
proc plural { args } {
return ${args}s}
proc index {{num 1} str} {
set arglist [split str "|"] return [lindex $num $arglist]
}
proc setcase { args } {
if $::verbose { puts "<<< $args" }
set type [lindex $args 0]
set args [lrange $args 1 end]
set chars [split $args ""]
if $::verbose { puts "chars: $chars" }
set idx -1
set prevch " "
foreach ch $chars {
incr idx
switch $type {
proper { if {[string first $prevch " -"] != -1} {
lset chars $idx [string toupper $ch]
}
set prevch $ch
}
upcase { lset chars $idx [string toupper $ch]; set prevch $ch }
dncase { lset chars $idx [string tolower $ch]; set prevch $ch }
1stch { lset chars 0 [string toupper $ch]; break}
}
}
set result [ join $chars "" ]
if $::verbose { puts ">>> $result" }
return $result}
proc when { exp cmd tablename args } {
if [expr $exp] {
switch $cmd {
"extend" { eval $tablename {*}$args }
"remove" {
namespace eval $::curgen {
vars table save ; import args tablename
foreach arg $args {
set idx [lsearch $table($tablename) $arg]
if {$idx != -1} {
set table($tablename) [lreplace $table($tablename) $idx $idx]
catch {set save($tablename) [lreplace $save($tablename) $idx $idx]}
} } } } } } }proc print { width args } {
set args [ join $args " " ]
while 1 {
if { $width >= [string length $args] } {
puts [string trim $args]
break
} else {
set idx $width
while { [ string index $args $idx ] ne " " } {
incr idx -1
if { $idx <= 0 } { puts [ string trim $args] ; return }
}
puts [string trim [ string range $args 0 $idx ] ]
set args [ string range $args $idx end ]
}
}}
proc do { block } {
eval uplevel $block
}
And the moronic test harness: testgen.tcl:
source generate.tcl
set dotests 2
set replay 0
foreach test $dotests {
switch $test {
1 { initgen test3 desc "Insult.txt"
if $replay { test3 record }
for { set j 0 } { $j < 10 } {incr j } { puts "[ test3 gen <insult> ]" }
if $replay {
test3 showtape
test3 playback
for { set j 0 } { $j < 10 } {incr j } { puts "[ test3 gen <insult> ]" }
}
}
2 { initgen test2 word "Elfish-f.txt"
if $replay { test2 record }
for { set j 0 } { $j < 10 } {incr j } { puts "[ test2 gen ]" }
if $replay {
test2 showtape
test2 playback
for { set j 0 } { $j < 10 } {incr j } { puts "[ test2 gen ]" }
}
}
3 { initgen test1 desc "Alchemy.txt"
if $replay { test1 record }
print 75 [ test1 gen <tostart> ]
for { set j 0 } { $j < 5 } { incr j } {print 75 [ test1 gen ] }
print 75 [ test1 gen <tofinish> ]
if $replay {
puts "--------------------------------"
test1 showtape
test1 playback
print 75 [ test1 gen <tostart> ]
for { set j 0 } { $j < 5 } { incr j } {print 75 [ test1 gen ] }
print 75 [ test1 gen <tofinish> ]
}
}
4 { initgen test4 desc "Pets.txt"
if $replay { test4 record }
for {set j 0} {$j <10} {incr j} {puts "$j [ test4 gen <pet> ]"}
if $replay {
puts "--------------------------------"
test4 showtape
test4 playback
for {set j 0} {$j <10} {incr j} {puts [ test4 gen <pet> ]}
}
}
5 { initgen test5 desc "Colors.txt"
if $replay { test5 record }
for {set j 0} {$j <10} {incr j} {puts [ test5 gen <color> ]}
if $replay {
puts "--------------------------------"
test5 showtape
test5 playback
for {set j 0} {$j <10} {incr j} {puts [ test5 gen <color> ]}
}
}
6 { initgen test6 desc "Dragon.txt"
if $replay { test6 record }
for {set j 0} {$j <10} {incr j} {puts [ test6 gen ]}
if $replay {
puts "--------------------------------"
test6 showtape
test6 playback
for {set j 0} {$j <10} {incr j} {puts [ test6 gen ]}
}
}
7 { initgen test7 desc "AcademicDisciplines.txt"
if $replay { test7 record }
for {set j 0} {$j <10} {incr j} {puts [ test7 gen ]}
if $replay {
puts "--------------------------------"
test7 showtape
test7 playback
for {set j 0} {$j <10} {incr j} {puts [ test7 gen ]}
}
}
8 { initgen test8 desc "RadPartField.txt"
for {set j 0} {$j < 4} {incr j} {puts [ test8 gen <radiation> ]}
for {set j 0} {$j < 4} {incr j} {puts [ test8 gen <particle> ]}
for {set j 0} {$j < 4} {incr j} {puts [ test8 gen <field> ]}
for {set j 0} {$j < 4} {incr j} {puts [ test8 gen <material> ]}
}
}
}