do not send whole state on action

src/island_client.ml

@@ -51,11 +51,12 @@ let papy_up = C2d.image_src_of_el (get_el "papy_up")
 
 let water = C2d.image_src_of_el (get_el "water")
 
-let draw_map =
+let draw =
   let papy_x = float_of_int (width - tile_size) /. 2. in
   let papy_y = (float_of_int height /. 2.) -. (float_of_int tile_size *. 1.5) in
-  fun map ->
-    let player_x, player_y = map.Map.player_pos in
+  fun state ->
+    let open State in
+    let player_x, player_y, player_dir = state.player_pos in
     for x = 0 to tiles_per_w - 1 do
       let map_x = x + player_x - (tiles_per_w / 2) in
       let tile_x = float_of_int ((x * tile_size) + orig_x) in
@@ -63,7 +64,7 @@ let draw_map =
         let map_y = y + player_y - (tiles_per_h / 2) in
         let tile_y = float_of_int ((y * tile_size) + orig_y) in
         let tile_img =
-          match Map.get_tile_kind ~x:map_x ~y:map_y map with
+          match Map.get_tile_kind ~x:map_x ~y:map_y state.map with
           | Grass -> grass
           | Water -> water
           | Black -> water
@@ -72,7 +73,7 @@ let draw_map =
       done
     done;
     let papy =
-      match map.Map.player_dir with
+      match player_dir with
       | Left -> papy_left
       | Right -> papy_right
       | Down -> papy_down
@@ -80,19 +81,43 @@ let draw_map =
     in
     C2d.draw_image context papy ~x:papy_x ~y:papy_y
 
-let kb_handler state ev =
-  let move = Map.move !state.State.map in
-  match ev |> Ev.as_type |> Ev.Keyboard.code |> Jstr.to_string with
-  | "KeyW" | "ArrowUp" -> move Up
-  | "KeyA" | "ArrowLeft" -> move Left
-  | "KeyS" | "ArrowDown" -> move Down
-  | "KeyD" | "ArrowRight" -> move Right
-  | "KeyM" -> Ws_client.send State.Meditate
-  | _s -> ()
+(* queue for action to be done *)
+let input_queue = Queue.create ()
+
+(* queue for action' to apply to client state *)
+let to_apply_queue : State.action' Queue.t = Queue.create ()
+
+let send_action state action =
+  match State.check_action state action with
+  | Error e -> Format.printf "Invalid action: %s@\n" e
+  | Ok _ -> Ws_client.send (Network.Action_msg action)
+
+let kb_handler ev =
+  let open State in
+  let act =
+    match ev |> Ev.as_type |> Ev.Keyboard.code |> Jstr.to_string with
+    | "KeyW" | "ArrowUp" -> Move Up
+    | "KeyA" | "ArrowLeft" -> Move Left
+    | "KeyS" | "ArrowDown" -> Move Down
+    | "KeyD" | "ArrowRight" -> Move Right
+    | "KeyM" -> Meditate
+    | _s -> Do_nothing
+  in
+  Queue.add act input_queue
 
 let rec game_loop state _timestamp =
-  draw_map !state.State.map;
-  let new_state = state in
+  draw state;
+  let new_state =
+    (* TODO repesct order of action *)
+    (* apply to_apply_queue *)
+    let state = Queue.fold State.perform_action state to_apply_queue in
+    (* TODO can this bug because of concurrency? *)
+    Queue.clear to_apply_queue;
+    (* send input action to server *)
+    Queue.iter (send_action state) input_queue;
+    Queue.clear input_queue;
+    state
+  in
   G.request_animation_frame (game_loop new_state)
 
 let () =
@@ -106,16 +131,27 @@ let () =
   (* get state from server*)
   let initial_state_fut = Ev.next Message.Ev.message Ws_client.ws_target in
 
+  (* attach message listener to update state *)
+  Ws_client.on_update_state_message (fun server_msg ->
+      match server_msg with
+      | Full_state _state ->
+        (* TODO reset state to received state *)
+        Format.printf "received Full_state message@\n"
+      | Update_result res -> (
+        match res with
+        | Error e -> Format.printf "received update result error: %s" e
+        | Ok action' -> Queue.add action' to_apply_queue ) );
+  (* bind keys *)
+  let _e : Ev.listener =
+    Ev.listen Ev.keydown kb_handler (Window.as_target G.window)
+  in
+
   Fut.await initial_state_fut (fun msg ->
-      let initial_state = Ws_client.to_server_msg msg in
-      let state_ref = ref initial_state in
-      (* bind keys *)
-      let _e : Ev.listener =
-        Ev.listen Ev.keydown (kb_handler state_ref) (Window.as_target G.window)
-      in
-      (* attach message listener to update state *)
-      Ws_client.on_update_state_message (fun received ->
-          state_ref := received;
-          Format.printf "YOUR MANA IS: %d@." !state_ref.mana );
-      (* start game *)
-      G.request_animation_frame (game_loop state_ref) )
+      match Ws_client.to_server_msg msg with
+      | Update_result _res_msg ->
+        failwith
+          "invalid first server message received; received Update expected \
+           Full_state"
+      | Full_state state ->
+        (* start game *)
+        G.request_animation_frame (game_loop state) )