Source

hack-and-slash / state.ml

Full commit
open Core.Std
open Vec.Export
open Direction.Export
open Action.Export

module Player = struct
  type t = { pos: Vec.t
           }
  with sexp, bin_io
end

type t =
  { players: Player.t Player_name.Map.t
  ; max_x: int
  ; max_y: int
  }
with sexp, bin_io

let create () =
  { players = Player_name.Map.empty
  ; max_x = 15
  ; max_y = 15
  }

let register_player t pname =
  let players' =
    Map.change t.players pname (function
      | None ->
        let player = { Player.
                       pos = vec (Random.int t.max_x) (Random.int t.max_y) }
        in
        Some player
      | Some _ as x -> x
    )
  in
  { t with players = players' }

let find_winners t =
  Map.to_alist t.players
  |> List.map ~f:(fun (pn,ps) -> (ps.Player.pos,pn))
  |> Vec.Map.of_alist_multi
  |> Map.to_alist
  |> List.filter ~f:(fun (_,players) -> List.length players > 1)
  |> List.map ~f:snd
  |> List.concat
  |> List.dedup

let status t pn =
  let winners = find_winners t in
  if not (List.is_empty winners) then
    let winners = List.map ~f:Player_name.to_string winners in
    Update.of_string ("WINNERS: " ^ String.concat ~sep:" " winners)
  else
    match Map.find t.players pn with
    | None -> Update.of_error_string "Unknown player"
    | Some ps ->
      Map.to_alist t.players
      |> List.filter ~f:(fun (pn',_) -> pn' <> pn)
      |> List.map ~f:(fun (pn',ps') ->
        let dist =
          Vec.manhattan_distance
            ps.Player.pos
            ps'.Player.pos
        in
        (pn',dist))
      |> List.map ~f:(fun (pn,d) -> Player_name.to_string pn ^ ":" ^ Int.to_string d)
      |> String.concat ~sep:","
      |> Update.of_string

let act t pname action =
  match Map.find t.players pname with
  | None ->
    (t,Update.of_string "Unknown player")
  | Some player ->
    match action with
    | Move d ->
      let delta = Direction.to_vec d in
      let player' = { Player. pos = Vec.add player.Player.pos delta } in
      let players' = Map.add t.players ~key:pname ~data:player' in
      ({ t with players = players' }, Update.empty)
    | Status ->
      (t, status t pname)