Source

hack-and-slash / state.ml

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

module Player = struct
  module Export = struct
    type _player = { pos: Vec.t
                   ; steps: int
                   }
    with sexp, bin_io
  end
  open Export

  type t = _player with sexp, bin_io

  let step t dir =
    let pos = Vec.add (Direction.to_vec dir) t.pos in
    { pos; steps = t.steps + 1 }

end
open Player.Export

module Game_state = struct

  module Export = struct
    type winners = { players: Player_name.t list
                   ; max_steps: int
                   }
    with sexp, bin_io
    type _game_state =
      | Playing
      | Game_over of winners
    with sexp, bin_io
  end
  open Export

  type t = _game_state with sexp, bin_io
end
open Game_state.Export

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

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

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

let new_game t =
  let players = Map.keys t.players in
  let t = { players = Player_name.Map.empty
          ; max_x = t.max_x
          ; max_y = t.max_y
          ; game_state = Playing
          }
  in
  List.fold ~init:t players ~f:register_player

let find_winners t =
  Map.to_alist t.players
  |> List.map ~f:(fun (pn,ps) -> (ps.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 update_on_win t =
  match t.game_state with
  | Game_over _ -> t
  | Playing ->
    match find_winners t with
    | [] -> t
    | players ->
      let max_steps =
        Map.data t.players
        |> List.map ~f:(fun p -> p.steps)
        |> List.fold ~init:0 ~f:Int.max
      in
      { t with game_state = Game_over { players; max_steps } }

let status t pn =
  match t.game_state with
  | Game_over winners ->
    let names = List.map ~f:Player_name.to_string winners.players in
    String.concat ["winners: ";String.concat ~sep:" " names;"; max steps: "
                   ;Int.to_string winners.max_steps]
    |> Update.of_string
  | Playing ->
    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.pos ps'.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 if_playing t f =
  match t.game_state with
  | Game_over _ -> (t,Update.of_error_string "GAME OVER")
  | Playing -> f ()

let act t pname action =
  match Map.find t.players pname with
  | None ->
    (t,Update.of_string "Unknown player")
  | Some player ->
    let (t,update) =
      match action with
      | Move d ->
        if_playing t (fun () ->
          let player' = Player.step player d in
          let players' = Map.add t.players ~key:pname ~data:player' in
          ({ t with players = players' }, Update.empty))
      | Status ->
        (t, status t pname)
      | New_game ->
        (new_game t, Update.empty)
    in
    (update_on_win t, update)