procgen  egret_txt.ml at trunk

File egret_txt.ml artifact 18174bc407 on branch trunk


type root = R of string | I of string*string
type kind = Plain | Vowel | Uncountable
type word = root * kind
let pick a = a.(Random.int (Array.length a))
let words = [|
	(R "egret", Vowel);	(I("knife","knives"), Plain);	(I("child","children"), Plain);
	(R "owl", Vowel);		(R "dawn", Uncountable);	(R "dawn", Plain);
	(R "relic", Plain);		(R "home", Plain);				(R "hope", Plain);
	(R "tower", Plain);	(R "plain", Plain);					(R "fire", Plain);
	(R "fire", Uncountable);	(R "fear", Plain);			(R "fear", Uncountable);
	(R "whisper", Plain);		(R "furrow", Plain);			(R "field", Plain);
	(R "regret", Plain);		(R "blade", Plain);			(R "thing", Plain);
	(R "pillar", Plain);		(R "fate", Plain);				(R "doom", Plain);
	(R "candle", Plain);		(R "lantern", Plain);			(I("sky","skies"), Plain);
	(I("grass","grasses"), Plain);	(I("ash","ashes"), Vowel); (R "void", Plain);
	(R "stranger", Plain);		(R "blood", Uncountable);	(R "incompetence", Uncountable);
	(R "holiness", Uncountable);	(R "sorrow", Uncountable);	(R "gladness", Uncountable);
	(R "unkindness", Uncountable); (I("cruelty","cruelties"), Plain);
	(R "cruelty", Uncountable); (R "ember", Vowel); (R "throat", Plain);
|]
let adjs = [|
	"sorrowful";"fiery";"unkind";"fallow";"sallow";"hollow";"unending";"wondrous";
	"vapid";"dim";"shallow";"glorious";"empty";"failing";"dying";"crawling";"ashen";
	"furious";"frightened";"terrible";"awful";"eternal";"silent";"frightful";"timeless";
	"golden";"black";"white";"noble";"defunct";
|]
let verbs = [|
	R "burn", true;			R "fear",true;	R "slaughter",true;	R "explode",false;
	R "interrogate",true;	R "sleep",false;	R "despair",false;		R "dissolve",true;
	R "question",true;		R "slay",true;	R "stay",false;			R "fade",false;
	I("wonder at", "wonders at"),true;		R "linger",false;		R "die",false;
	I("cry out", "cries out"),false; I("cry out at","cries out at"),true;
	I("cry","cries"),false; R "weep", false;
	I("cry out to","cries out to"),true;
|]
let compl : root array = [| R "hope"; R "believe"; I("wonder if","wonders if"); |];;
let sg (r:root) : string = match r with
	| R x -> x
	| I(x,_) -> x;;
let pl (r:root) : string = match r with
	| R x -> x^"s"
	| I(_,x) -> x;;
let indef (w:word) : string = let (r,k) = w in (match k with
	| Plain -> "a "
	| Uncountable -> ""
	| Vowel -> "an ") ^ (sg r);;
	
let pron () = pick [|
	"it",false; "she",false; "he",false; "they",true;
	"we",true; "you",true;
|]
let accpron() = pick [|
	"it";"her";"him";"them";"us"
|]
let basenp () : string * bool= let w = pick words in 
	let (r,k) = w in
	let adj = pick [|(pick adjs) ^ " ";""|] in
	let rsg = adj ^ (sg r) in
	let rpl = adj ^ (pl r) in
	let sgs = [|
		indef w;
		"the " ^ rsg;
		"yon " ^ rsg;
		"this " ^ rsg;
		"that " ^ rsg;
		"my " ^ rsg;
		"some " ^ rsg;
		"your " ^ rsg;
		"her " ^ rsg;
		"our " ^ rsg;
		"its " ^ rsg;
		"their " ^ rsg;
		"his " ^ rsg;
	|] in let pls = [|
		pl r;
		"the " ^ rpl;
		"these " ^ rpl;
		"those " ^ rpl;
		"my " ^ rpl;
		"some " ^ rpl;
		"yonder " ^ rpl;
		"your " ^ rpl;
		"her " ^ rpl;
		"our " ^ rpl;
		"its " ^ rpl;
		"his " ^ rpl;
		"their " ^ rpl;
	|] in if k = Uncountable then (pick sgs,false) else pick [|(pick sgs,false);(pick pls,true)|]

let rec gp () : string*bool = let (n,p) = np () in (n ^ " of " ^ (let (n,_) = np() in n)), p
and relp () : string*bool = let (n,p) = basenp () in (n ^ " that " ^ (vp p)), p
and np () : string*bool = (pick [| basenp; basenp; basenp; gp; relp |])()
and pvp p =  let verb, trans = pick verbs in
				let v = (if p then sg else pl) verb in
				let n, _ = (pick [| np(); accpron(),false |]) in
					v ^ if trans then (" " ^ n) else ""
(* and cvp (p:bool) : string =
	let verb = (pick compl) in
	let v = (if p then sg else pl) verb in
	let n,p = (pick [|np;pron|])() in
	let d = decl n p in
	v ^ " " ^ d -- THIS IS HORRIBLY BROKEN *)
and vp p = pvp p
and decl n p = n ^ " " ^ (vp p) ^ (pick [|
	(fun()->".");
	(fun()->", and " ^ (s()));
	(fun()->", but " ^ (s()));
|]())
and idques n p = let n2, _ = np() in (if p then "are " else "is ")^n^" "^n2^"?"
and ques n p = (if p then "do " else "does ")^n^" "^(vp true)^"?"
and s () = let (n,p) = pick [|np;pron|] () in (pick [|decl;decl;ques;idques|]) n p;;
let rec times x f = if x > 0 then
		(f (); times (x-1) f)
	else
		();;
(*let () = Random.self_init ();
	times 10 (fun () -> let c = string_of_int ((Random.int 6)+1) in
		print_string ("\x1b[1;3"^c^"m-\x1b[0;3"^c^"m "^(s ()) ^ "\n"));;*)
let () = Random.self_init (); print_string ((s ()) ^ "\n");;