procgen  drug.ml at [77c9e366f8]

File drug.ml artifact b5c9249601 part of check-in 77c9e366f8


let frics = [| "f"; "sh"; "th"; |]
let vfrics = [| "z"; "v"; "zh"; |]
let stops = [| "t"; "p"; "k"; "c"; |]
let vstops = [| "d"; "b"; "g"; "gh"; |]
let withglide r f = Array.map (fun i -> i^f) r
let withonset r o = Array.map (fun i -> o^i) r
let consonants = Array.concat [
	frics; vfrics; stops; vstops;
	withonset stops "s";
	[| "w"; "r"; "rh"; "s"; "l"; "ch"; "n"; "m"; |];
]
let initials = Array.concat [
	consonants;
	withglide frics "r"; withglide frics "l"; withglide frics "w";
	withglide stops "r"; withglide vstops "r"; withglide vstops "w";
	[| "qu"; "spr"; "spl"; "str"; "scr"; "scl"; "squ"; "bl"; "gl"; "sn"; "sm"; "j"; "h"; "sph"; "ph";|];
]
let nuclei = [| "e"; "ee"; "i"; "a"; "ou"; "u"; "oo"; "ea"; "oa"; "ai"; "oi"; "ie";|]
let finals = Array.concat [
	vstops;
	withonset stops "s"; withonset stops "r"; withonset stops "l";
	withonset vstops "r"; withonset vstops "l";
	[| "gh"; "ck"; "ce"; "ss"; "se"; "nd"; "mb"; "mph"; "nk"; "tch"; "ke"; "ght";
	"ff";  "ll"; "zz"; "t"; "p"; "th"; "rth"; "lth"; "dge"; "nge"; "ng"; "ft"; "ckle"; "ngle"; "rkle";
	"scht"; "ze"; "x"; "sh"; "rsh"; "lsh"; "ggle"; "ddle"; "bble"; "pple"; "rge"; "lge"; "ve"; "rve";
	"lve"; "ffle"; "ttle"; "kle"; "sch"; "m"; "n"; "rm"; "lm"; "rn"; "ln";|]
]
let range min max = (Random.int (max-min)) + min
let chance n = range 0 n = 0
let pick (r: 'a array) : 'a = r.(range 0 (Array.length r));;
let prefixes = [| "crack"; "crystal"; "powdered"; "raw"; "pure"; "liquid"; "street";
	"super"; "electric"; "diced"; "homemade"; "traditional"; "old-school"; "purified";
	"high-caliber"; "high-octane"; "old-fashioned"; "good old"; "honest-to-god";
	"weapons-grade"; "soviet"; "american"; "canadian"; "british"; "russian";
	"synthetic"; "french"; "cyber"; |]
let word () = (if chance 3 then (pick prefixes) ^ " " else "") ^
	(if chance 5 then "" else pick initials) ^
	(pick nuclei) ^
	(pick finals)
	
let greets = [| "hey"; "whassup"; "what's up"; "what up"; "yo"; "hey there"; "what's shakin'" |]
let names = [| "dude"; "bro"; "man"; "babe"; "sweetheart"; "honey"; "baby"; "hottie"; "girl"; |]
let questions = [| "wanna"; "want to"; "shall we"; "how about we"; |]
let exhorts = [| "we oughta"; "you oughta"; "we ought to"; "you ought to"; "we should";
	"you should"; "let's"; |]
type component = Invariant of string | Numbered of string * string | Poss
type state = Plain of string | Compound of component list
let states = [|
	Plain "high";
	Compound[Invariant "out of"; Poss; Numbered("mind","minds")];
	Compound[Invariant "outta"; Poss; Numbered("mind","minds")];
	Plain "fucked up";
	Plain "wrecked";
	Plain "hammered";
	Plain "buzzed";
	Plain "tweaked";
	Plain "whacked";
	Plain "whacked out";
	Plain "smacked";
	Plain "smacked out";
	Plain "tipsy";
	Plain "snazzy";
	Plain "spooky";
	Plain "crazy";
	Plain "messed up";
	Plain "far out";
	Plain "horny";
	Plain "psycho";
	Plain "loony";
	Plain "wacky";
	Plain "silly";
	Plain "creepy";
	Plain "frazzled";
	Plain "dazzling";
	Plain "wired";
	Plain "peppy";
	Plain "hoovered";
	Plain "turnt";
	Plain "turnt up";
	Plain "tits-up";
	Plain "toasted";
	Plain "roasted";
	Plain "cooked";
	Plain "baked";
	Plain "basted";
	Plain "flunked";
	Plain "flunked out";
	Plain "crazed";
	Plain "stewed";
	Plain "framed for war crimes";
	Plain "ruined";
	Plain "totally ruined";
	Plain "whacked out";
	Plain "creeped out";
	Plain "spunky";
	Plain "spiffy";
	Plain "nifty";
	Plain "wicked";
	Plain "slutty";
	Plain "jazzed";
	Plain "jazzy";
	Plain "fried";
	Plain "hecked";
	Plain "hecked up";
	Plain "hecked out";
	Plain "screwed";
	Plain "screwed up";
	Plain "ousted";
	Plain "thrown out of the mall";
	Plain "cyber";
	Plain "totally online";
	Plain "cybered";
	Plain "downloaded";
|]
let roas = [| "on"; "shooting up"; "using"; "mainlining"; "snorting"; "vaping"; "smoking"; "cybering";
	"sucking down"; "gargling"; "doing"; "trying"; "guzzling"; "popping"; "downing"; "chewing"; 
	"crunching"; "sniffing"; "zapping"; "downloading"; "dropping"; "cooking up"; "freebasing"|]
let vroas = [| "shoot up"; "mainline"; "snort"; "vape"; "smoke"; "freebase";
	"suck down"; "gargle"; "do"; "try"; "guzzle"; "pop"; "down"; "chew"; "crunch";
	"sniff"; "zap"; "download"; "drop"; "cyber"; "cook up"; |]
module Pronoun = struct
	type t = {
		nom : string; obl : string; gen : string;
		refl : string; cop : string; brevcop : string;
		pl : bool;
	}
	let you = {nom = "you"; obl = "you"; gen = "your"; refl = "yourself";
		cop = "are"; brevcop = "'re"; pl = false;}
	let youpl = {nom = "you"; obl = "you"; gen = "your"; refl = "yourself";
		cop = "are"; brevcop = "'re"; pl = true;}
	let he = {nom = "he"; obl = "him"; gen = "his"; refl = "himself";
		cop = "is"; brevcop = "'s"; pl = false;}
	let they = {nom = "they"; obl = "them"; gen = "their"; refl = "themselves";
		cop = "are"; brevcop = "'re"; pl = true;}
	let she = {nom = "she"; obl = "her"; gen = "her"; refl = "herself";
		cop = "is"; brevcop = "'s"; pl = false;}
	let me = {nom = "I"; obl = "me"; gen = "my"; refl = "myself";
		cop = "am"; brevcop = "'m"; pl = false;}
	let we = {nom = "we"; obl = "us"; gen = "our"; refl = "ourselves";
		cop = "are"; brevcop = "'re"; pl = true;}
	let all = [| you; youpl; he; they; she; me; we |]
end
let cop p = Pronoun.(if chance 4 then p.nom ^ " " ^ p.cop else p.nom^p.brevcop)
let makestate p s = 
	let eval c = match c with
		| Invariant i -> i
		| Numbered(sg,pl) -> if p.Pronoun.pl then pl else sg
		| Poss -> p.Pronoun.gen
	in match s with
		| Plain t -> t
		| Compound l -> List.fold_left (fun a t -> if a = "" then a^(eval t) else a^" "^(eval t)) "" l 
let gethigh p = (cop p) ^ (pick [|" getting "; " gonna get "; " "|]) ^ (pick [|"";"so "|])
	^ (makestate p (pick states)) ^ " on " ^ (word ());;
let cantwait p = p.Pronoun.nom ^ " can't wait to get " ^ (makestate p (pick states)) ^ " on " ^ (word ());;
let affecting p =
	if chance 2 then 
		(pick [|
			"it's got"; "it's getting"; "it got"; "it has";
			"it's making"; "it's gonna get"; "it's gonna make"
		|]) ^ " " ^ p.Pronoun.obl
	else Pronoun.(pick [|
		p.nom ^ " got";
		(cop p) ^ " getting";
		(cop p) ^ " gonna get";
		(cop p);
	|]);;
let gotso p = (affecting p) ^ (pick [|" ";" so "|]) ^ (makestate p (pick states));;
let ison p = (cop p) ^ " " ^ (pick roas) ^ " " ^ (pick [|"so much ";"too much ";"way too much ";"a lotta ";"a lot of "; "a ton of "; "a whole lotta "; "a whole lot of ";"";""|]) ^ (word ());;
let isonand p = (ison p) ^ " and " ^ (gotso p)

let offer p name (* haaaack *) = (pick greets) ^ " " ^ name ^ (pick [|"! "; ", "; ". "; " - ";|]) ^
	if chance 2 then
		(pick questions) ^ (pick [|" go "; " "|]) ^ (pick vroas) ^ (pick [|" some "; " "|]) ^
		(word ()) ^ (if chance 2 then " and get " ^ (makestate p (pick states)) else "") ^ "?"
	else  
		(pick exhorts) ^ (pick [|" go "; " "|]) ^ (pick vroas) ^ (pick [|" some "; " "|]) ^
		(word ()) ^ (if chance 2 then " and get " ^ (makestate p (pick states)) else "") ^
		(pick [|"!";"";"."|]);;
let offer_wrap p (* haaaack *) = offer Pronoun.you (pick names) 
let gotsoand p = (gotso p) ^ " " ^ (pick roas) ^ (pick [|" the "; " that "; " all that ";" some ";|]) ^ (word ())
let routes = [| gethigh; ison; isonand; offer_wrap; gotsoand; cantwait; |] 
let main = Random.self_init ();
	if Array.length Sys.argv >= 2 && String.length (String.trim (Sys.argv.(1))) >= 1 then
		print_string(offer Pronoun.you (String.trim Sys.argv.(1)))
	else print_string (pick routes (pick Pronoun.all))