| 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 {
#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 zippersWhich 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 ]
}
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]
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> ]}
}
}
}
