Commits

Yaron Minsky committed c52353c

initial import

  • Participants

Comments (0)

Files changed (18)

+syntax: glob
+*~
+_build
+open Core.Std
+open Direction.Export
+
+module Export = struct
+  type _action =
+    | Move of Direction.t
+    | Display
+  with sexp, bin_io
+end
+
+type t = Export._action =
+  | Move of Direction.t
+  | Display
+with sexp, bin_io
+
+let to_line = function
+  | Move d ->
+    begin match d with
+    | Up    -> "u"
+    | Down  -> "d"
+    | Left  -> "l"
+    | Right -> "r"
+    end
+  | Display -> "display"
+
+let of_line l =
+  match String.strip l |> String.lowercase with
+  | "u" -> Ok (Move Up)
+  | "d" -> Ok (Move Down)
+  | "l" -> Ok (Move Left)
+  | "r" -> Ok (Move Right)
+  | "display" -> Ok (Display)
+  | s -> error "Unknown action" s
+           <:sexp_of<string>>
+
+open Core.Std
+
+module Export : sig
+  type _action =
+    | Move of Direction.t
+    | Display
+end
+
+type t = Export._action =
+  | Move of Direction.t
+  | Display
+with sexp, bin_io
+
+val to_line : t -> string
+val of_line : string -> t Or_error.t

File build_all.sh

+#!/usr/bin/env bash
+
+corebuild -pkg async main.native

File direction.ml

+open Core.Std
+open Vec.Export
+
+module Export = struct
+  type _direction =
+    | Up | Down | Left | Right
+  with sexp, bin_io
+end
+
+type t = Export._direction =
+  | Up | Down | Left | Right
+with sexp, bin_io
+
+let to_vec = function
+  | Up    -> vec   0    1
+  | Down  -> vec   0  (-1)
+  | Left  -> vec (-1)   0
+  | Right -> vec   1    0

File direction.mli

+open Core.Std
+
+module Export : sig
+  type _direction = Up | Down | Left | Right
+end
+
+type t = Export._direction = Up | Down | Left | Right with sexp, bin_io
+
+val to_vec : t -> Vec.t
+open Core.Std
+
+let () =
+  Command.group
+    ~summary:"The Ultimate Tank tool"
+    [ "server", Server.command
+    ]
+  |> Command.run
+/Users/yminsky/Documents/code/tank/_build/main.native

File player_name.ml

+open Core.Std
+
+include String
+let of_string s = String.strip s

File player_name.mli

+open Core.Std
+
+type t with sexp, bin_io
+val of_string : string -> t
+include Comparable.S_binable with type t := t
+
+
+open Core.Std
+open Async.Std
+
+let send_update w u =
+  match Update.to_line u with
+  | None -> Deferred.unit
+  | Some l ->
+    Writer.write w l;
+    Writer.flushed w
+
+let run ~port =
+  let state = ref (State.create ()) in
+  let host_and_port =
+    Tcp.Server.create
+      ~on_handler_error:`Raise
+      (Tcp.on_port port)
+      (fun _addr r w ->
+         Reader.read_line r
+         >>= function
+           | `Eof -> Deferred.unit
+           | `Ok pname ->
+             let pname = Player_name.of_string pname in
+             state := State.register_player !state pname;
+             let rec loop () =
+               Reader.read_line r >>= function
+                 | `Eof -> Deferred.unit
+                 | `Ok line ->
+                   begin match Action.of_line line with
+                   | Error e ->
+                     let u = Update.of_error e in
+                     send_update w u
+                   | Ok action ->
+                     let (state',u) = State.act !state pname action in
+                     state := state';
+                     send_update w u
+                   end
+                   >>= fun () ->
+                   loop ()
+             in
+             loop ()
+      )
+  in
+  ignore (host_and_port : (Socket.Address.Inet.t, int) Tcp.Server.t Deferred.t);
+  Deferred.never ()
+
+let command =
+  let default_port = 12323 in
+  Command.async_basic
+    ~summary:"Start the server"
+    Command.Spec.(
+      empty
+      +> flag "-port" (optional_with_default default_port int)
+        ~doc:(sprintf " Port to listen on (default %d)" default_port)
+    )
+    (fun port () -> run ~port)
+
+open Core.Std
+
+val command : Command.t
+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 = 100
+  ; max_y = 100
+  }
+
+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 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)
+    | Display ->
+      (t, sexp_of_t t |> Sexp.to_string |> Update.of_string)
+
+
+(** The state of the game *)
+
+open Core.Std
+
+type t with sexp, bin_io
+
+(** Creates a fresh game state *)
+val create : unit -> t
+
+(** Apply a player action to the state, possibly creating an update to return to
+    the player *)
+val act : t -> Player_name.t -> Action.t -> t * Update.t
+
+(** Add a new player, if the player is not already present.  Does nothing if the
+    player is already there. *)
+val register_player : t -> Player_name.t -> t
+open Core.Std
+
+type t = string option
+
+let escape_cr =
+  unstage (String.Escaping.escape ~escapeworthy:['\n'] ~escape_char:'\\')
+
+let of_string s = Some s
+
+let empty = None
+
+let of_error e =
+  Some ("ERROR: " ^ Error.to_string_hum e)
+
+let to_line t =
+  Option.map ~f:(fun s -> escape_cr s ^ "\n") t
+
+open Core.Std
+
+type t
+
+val of_string : string -> t
+val of_error : Error.t -> t
+val empty : t
+
+(** Returns an update as a single, ['\n']-terminated string  *)
+val to_line : t -> string option
+open Core.Std
+
+module Export = struct
+  type _vec = { x: int; y : int } with sexp, bin_io
+  let vec x y = { x; y }
+end
+
+type t = Export._vec = { x: int; y: int } with sexp, bin_io
+
+let add t1 t2 =
+  { x = t1.x + t2.x
+  ; y = t1.y + t2.y
+  }
+open Core.Std
+
+module Export : sig
+  type _vec = { x: int; y : int }
+  val vec : int -> int -> _vec
+end
+
+type t = Export._vec = { x: int; y: int } with sexp, bin_io
+
+val add : t -> t -> t