Updated 2014-06-03 21:52:52 by LarrySmith
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 [1] 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 [2] and in computers with Procedural Generation Wiki[3] and Procedural Generation[4].

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 {
    {...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}

  simpleinsult {
    #3<{<insultadj> <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>]

  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:


  initgen demo word "Elfish-f.txt"

You get a generator where calls of:
 [puts [demo gen]

Can produce results like:

However, the system can be more sophisticated than this. A production <...> can include a number of different operations.

For example:

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:

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:

You will get "baa" if <critter> is NOT cow.

You can invert this operator:

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:


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"

  race Elf Human Dwarf
  Elf-epithet tiny points Spock
  Human-epithet dummy round-ear
  Dwarf-epithet shorty grumpy

  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).
  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 **:

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 (())


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:


You can also use the special index 1of:

Which will give you any of the possible choices at random - this let's you build up tables dynamically.


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 {

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
        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"

        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" }
    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]
    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 {
        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 ]
      if $::verbose { puts "Defining $tablename" }
      set oldtable {}
      catch {set oldtable $table($tablename)}
      set table($tablename) $args
      if { [llength $oldtable] != 0 } {
        set table($tablename) [linsert $args end {*}$oldtable]
      set table($tablename) [lsort -nocase $table($tablename)]
      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]
      } 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> ]}