|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 [http://en.wikipedia.org/wiki/Mad_Libs] 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 [http://www.seventhsanctum.com/] and in computers with Procedural Generation Wiki[http://pcg.wikidot.com/] and Procedural Generation[http://en.wikipedia.org/wiki/Procedural_generation].

Tcl is ideally suited to this as it is essentially a macro language designed for text substitution. Unfortunately, Tcl has built-in recursion limits[ interp 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.

For those fans of Dr. Smith from Lost In Space, I give you, the Dr. Smith "Spare Me" Generator:

  spareme  {
    {Spare me your <<l:=<letter>>-adj><75%:, <<@l>-adj>> <<@l>-noun>! }
  }

  letter  a b c ch d e f g h i j k l m n o p q r s sh t th u v w y z

  a-adj -x {
    aberrent absurd accusing acrid addictive addlepated agonized alarming alienated amoral annoying arrogant asinine atypical automated awful
  }

  a-noun  {
    abortions actions activities ad-libs adjudications advice alerts allegations allusions amateurisms assassin {attempts at humor} axioms
  }

  b-adj -x {
    babbling backbiting backhanded baffling banal barbarous barbed barmy becursed bereft bitter blabbering blameful blathering blithering bloated bogus bullying bumbling
  }

  b-noun  {
    balderdash barbs bastions bedlam befallen beguiled bequests betrayals bias {bird-brained bitching} bitching blatherings bleats boobyisms botchers bumpkinisms
  }

  c-adj -x {
    cackling cagey calamitous callous cankered cantankerous captive captured carping catatonic caustic clashing cleaving clenching cliche climbing clobbering clumsy confused cumbersome
  }

  c-noun  {
    cacophony cajolery caretakering carnage casualty-lists catarwauling causes claims claptrap clashes clodhoppers comments {comment collections} concoctions conundrums cowardice creations {cuckoo commentary} 
  }

  ch-adj -x {
    chaffing chained chancy charnel chary chastening chattering cheap cheesy chiding childish chilling chilly chintzy choking churlish
  }

  ch-noun  {
    {chaped chappy} charnels chattering chatty-cathy cheese-chomper chestnut {chicken chewer} chillbilly chinwagger chowderhead chucklehead chump
  }

  d-adj -x {
    darkening deadly deafening decaying defective deplorable derelict detached detaining dire direful discordant disreputable dusruptive drifting dull dunderheaded
  }

  d-noun  {
    dabbling dallying decoctions dementia detection defaults defects deficits deformations delays depravements din discord dodderings doubts dramatics duties
  }

  e-adj -x {
    eclectic egotistic egregious eldritch elitest empty endless entangling epic eroded evil excessive exhausted exploitive extorted extreme
  }

  e-noun  {
    edicts effluvia elisions emanations endorsements enlistment enthusiasm entitlements epistles evasions excesses excuses explanations
  }

  f-adj -x {
    fainting fallible faltering fancy fatal faulty feeble ferocious finnicky flabberghasting fleecing flimsy floundering foisting foolish fractious frightful fugitive phony
  }

  f-noun  {
    failures fallacies familiars fermentations fetishers filching fillibusters fixations flappings flattery flummery foibles fomentation forecasts fourflushers
  }

  g-adj -x {
    gabby galloping gangrenous ghastly ghostly giggling glacial glib gloomy goofy gormless gratuitous grievous grifting groggy grumpy
  }

  g-noun  {
    gabbling gaffers gallants gallumpers gangmembers gangsters gaspers geldings ghettoes gits gizmos grafters gratitude groaners
  }

  h-adj -x {
    habitual hackable haggard halting hapless harpy harrowing heated heavy highbrow hopeless horrific hostile huffy hulking
  }

  h-noun  {
    habitats hacking hacks handoffs harangues harbringers harkening hazards heaps heckling henchmen hilarity hoarding homilies hokum hosannas humour hysteria
  }

  i-adj -x {
    icky idealess idiotic illogical illusionary imbecile immodest immolated immunized impaired impudent impulsive impure insensitive inane insipid insulting
  }

  i-noun  {
    ideosyncracies idiocy idolizers ineptitude illegals impacts indicators infections influxes infringements initiations innuendo innuendoes
  }

  j-adj -x {
    jagging jangling janitorial jargon-jamming jaundiced jealous jejune jerking jerky jesting jilting jingoistic jinxy jughead junketing junking
  }

  j-noun  {
    jabber jailbirds jarheads jaywalkers jeering jeremiads jaw-jerking jesters jobs jockeys jokes jollying journals jumpers junctures junkyards juries
  }

  k-adj -x {
    clandestine cod-whalloping crazy kamikaze Karmic kennel-carrying kidnapped kinky kirtled kitschy kleptomaniacal klutzy kooky 
  }

  k-noun  {
    kabuki kahns keelhauling keester-kicking ken keyboarding kindnesses kindred kippers kismet {kith & kin} kludges kobolds kooks kvetching
  }

  l-adj -x {
    lallygagging lamentable lame-brained late laughable lavish lazy leaky leftwing lethal libeling Liberal listless lonesome looney lousy Luddite ludicrous lugubrious 
  }

  l-noun  {
    labors lambasting layovers lectures lecturing legalisms lessons levies liabilities librettos litigation lobbying luminism lunacy
  }

  m-adj -x {
    madding madeover magnified malignant maligned malodorous mangled manifest marauding mawkish meandering mediocre metaphorical misguided monstrous mutant mutinous <m-monkeyadj>
  }

  m-monkeyadj -x maladjusted mawkish mental mooky muck-raking mucus-munching mule-headed murdering mutated mutt 
  m-noun  {
    machinations machismo maladies malaprops malingering manacles mandates merriment moanings {<m-monkeyadj> monkeys} moralizations moralizing musings mutterings
  }

  n-adj -x {
    knackered knavish knee-knocking knob-lobbing know-it-all knuckle-dragging narcissistic nattering nauseating necrotic noisy nonstop noxious
  }

  n-noun  {
    nabobery narcissism narrations neuroticisms news newspeak nihilism ninnyisms nominations noodging nostrums notes nothings
  }

  o-adj -x {
    oaffish obliging obnoxious obsolete obtuse odd odious offensive oily opportunistic optimistic orgiastic ossified over-long oversold
  }

  o-noun  {
    oaffishness obituaries obstacles occupations oddities odysseys offerings omissions operations opinions opposition outrages
  }

  p-adj -x {
     pandering paranoid parasitical parroting pastiche pathetic peculiar pedagogical pesky pointed poisonous preposterous presumptuous pusillanimous
  }

  p-noun  {
    pabulum paeans palavers pandemonium pandering parodies partakings patter perigrinations perjuries platitudes pleasantries ponderings pranking products
  }

  q-adj -x {
    quailing quaint quaking quasi queasy queer querulous quibbling quick quiet quirky quisling quivering quixotic
  }

  q-noun  {
    calumny quackery quackings qualms quarrels quashings quatrains questions quests {quintessence of insult} quips quizzes quotes
  }

  r-adj -x {
    rabid rambling rasping raucous ravening redneck reflected reflexive replacement retconned ridiculous rousing rowdy rude
  }

  r-noun  {
    rage railery railings rancor recitals recitations reckonings regalings remarks rigmarole rowdyism ruffianism rumblings
  }

  s-adj -x {
    cybernetic cynical sacriligious sadistic salubrious sanctimonious sarcastic silly simplistic slumming smirking stupid
  }

  s-noun  {
    cynicisms sagacity salutes scatterbrains {sense of humor} services skepticism {slothing about} solos sounds surveys
  }

  sh-adj -x {
      shabby shade-stealing shadowy shady shallow shameful shameless shark-jumping sharkish shawty sheep-biting sheep-faced sheisty shiftless shifty shocking shoddy short shortsighted shovel-faced showy shrill
  }

  sh-noun {
    charletons {sheep shavers} shih-tzus shirkers schmucks shift-crickets shills show-offs schleps {shock monkeys} showboats shysters 
  }

  t-adj -x {
    tardy tarnished tattered tawdry telling tenacious tintinabulating tiresome traditional treacherous treasonous
  }

  t-noun  {
    taglines taints tales tattles tensions tepidness testiness treachery treatises trumpetings {tubs of misinformation} tweeks twerps twits twitterings
  }

  th-adj -x {
    thankless theoretical thick thieving thorny thorough thoughtful thrilling thuggish thunderous thwarted
  }

  th-noun  {
    theatrics themes theology theories thickets thieves thinking thoughts thrashings threads threats thumpings
  }

  u-adj -x {
    ubiquitous ulcerous unartful unbearable unbelievable uncivil unclear unctuous undue unhinged unlikely unreasonable unusual uppity usual
  }

  u-noun  {
    ultimatums ululations umbrage uncivilisms underlings uneasiness unions upbraids users usurpations utterances utterings
  }

  v-adj -x {
    vacant vacuous vast vaulting vaunted veiled vernacular vertiginous vestigial visceral vitriolic vivid volatile vulgar
  }

  v-noun  {
    vacousness vagrancies vanities vaporing vendettas vengeance venturings verbiage verdicts verities villainies villainy vitriol
  }

  w-adj -x {
    wanton wardroom weary weevilly weighty weird whacky whoozy whopping wicked wiggy wimpy witless wobbling wobbly worrysome
  }

  w-noun  {
    waffling warbles warnings warranties wastages weaknesses weepfests welfare whimpers whining whinnyings wisdom wisecracks
  }

  y-adj -x useless yammering yawning yelping yokal youthful yucky yuppie

  y-noun  {
    yabbering yahoo yaps yarns yawps yearnings yeast yelling yelps yodeling yowling yutziness
  }

  z-adj -x zany zealous zestless zinging zippy zoophobic

  z-noun  zappers zaps zeal zeolotries zeppelins zingers zippers

Which pumps out zingers like:

  Spare me your kitschy, kooky kindnesses!
  Spare me your quaking quizzes!
  Spare me your unusual, unlikely underlings!
  Spare me your theoretical, thrilling thieves!
  Spare me your barbed, bitter befallen!
  Spare me your weird weaknesses!
  Spare me your zealous, zestless zingers!
  Spare me your giggling, gabby gangsters!
  Spare me your huffy, heavy humour!
  Spare me your chary, childish chucklehead!
  Spare me your direful, drifting din!
  Spare me your quiet, quisling quotes!
  Spare me your crazy, kooky kludges!
  Spare me your marauding, muck-raking moralizing!
  Spare me your bogus, blabbering boobyisms!
  Spare me your illusionary, icky innuendo!
  Spare me your knavish nothings!
  Spare me your childish, chattering chinwagging!
  Spare me your hostile hacks!

To use these things 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"

  puts [demo gen <insult>]

or

  source generate.tcl

  initgen drsmith desc "DrSmith.txt"

  puts [drsmith gen <spareme>]

  
This create generators ("demo" from "Insult.txt" and "drsmith" from "DrSmith.txt") -- "desc"ription-type generators. To get an insult, you evaluate the basic constructor for the generator, as shown above.

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 sound-alike "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:

 [puts [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> will give you the first result and <@save2> the second. This is useful to save state from productions in process to alter productions yet in the cue. You can see this in the DrSmith generator, which first generates a starting letter and then the words needed based from it. 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 }
                }
            **  { set value ""; set r [ lookup $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> ]}
      }

    }
  }

<<categories>> Toys |Gaming|Tcl for Kids