let nouns = [|
"verve"; "pulchritude"; "beneficence"; "dismay"; "wit";
"cheer"; "glee"; "malevolence"; "wickedness"; "cruelty";
"sagacity"; "splendor"; "pride"; "rage"; "fury"; "snazz";
"foolishness"; "sleepiness"; "curiosity"; "brevity"; "lust";
"confidence"; "bashfulness"; "awkwardness"; "terror";
"accuracy"; "insanity"; "sorrow"; "gladness"; "weariness";
"depression"; "passion"; "dread"; "popularity"; "vulgarity";
"madness"; "compassion"; "tact"; "evil"; "hate"; "hatred";
"horror"; "omnipotence"; "charisma"; "radiance"; "depravity";
|]
let mods_w = [|
"filled"; "overcome"; "shining"; "vivacious";
"burning"; "blazing"; "morose"; "gleeful"; "mad";
"shaking"; "howling"; "snarling"; "gruesome";
"helpless"; "vibrant"; "desperate"; "triumphant";
"glum"; "sorrowful"; "struck"; "grumbling";
"griping"; "hissing"; "hooting"; "crackling";
"glowing"; "radiant";
|]
let mods_f = [|
"full of"; "struck by"; "overcome by";
|]
let mods = Array.append (Array.map (fun a -> a ^ " with") mods_w) mods_f
let advs = [|
"cruelly"; "angrily"; "madly"; "hopelessly"; "thoughtlessly";
"wickedly"; "hopefully"; "quickly"; "speedily"; "furiously";
"kindly"; "maniacally"; "tearfully"; "bashfully"; "angrily";
"wondrously"; "splendidly"; "tremendously"; "badly";
"terribly"; "foolishly"; "snazzily"; "toplessly"; "balefully";
"beautifully"; "kindly"; "thoughtfully"; "cautiously";
"severely"; "wisely"; "lustfully"; "tactfully"; "winsomely";
"watchfully"; "irresponsibly"; "headlessly"; "charismatically";
"radiantly"; "sinfully"; "lawlessly"; "unlawfully"; "lawfully";
|]
let adjs = [|
"cheerful"; "wondrous"; "overwhelming"; "adorable";
"snazzy"; "hopeful"; "desperate"; "lustful"; "dour";
"sad"; "sorrowful"; "hopeless"; "all-consuming"; "mad";
"cruel"; "dreadful"; "terrible"; "fearsome"; "inescapable";
"thoughtless"; "vile"; "bashful"; "topless"; "naked"; "dire";
"baleful"; "vulgar"; "beautiful"; "horrid"; "cautious";
"violent"; "wise"; "supreme"; "marvelous"; "tactful"; "evil";
"wretched"; "fearful"; "awe-inspiring"; "vengeful"; "wrathful";
"omnipotent"; "charismatic"; "radiant"; "lawless"; "unlawful";
"lawful";
|]
type rule = R of string array | S of string | B of rule list | A of rule array | O of rule;;
let mkb = Array.map (fun a -> S a)
let verbs = Array.append (mkb [|
"shines"; "toots"; "honks"; "mutters"; "whispers"; "growls";
"roars"; "whuffles"; "warbles"; "howls"; "screams"; "shrieks";
"quivers"; "dances"; "hops up and down"; "grins"; "mumbles";
"counsels you"; "glares"; "stares at you"; "looks up"; "gazes at you";
"marvels"; "laughs"; "sins"; "whistles"; "whungles"; "jangles";
"twerks"; "blinks"; "blorps"; "flunks"; "planks"; "glitters";
"gleams"; "grumbles"; "grouches"; "bites you"; "gnaws on you";
"glimmers"; "gripes"; "plots"; "wonders"; "whittles"; "plays the fiddle";
"ponders"; "contemplates you"; "scrunches"; "zaps"; "zaps you";
"hoots"; "crackles"; "glows"; "blogs";
|]) [|
B[S"radiates "; R nouns];
B[S"oozes "; R nouns];
|]
let pick a = a.(Random.int (Array.length a))
let rec eval r : string = match r with
| R x -> pick x
| S x -> x
| B x -> List.fold_left (^) "" (List.map eval x)
| A x -> eval (pick x)
| O x -> if Random.int 2 = 0 then eval x else ""
let syl () =
let stop = R [| "p"; "t"; "k"; |] in
let fric = R [| "s"; "f"; "h"; "x"; |] in
let vstop = R [| "b"; "d"; "g"; |] in
let vfric = R [| "z"; "v"; "gh"; |] in
let liq = R [| "l"; "r"; "y"; "w"; |] in
let nasal = R [| "n"; "m"; "ng"; |] in
let obs = A [| stop; fric; vstop; nasal; liq; |] in
let v = R [| "a"; "e"; "u"; "o"; "i"; "ee"; "oo"; "au"; "ai";"oi";|] in
let sr = A [|
B[obs; v; O obs];
B[A [|stop;vstop;fric;vfric;|]; O liq; v; O obs];
|] in eval sr
;;
let prefixes = [| "ur-"; "dire "; "dire ur-"; "super "; "ultra "; "great "; "grand "; "terror-"; "horror-"; "giant "; "evil "; "dark "; "vorpal "; "royal ";|]
let name () =
let size = 1 + (Random.int 3) in
let rec loop n acc = if n = 0 then acc else loop (n-1) (acc^(syl ())) in
(if Random.int 2 = 0 then (pick prefixes) else "") ^ loop size "";;
let isvowel c = match c with
| 'a' | 'e' | 'i' | 'o' | 'u' -> true
| _ -> false;;
let indef x = if isvowel x.[0] then "an "^x else "a "^x;;
let encounter () =
let msgs = [|
"you encounter";
"you chance upon";
"you find";
"you run into";
"you run straight into";
"you trip over";
"you stumble upon";
"you happen upon";
"egads!";
"how wondrous!";
"how marvelous!";
"how gruesome!";
"how splendid!";
"oh no!";
|] in
let kinds =
let maybe x = O(B[x; S" "]) in
let adjp = B[maybe (R advs); R adjs] in B [
R [|"it";"she";"he";|]; S" ";
A [|
B[A verbs; S " ";
A [|
B[ S "with "; maybe adjp; R nouns;];
R advs;
|];
];
B[S"is "; maybe (R advs);
A [|
B[R mods; S" "; maybe adjp; R nouns;];
R mods_w;
|]
];
|];
S "!";
] in
(pick msgs)^" "^(indef (name()))^"! " ^ (eval kinds);;
let rec times n a = if n = 0 then () else (a (); times (n-1) a);;
let () = Random.self_init ();
(* times 20 (fun () ->*)
print_string ((encounter ()) ^ "\n")
(* )*)