hubFS: THE place for F#

open List
open String

(* TYPES AND THEIR METHODS *)

type direction = North | South | East | West | Up | Down
let opposite r = match r with North -> South | East -> West | South -> North | West -> East | Up -> Down | Down -> Up // Method
let all_dirs f = f North; f South; f East; f West; f Up; f Down // Static Method
let all_dirs_str f = filter (fun r -> r<>"") [f North "To The North"; f South "To The South"; f East "To The East"; f West "To The West"; f Up "Going Upwards"; f Down "Going Downwards"] // Static Method

type item = string

type tag = int

type action = subaction * string // What happens, and text to accompany it
and subaction = RoomChange of room * room // The first room is replaced for the second room on the global map, and if you are in the first room you are transported to the second.
               | SetTag of tag * bool // Sets a given tag to either true or false
               | SetItem of item * bool // If bool is true, you gain this item, if false, it is removed from your inventory if it is there.
               | Teleport of room // Moves you to another room
               | Composite of subaction list // Runs through multiple actions
               | Nothing // Nothing happens

and conversation = conversationline list // A conversation is a list of conversation lines
and conversationline = Auto of autoline | Choice of choiceline // And each conversation line is either an automatic line, or the character has a choice in what to say
and autoline = bool * string * tag option * item option * action option // Who says it, what they say, prerequisite tag, prerequisite item, resulting action
and choiceline = (tag option * item option * string * action option) list // List of choices. Each choice consists of a prerequisite tag, prerequisite item, what you could say, resulting action
and room = { name : string;
              details : string;
              mutable move : direction -> room option; // Partial function from direction to adjacent rooms
              mutable items : (item * action option) list; // Items in the room one can pick up, and what happens when you pick each one up
              mutable uses : string -> action option; // Partial function from strings to what happens when you use that item in this room. If this string is an item (i.e. if anywhere.examine string != "") you must have that item to be able to use it.
              mutable people : (string * conversation) list; // People in the room, and the conversation that happens when you talk to them
              mutable autos : tag -> action option } // Partial function from tags to what happens automatically in the room if you have that tag

let room_to_string r =
 let move_to_string f = concat "\n" (all_dirs_str (fun d s -> match (f d) with Some r -> s ^ ": " ^ r.name | _ -> "")) in
 "Current Room: " ^  r.name ^ (if r.details<>"" then "\nDetails: " ^ r.details ^ "\n" else "\n") ^ (move_to_string r.move) ^ (if r.items<>[] then "\nItems: " ^ capitalize (concat ", " (map fst r.items)) ^ "." else "") ^ (if r.people<>[] then "\nPeople: " ^ capitalize (concat ", " (map fst r.people)) ^ ".\n" else "\n")
let update_adjacent rm =
 let alter_adjacent f d r g = if (g=d) then r else f g in
 all_dirs (fun d -> match (rm.move d) with
 Some r -> r.move <- alter_adjacent r.move (opposite d) (Some rm) | None -> ())

type anywheres = { opens : item -> action option; // Partial functions from items to what happens when you open them
                  //time : int -> action option; // Partial function from number of moves passed to what happens (will have reset timer action later). Not yet implemented.
                  combine : item -> item -> action option; // Partial function from item pairs to what happens when you combine them
                  use : item -> action option; // Partial function from item to what happens if you attempt to use them, wherever you are.
                  examine : item -> string } // Function from items to their description. If this is empty undefined behaviour may occur (see "uses.")

type character = { mutable rm : room; // Room the character is currently in
                   mutable inv : item list; // The character's current inventory
                   mutable tags : tag list; // The character's current state (closed world assumption)
                   anywhere : anywheres} // A link to the things the character may do anywhere

type input = Go of direction
           | Quit
           | Look
           | Null
           | PickUp of item
           | Inventory
           | Examine of item
           | Open of item
           | Use of item
           | Talk of string
           | Combine of item * item
           | Decision of int // For use in conversations - e.g. "say 5"

type mode = Normal | Talking

(* MAIN ENGINE *)

let run c out = // run :: (string -> input) -> ()
 
 let str = ref (room_to_string c.rm) in // String representing the output of this 'round'
 let mode = ref Normal in // Current mode (talking or normal)
 
 let conversation = ref [] in // Current conversation going on (if any)
 let person = ref "" in // Person you are currently talking to (if any)
 let acts = ref [] in // Current list of decisions (if any)
 
 let do_autos do_action = concat "" (map (fun x -> match c.rm.autos x with None -> "" | Some (r,s) -> do_action r; s) c.tags) in // Does things asked to be done automatically in that room
 
 let rec do_action act = match act with // Executes a given action
     RoomChange (t, r) -> let rec rem_dups x = match x with x::xs -> let r = rem_dups xs in if mem x r then r else x::r | [] -> [] in
                     update_adjacent r; r.items <- rem_dups(append r.items t.items); if (c.rm=t) then c.rm <- r
   | SetItem (i, b) -> if b then c.inv <- i :: c.inv else c.inv <- filter (fun r -> r<>i) c.inv
   | SetTag (i, b) -> if b then c.tags <- i :: c.tags else c.tags <- filter (fun r -> r<>i) c.tags
   | Teleport r -> c.rm <- r; ignore(do_autos do_action)
   | Composite actions -> List.iter (fun x -> do_action x) actions
   | Nothing -> () in

 let rec do_conv() =  let mem_opt a bs = match a with Some t -> if mem t bs then true else false | None -> true in match !conversation with // Moves on to the next line of a conversation
     (Auto (who,text,tag,item,act)) :: cs -> conversation := cs;
       (if mem_opt tag c.tags && mem_opt item c.inv then begin (match act with Some (r,s) -> do_action r | None -> ());
       (if who then "You: " else !person ^ ": ") ^ text ^ "\n" end else "") ^ do_conv()
   | (Choice ds) :: cs ->
       let map_nats f xs = let rec nats x y = if x = y then [] else x :: nats (x+1) y in map (fun (n,x) -> f x n) (combine (nats 1 (List.length xs+1)) xs) in
       let ds = map (fun (a,b,c,d) -> (c,d)) (filter (fun (tag,item,text,action) -> mem_opt tag c.tags && mem_opt item c.inv) ds) in
       let es = map_nats (fun (r,act) n -> ("(" ^ string_of_int n ^ ") " ^ r,act)) ds in acts := es; concat "\n" (map fst es) ^ "\n"
   | [] -> mode := Normal; "The conversation ends.\n" in

 // Main Loop
 while (true) do str := do_autos do_action ^
  (let rs = out (!str) in (if !mode = Normal then begin match rs with
    Go d -> let nrm = c.rm.move d in (match nrm with
               None -> "You cannot go in that direction from here.\n"
             | Some r -> c.rm <- r; do_autos do_action ^ "\n" ^ room_to_string c.rm)
  | Look -> room_to_string c.rm
  | PickUp itm -> if mem_assoc itm c.rm.items then begin
            c.inv <- itm :: c.inv;
            let s = (match assoc itm c.rm.items with None -> "" | Some (r,s) -> do_action r;s) in
            c.rm.items <- remove_assoc itm c.rm.items; s ^           
            itm ^ " picked up.\n"
            end else "No item of that name in the room.\n"
  | Inventory -> "Inventory: " ^ capitalize (concat ", " c.inv) ^ ".\n"
  | Use itm -> if mem itm c.inv || c.anywhere.examine itm = "" then begin
         match c.rm.uses itm with
           None -> (match c.anywhere.use itm with
                Some (act,str) -> do_action act; str^ "\n"
              | None -> if c.anywhere.examine itm = "" then "No item of that name in your inventory.\n" else "That item has no use here.\n")
         | Some (act,str) -> do_action act; str ^ "\n";
         end else "No item of that name in your inventory.\n"
  | Open itm -> if mem itm c.inv then begin
         match c.anywhere.opens itm with None -> "This item is not openable.\n" | Some (r,s) -> do_action r; s ^ "\n"
         end else "No item of that name in your inventory.\n"
  | Quit -> exit 0
  | Combine (i,j) -> if (mem i c.inv && mem j c.inv) then
         match c.anywhere.combine i j with Some (r,s) -> do_action r; s ^ "\n"| None ->
         match c.anywhere.combine j i with Some(r,s) -> do_action r; s ^ "\n" | None -> "You cannot combine these items.\n"
         else "You do not have one or both of those items in your inventory.\n"
  | Talk p -> if mem_assoc p c.rm.people then (person := capitalize p; conversation := assoc p c.rm.people; mode := Talking; "You engage in conversation with " ^ p ^ ".\n") else "There is no such person here.\n"
  | Examine itm -> if mem itm c.inv then c.anywhere.examine itm ^ "\n" else "No such item available.\n"
  | Decision n -> "This is not the right time to be typing numbers in.\n"
  | Null -> "Instruction not recognised.\n"
 end else "") ^ (if !mode = Talking then (if !acts = [] then do_conv() else "") ^
   (match rs with
    Decision n -> if n < List.length !acts + 1 then (
           conversation := tl !conversation;
           (match snd(nth (!acts) (n-1)) with None ->  acts := [];"" | Some (r,s) -> do_action r;acts := [];s) ^ do_conv())
        else ""
      | _ -> "")
  else ""))
 
 done

(* INTERFACE *)

let parse s = match lowercase s with "up" -> Go Up | "down" -> Go Down | "quit" -> Quit | "look" -> Look | "south" -> Go South | "north" -> Go North | "east" -> Go East | "west" -> Go West | "q" -> Quit | "inv" -> Inventory | s ->
 try
 begin
 if sub s 0 3 = "use" then let item = sub s 4 ((length s)-4) in Use item else
 if sub s 0 3 = "say" then let item = sub s 4 ((length s)-4) in Decision (int_of_string item) else
 if sub s 0 4 = "open" then let item = sub s 5 ((length s)-5) in Open item else
 if sub s 0 4 = "talk" then let person = sub s 5 ((length s)-5) in Talk person else
 if sub s 0 6 = "pickup" then let item = sub s 7 ((length s)-7) in PickUp item else
 if sub s 0 7 = "examine" then let item = sub s 8 ((length s)-8) in Examine item else
 if sub s 0 7 = "combine" then try
    let items = sub s 8 ((length s)-8) in
    let r = index items ':' in
    let item1 = sub items 0 r in
    let item2 = sub items (r+1) ((length items)-r-1) in Combine (item1,item2) with IndexOutOfRangeException -> Null else Null
 end with Invalid_argument _ -> Null
 
(* MAIN METHOD *)

let go c = run c (fun s -> print_string (s ^ ">"); parse(read_line()))