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))