make wheat an entity

src/entity.ml

@@ -1,12 +1,13 @@
 type _ t =
   | Sheep : int -> [> `S ] t
   | Fairy : int -> [> `F ] t
+  | Wheat : int -> [> `W ] t
 
 (* todo move to State? *)
 type tbl =
   { mutable count : int
-  ; positions : ([ `S | `F ] t, Map.position) Hashtbl.t
+  ; positions : ([ `S | `F | `W ] t, Map.position) Hashtbl.t
-  ; positions' : (int * int, [ `S | `F ] t) Hashtbl.t
+  ; positions' : (int * int, [ `S | `F | `W ] t) Hashtbl.t
   ; manas : ([ `F ] t, int) Hashtbl.t
   }
 
@@ -20,11 +21,13 @@ let init_tbl () =
 let pp fmt tbl entity =
   let pos = Hashtbl.find tbl.positions entity in
   match entity with
+  | Wheat id -> Format.fprintf fmt "Wheat %d: %a" id Map.pp_position pos
   | Sheep id -> Format.fprintf fmt "Sheep %d: %a" id Map.pp_position pos
   | Fairy id as fairy ->
     let mana = Hashtbl.find tbl.manas fairy in
     Format.fprintf fmt "Fairy %d : mana = %d, %a" id mana Map.pp_position pos
 
+(* todo refacto make_* , hange to spawn_* ? *)
 let make_sheep tbl ~x ~y =
   let entity = Sheep tbl.count in
   tbl.count <- tbl.count + 1;
@@ -36,6 +39,17 @@ let make_sheep tbl ~x ~y =
   Hashtbl.replace tbl.positions' (pos.x, pos.y) entity;
   entity
 
+let make_wheat tbl ~x ~y =
+  let entity = Wheat tbl.count in
+  tbl.count <- tbl.count + 1;
+  let pos =
+    Map.{ x; y; offset_x = 0.; offset_y = 0.; dir = Obj.magic (x * y mod 4) }
+  in
+  (* todo unsafe position could be taken already *)
+  Hashtbl.replace tbl.positions entity pos;
+  Hashtbl.replace tbl.positions' (pos.x, pos.y) entity;
+  entity
+
 let make_fairy tbl ~x ~y =
   let entity = Fairy tbl.count in
   tbl.count <- tbl.count + 1;
@@ -85,4 +99,4 @@ let set_mana tbl id n = Hashtbl.replace tbl.manas id n
 (* todo better name *)
 let get_entity tbl ~x ~y = Hashtbl.find_opt tbl.positions' (x, y)
 
-let id = function Sheep id | Fairy id -> id
+let id = function Sheep id | Fairy id | Wheat id -> id

src/island_client.ml

@@ -88,7 +88,6 @@ let draw_canvas =
           | Grass -> grass
           | Water -> water
           | Black -> water
-          | Wheat -> wheat
         in
         C2d.draw_image context tile_img ~x:tile_x ~y:tile_y;
         begin
@@ -97,7 +96,10 @@ let draw_canvas =
           | Some e ->
             if e <> player then
               let tile_img =
-                match e with Sheep _ -> sheep | Fairy _ -> papy_up
+                match e with
+                | Sheep _ -> sheep
+                | Fairy _ -> papy_up
+                | Wheat _ -> wheat
               in
               C2d.draw_image context tile_img ~x:tile_x ~y:tile_y
         end
@@ -244,7 +246,7 @@ let rec game_loop state last_auto_update timestamp =
     if should_auto_update then timestamp else last_auto_update
   in
   apply_last_key state;
-  let state =
+
   (* apply queue of actions *)
   Queue.iter (State.perform_action state) to_apply_queue;
   Queue.clear to_apply_queue;
@@ -252,8 +254,9 @@ let rec game_loop state last_auto_update timestamp =
   Queue.iter (send_action state) input_queue;
   Queue.clear input_queue;
   (* state auto update *)
-    if should_auto_update then State.auto_update state else state
+  begin
-  in
+    if should_auto_update then State.auto_update state
+  end;
   G.request_animation_frame (game_loop state last_auto_update)
 
 let () =

src/map.ml

@@ -8,7 +8,6 @@ type background =
   | Grass
   | Water
   | Black
-  | Wheat
 
 let pp_dir fmt dir =
   let s =
@@ -22,11 +21,7 @@ let pp_dir fmt dir =
 
 let pp_background fmt b =
   let s =
-    match b with
+    match b with Grass -> "Grass" | Water -> "Water" | Black -> "Black"
-    | Grass -> "Grass"
-    | Water -> "Water"
-    | Black -> "Black"
-    | Wheat -> "Wheat"
   in
   Format.pp_print_string fmt s
 
@@ -52,19 +47,6 @@ type t =
 let get_tile_kind ~x ~y map =
   try map.tiles.(x).(y) with Invalid_argument _ -> Black
 
-let count_wheat map =
-  Array.fold_left
-    (fun count a ->
-      let count' =
-        Array.fold_left
-          (fun count -> function
-            | Wheat -> succ count
-            | Black | Grass | Water -> count )
-          0 a
-      in
-      count + count' )
-    0 map
-
 let check_move map ({ x; y; _ } as pos) movement_dir =
   let x, y =
     match movement_dir with
@@ -76,7 +58,7 @@ let check_move map ({ x; y; _ } as pos) movement_dir =
   match get_tile_kind ~x ~y map with
   | (Black | Water) as bg ->
     Error (Format.asprintf "can't move on %a" pp_background bg)
-  | Grass | Wheat -> Ok { pos with x; y }
+  | Grass -> Ok { pos with x; y }
 
 let n = 50
 

src/pellest.ml

@@ -11,7 +11,9 @@ let update_offline_user_state () =
 
 let update_online_user_state () =
   Hashtbl.filter_map_inplace
-    (fun _user_id state -> Some (Shared.State.auto_update state))
+    (fun _user_id state ->
+      Shared.State.auto_update state;
+      Some state )
     User.state_ht
 
 let to_repeat () =

src/state.ml

@@ -39,7 +39,7 @@ end
 
 type t =
   { map : Map.t
-  ; wheat : int
+  ; mutable wheat : int
   ; player : [ `F ] Entity.t
   ; tbl : Entity.tbl
   }
@@ -58,16 +58,16 @@ let init () =
 type action =
   | Meditate
   (* TODO some action do not needs to be checked by server *)
-  | Move_offset of ([ `S | `F ] Entity.t * Map.dir)
+  | Move_offset of ([ `S | `F | `W ] Entity.t * Map.dir)
-  | Move of ([ `S | `F ] Entity.t * Map.dir)
+  | Move of ([ `S | `F | `W ] Entity.t * Map.dir)
   | Plant_wheat
 (* TODO: we don't need dir so we should change the type of Map.position *)
 
 (* type for result of action send to the client by the server *)
 type action' =
   | Add_mana of ([ `F ] Entity.t * int)
-  | Set_position of ([ `S | `F ] Entity.t * Map.position)
+  | Set_position of ([ `S | `F | `W ] Entity.t * Map.position)
-  | Set_offset of ([ `S | `F ] Entity.t * (float * float))
+  | Set_offset of ([ `S | `F | `W ] Entity.t * (float * float))
   | Spawn_wheat of int * int
 
 let pp_action fmt = function
@@ -128,11 +128,17 @@ let rec check_action state = function
     match Map.get_tile_kind ~x ~y state.map with
     | Map.Black -> Error "can't plant wheat in space !"
     | Water -> Error "can't plant wheat in water !"
-    | Wheat -> Error "there's already some wheat there !"
+    | Grass -> (
-    | Grass ->
+      match Entity.get_entity state.tbl ~x ~y with
+      | Some other_entity ->
+        let pp fmt = Entity.pp fmt state.tbl in
+        Error
+          (Format.asprintf "there's already another entity (%a) there !" pp
+             other_entity )
+      | None ->
         if Entity.get_mana state.tbl state.player >= plant_wheat_cost then
           Ok [ Spawn_wheat (x, y); Add_mana (state.player, -plant_wheat_cost) ]
-      else Error "not enough mana..." )
+        else Error "not enough mana..." ) )
 
 (* TODO imutable state? *)
 let perform_action state = function
@@ -141,7 +147,10 @@ let perform_action state = function
     Entity.set_mana state.tbl e (old_mana + n)
   | Set_position (e, pos) -> Entity.set_pos state.tbl e pos
   | Set_offset (e, offset) -> Entity.set_offset state.tbl e offset
-  | Spawn_wheat (x, y) -> state.map.tiles.(x).(y) <- Map.Wheat
+  | Spawn_wheat (x, y) ->
+    state.wheat <- state.wheat + 1;
+    let _w : [> `W ] Entity.t = Entity.make_wheat state.tbl ~x ~y in
+    ()
 
 let auto_update state =
   (* mut state *)
@@ -150,9 +159,8 @@ let auto_update state =
     | Error _e -> ()
     | Ok actions -> List.iter (perform_action state) actions
   end;
-  let count_wheat = Map.count_wheat state.map.tiles in
   (* TODO simulate animals *)
-  { state with wheat = state.wheat + count_wheat }
+  ()
 
 let auto_update_rate = Time.mk_s 1