procgen  drug.ml at trunk

File drug.ml artifact 57ab84e43c on branch trunk


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"; "dank"; "dinky"; "dismal"; "fire"; "wild"; "wacky";
    "snazzy"; "sleazy"; "skanky"; "sexy"; "screwy"; "funky"; "queer"; "kinky"; "fascist";
    "irish"; "nazi"; |]
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 |Obl | Nom | Refl
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")];
	Compound[Invariant "put out of"; Poss; Invariant "misery"];
	Compound[Invariant "put outta"; Poss; Invariant "misery"];
	Compound[Invariant "an APB on"; Poss; Numbered("ass","asses")];
	Compound[Invariant "a cop on"; Poss; Invariant "tail"];
	Plain "fucked";					Plain "bailed out";
	Plain "fucked up";				Plain "slobbered";
	Plain "fucked off";				Plain "slobbered out";
	Plain "fucked out";				Plain "honked";
	Plain "fucked away";			Plain "honked out";
	Plain "wrecked";				Plain "honked off";
	Plain "hammered";				Plain "honked away";
	Plain "buzzed";					Plain "tweeted";
	Plain "tweaked";				Plain "tweeted at";
	Plain "whacked";				Plain "subtweeted";
	Plain "whacked out";			Plain "slagged";
	Plain "whacked off";			Plain "razzed";
	Plain "smacked";				Plain "thrashed";
	Plain "smacked out";			Plain "flogged";
	Plain "tipsy";					Plain "jacked";
	Plain "snazzy";					Plain "jacked up";
	Plain "spooky";					Plain "jacked off";
	Plain "crazy";					Plain "exiled";
	Plain "messed up";				Plain "sentenced to death";
	Plain "far out";				Plain "jailed";
	Plain "horny";					Plain "orbital";
	Plain "psycho";					Plain "radical";
	Plain "loony";					Plain "dialectical";
	Plain "wacky";					Plain "shagged";
	Plain "silly";					Plain "snubbed";
	Plain "creepy";					Plain "glued";
	Plain "frazzled";				Plain "glued off";
	Plain "dazzling";				Plain "glued out";
	Plain "wired";					Plain "sneezy";
	Plain "peppy";					Plain "grumpy";
	Plain "hoovered";				Plain "wild";
	Plain "turnt";					Plain "outta this world";
	Plain "turnt up";				Plain "out of this world";
	Plain "tits-up";				Plain "junked";
	Plain "toasted";				Plain "trashed";
	Plain "roasted";				Plain "recycled";
	Plain "cooked";					Plain "fragged";
	Plain "baked";					Plain "dematerialized";
	Plain "basted";					Plain "degenerate";
	Plain "flunked";				Plain "biblical";
	Plain "flunked out";			Plain "mystical";
	Plain "crazed";					Plain "mythical";
	Plain "stewed";					Plain "twisted";
	Plain "framed for war crimes";	Plain "stabbed";
	Plain "ruined";					Plain "stapled";
	Plain "totally ruined";			Plain "cucked";
	Plain "whacked out";			Plain "cucked up";
	Plain "creeped out";			Plain "cucked out";
	Plain "spunky";					Plain "cucked off";
	Plain "spiffy";					Plain "bamboozled";
	Plain "nifty";					Plain "baffled";
	Plain "wicked";					Plain "baffled";
	Plain "slutty";					Plain "logged on";
	Plain "jazzed";					Plain "logged off";
	Plain "jazzy";					Plain "hauled";
	Plain "fried";					Plain "hauled away";
	Plain "hecked";					Plain "hauled off";
	Plain "hecked up";				Plain "rehabilitated";
	Plain "hecked out";				Plain "disappeared";
	Plain "screwed";				Plain "counterrevolutionary";
	Plain "screwed up";				Plain "gulagged";
	Plain "ousted";					Plain "grinched";
	Plain "thrown out of the mall";	Plain "redacted";
	Plain "cyber";					Plain "razed";
	Plain "totally online";			Plain "sludged";
	Plain "cybered";			    Plain "clawed up";
	Plain "downloaded";			    Plain "clawed off";
	Plain "slurped out";		    Plain "dragged";
	Plain "sucked off";			    Plain "dragged away";
	Plain "sporked";			    Plain "dragged away screaming";
	Plain "sporked up";			    Plain "kidnapped";
	Plain "sleazy";				    Plain "hazed";
	Plain "sleazed up";			    Plain "glazed";
	Plain "sleazed up";			    Plain "shot";
	Plain "sledged";			    Plain "shot at";
	Plain "sledged out";		    Plain "spherical";
	Plain "sledged up";			    Plain "authoritarian";
	Plain "sickled";			    Plain "totalitarian";
	Plain "hammered and sickled";   Plain "fascist";
	Plain "strung out";			    Plain "nationalized";
	Plain "strung up";			    Plain "flayed";
	Plain "strung along";		    Plain "thumped";
	Plain "blown";				    Plain "thumped off";
	Plain "blown up";			    Plain "humped";
	Plain "blown out";			    Plain "messy";
	Plain "blown away";			    Plain "conical";
	Plain "blazed";				    Plain "chunked";
	Plain "dredged";			    Plain "chunky";
	Plain "dredged up";			    Plain "hucked";
    Plain "bailed";                 Plain "zucked";
    Plain "zucked up";              Plain "zucked off";
    Plain "zucked out";             Plain "benched";
    Plain "drafted";                Plain "conscripted";
    Plain "killed";                 Plain "killed";
    Plain "hanged";                 Plain "hung";
    Plain "hung out to dry";        Plain "janky";
    Plain "hacked";                 Plain "hacked into";
    Plain "hacked off";             Plain "hacked out";
    Plain "judged";                 Plain "found guilty";
    Plain "empaneled";              Plain "impaled";
    Plain "acquitted";              Plain "shucked";
    Plain "banksy";                 Plain "persecuted";
    Plain "desegregated";           Plain "hauled";
    Plain "hauled into court";      Plain "trumped up";
    Plain "gendered";               Plain "ghouled";
    Plain "slugged";                Plain "slagged";
    Plain "frayed";                 Plain "stupid";
    Plain "girly";                  Plain "manly";
    Plain "comical";                Plain "satirical";
    Plain "mocked";                 Plain "funny";
    Plain "arrested";               Plain "molested";
    Plain "assaulted";              Plain "convicted";
    Plain "traumatized";            Plain "ravished";
    Plain "violated";               Plain "sexy";
    Plain "beaten";                 Plain "used";
    Plain "bruised";                Plain "battered";
    Plain "bloody";                 Plain "abused";
    Plain "neglected";              Plain "gaslit";
    Plain "lied to";                Plain "deceived";
    Plain "fooled";                 Plain "foolish";
    Plain "dense";                  Plain "arboreal";
    Plain "chucked";                Plain "got";
    Plain "done";                   Plain "had";
    Plain "duped";                  Plain "dropped";
    Plain "drunk";                  Plain "busted";
    Plain "buxom";                  Plain "bothered";
    Plain "hot";                    Plain "cold";
    Plain "joshed";                 Plain "surrounded";
    Plain "sharp";                  Plain "spun";
    Plain "spun up";                Plain "spun out";
    Plain "spun along";             Plain "dragged along";
    Plain "long";                   Plain "weird";
    Plain "corporate";              Plain "enterprise";
    Plain "electronic";             Plain "electric";
    Plain "tortured";               Plain "shivved";
    Plain "shanked";                Plain "skanky";
    Plain "skanked";                Plain "skanked up";
    Plain "skanked out";            Plain "skanked off";
    Plain "skanked away";           Plain "whored";
    Plain "whored out";             Plain "whored off";
    Plain "sold";                   Plain "sold off";
    Plain "sold out";               Plain "spanked";
    Plain "slapped";                Plain "stunk";
    Plain "stinky";                 Plain "stung";
    Plain "stabled";                Plain "stuck";
    Plain "topped";                 Plain "bottomed";
    Plain "trawled";                Plain "trawled for";
    Plain "wanked";                 Plain "wanked out";
    Plain "strapped";               Plain "butchered";
    Plain "invaded";                Plain "liberated";
    Plain "greeted as liberators";  Plain "defiled";
    Plain "desecrated";             Plain "lost";
    Plain "scolded";                Plain "slabbed";
    Plain "snagged";                Plain "flabby";
    Plain "fracked";                Plain "wobbled";
    Plain "mobbed";                 Plain "floppy";
    Plain "slinky";                 Plain "sloppy";
    Plain "snooty";                 Plain "twee";
    Plain "rich";                   Plain "poor";
    Plain "addicted";               Plain "hooked";
    Plain "clammed up";             Plain "quiet";
    Plain "chafed";                 Plain "chewed up";
    Plain "chewed out";             Plain "green";
    Plain "purple";                 Plain "pink";
    Plain "white";                  Plain "douched";
    Plain "douchey";                Plain "douched out";
    Plain "douched up";             Plain "douched off";
    Plain "dank";                   Plain "humped up";
    Plain "humped off";             Plain "funky";
    Plain "funked";                 Plain "funked up";
    Plain "funked off";             Plain "funked out";
    Plain "sad";                    Plain "depressed";
    Plain "dehumanized";            Plain "demeaned";
    Plain "dropped out";            Plain "queer";
    Plain "gay";                    Plain "kinky";
    Plain "cranked";                Plain "cranked out";
    Plain "cranked up";             Plain "cranked off";
    Plain "cranked away";           Plain "kicked";
    Plain "booted";                 Plain "kinked";
    Plain "sucked off";             Plain "boggled";
    Plain "branded";                Plain "rebranded";
    Plain "compliant";              Plain "obedient";
    Plain "scammed";                Plain "legal";
    Plain "outlawed";               Plain "banned";
    Plain "banished";               Plain "baled";
    Plain "blooded";                Plain "blasted";
    Plain "blasted out";            Plain "blasted off";
    Plain "blasted up";             Plain "blasted down";
    Plain "slammed";                Plain "slammed down";
    Plain "memed";                  Plain "memetic";
    Plain "elected";                Plain "bought out";
    Plain "bought up";              Plain "bought";
    Plain "bagged";                 Plain "bugged";
    Plain "blurry";                 Plain "blurred";
    Plain "blobbed";                Plain "cubed";
    Plain "orbed";                  Plain "squared";
    Plain "[REDACTED]";             Plain "wrangled";
    Plain "wrassled";               Plain "glib";
    Plain "maudlin";                Plain "schooled";
    Plain "wracked";                Plain "served";
    Plain "flailed";                Plain "whaled";
    Plain "sloshed";                Plain "sprayed";
    Plain "spayed";                 Plain "prayed to";
    Plain "prayed out";             Plain "prayed off";
    Plain "prayed for";             Plain "prayed away";
    Plain "snacked";                Plain "snacked up";
    Plain "snacked out";            Plain "snacked away";
    Plain "snacked off";            Plain "deported";
    Plain "sat on";
|]
let roas = [| "on"; "shooting up"; "using"; "mainlining"; "snorting"; "vaping"; "smoking"; "cybering";
    "sucking down"; "gargling"; "doing"; "trying"; "slurping"; "guzzling"; "popping"; "downing"; "chewing"; "pooping"; "shitting"; "pissing";
    "crunching"; "sniffing"; "zapping"; "downloading"; "dropping"; "cooking up"; "freebasing"; "hooting"; "tooting"; "blasting"; "blazing";
    "tweeting"; "honking"; "plugging"; "plugging in"; "hooking up"; "turning on"; "boofing"; "whacking"; "choking"; "ravishing"; "looting"; "slaughtering"; "drinking"; "eating"; "slugging"; "ghouling"; "scrobbling"; "torrenting"; "oiling up"; "jacking off";|]
let vroas = [| "shoot up"; "mainline"; "snort"; "vape"; "smoke"; "slurp"; 
    "suck down"; "gargle"; "do"; "try"; "guzzle"; "pop"; "down"; "chew"; "crunch"; "poop"; "shit"; "piss"; "blast"; "blaze";
    "sniff"; "zap"; "download"; "drop"; "cyber"; "cook up"; "toot"; "hoot"; "plug"; "plug in";
    "hook up"; "turn on"; "boof"; "whack"; "choke"; "drink"; "eat"; "slug"; "ghoul"; "freebase"; "ravish"; "loot"; "slaughter"; "scrobble"; "torrent"; "oil up"; "jack off";|]
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
		| Nom -> p.Pronoun.nom
		| Obl -> p.Pronoun.obl
		| Refl -> p.Pronoun.refl
	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 =
    let pickstate () =
        (makestate p (pick states)) ^
            (if chance 3 then
                " and " ^ (makestate p (pick states))
            else "")
    in (cop p) ^ (pick [|" getting "; " gonna get "; " "|]) ^ (pick[| ""; p.Pronoun.refl ^ " " |]) ^ (pick [|"";"so "; "all "; "way "; "super "; "totally "|])
	^ (pickstate ()) ^ " on " ^ (word ());;
let cantwait p = p.Pronoun.nom ^ " can't wait to get " ^ (pick[| ""; p.Pronoun.refl ^ " " |]) ^ (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 ";"some ";"a little ";"some of this ";"some of that ";"a bit of ";"my ";"your ";"this ";"that ";"that there ";"all this ";"some of her ";"some of his ";"some of our ";"all this ";"all of this ";"her ";"his ";"our ";"";"";""|]) ^ (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))