wip: animals

.ocamlformat

@@ -1,4 +1,4 @@
-version=0.24.1
+version=0.25.1
 assignment-operator=end-line
 break-cases=fit
 break-fun-decl=wrap

src/animal.ml

@@ -0,0 +1,62 @@
+type fairy =
+  { mana : int
+  ; pos : Map.position
+  }
+
+type t =
+  | Sheep of { pos : Map.position }
+  | Fairy of fairy
+
+let pp fmt = function
+  | Sheep o -> Format.fprintf fmt "Sheep: %a" Map.pp_position o.pos
+  | Fairy o ->
+    Format.fprintf fmt "Fairy : mana = %d, %a" o.mana Map.pp_position o.pos
+
+let make_sheep ~x ~y =
+  Sheep
+    { pos =
+        Map.
+          { x; y; offset_x = 0.; offset_y = 0.; dir = Obj.magic (x * y mod 4) }
+    }
+
+let make_fairy ~x ~y =
+  { mana = 1; pos = Map.{ x; y; offset_x = 0.; offset_y = 0.; dir = Down } }
+
+let pos = function Sheep o -> o.pos | Fairy o -> o.pos
+
+let set_pos pos = function
+  | Sheep _o -> Sheep { pos }
+  | Fairy o -> Fairy { o with pos }
+
+module Herd = struct
+  (* ... or just use a mutable state and a hashtbl? *)
+  module IntMap = Stdlib.Map.Make (struct
+    type t = int
+
+    let compare = Int.compare
+  end)
+
+  type nonrec t = t IntMap.t
+
+  let find_opt = IntMap.find_opt
+
+  let update = IntMap.update
+
+  let iter = IntMap.iter
+
+  let init map =
+    List.init 50 (fun _i ->
+        let x = Random.int map.width in
+        let y = Random.int map.height in
+        (x, y) )
+    |> List.filter (fun (x, y) -> Map.get_tile_kind ~x ~y map = Grass)
+    |> List.mapi (fun i (x, y) -> (i, make_sheep ~x ~y))
+    |> List.to_seq |> IntMap.of_seq
+
+  let pp fmt o =
+    Format.fprintf fmt "[%a]"
+      (Format.pp_print_list
+         ~pp_sep:(fun _fmt () -> Format.pp_print_string fmt "; ")
+         pp )
+      (IntMap.to_seq o |> List.of_seq |> List.map snd)
+end

src/dune

@@ -45,7 +45,7 @@
 
 (library
  (name shared)
- (modules log map network state time)
+ (modules animal log map network state time)
  (libraries))
 
 (rule

src/island.ml

@@ -43,6 +43,7 @@ let get request =
          ; "papy_up"
          ; "water"
          ; "wheat"
+         ; "sheep"
          ]
   in
 

src/island_client.ml

@@ -53,6 +53,8 @@ let water = C2d.image_src_of_el (get_el "water")
 
 let wheat = C2d.image_src_of_el (get_el "wheat")
 
+let sheep = C2d.image_src_of_el (get_el "sheep")
+
 let draw_canvas =
   let offset_conv =
     let m = float_of_int @@ (tile_size / 2) in
@@ -66,14 +68,16 @@ let draw_canvas =
     let open State in
     (* TODO: it could be possible to optimize starting/ending index by looking at the offset *)
     for x = -2 to tiles_per_w + 1 do
-      let map_x = x + state.player_pos.x - half_tiles_per_w in
+      let map_x = x + state.player.pos.x - half_tiles_per_w in
       let tile_x =
-        float_of_int ((x * tile_size) + orig_x) +. offset_conv state.offset_x
+        float_of_int ((x * tile_size) + orig_x)
+        +. offset_conv state.player.pos.offset_x
       in
       for y = -2 to tiles_per_h + 1 do
-        let map_y = y + state.player_pos.y - half_tiles_per_h in
+        let map_y = y + state.player.pos.y - half_tiles_per_h in
         let tile_y =
-          float_of_int ((y * tile_size) + orig_y) +. offset_conv state.offset_y
+          float_of_int ((y * tile_size) + orig_y)
+          +. offset_conv state.player.pos.offset_y
         in
         let tile_img =
           match Map.get_tile_kind ~x:map_x ~y:map_y state.map with
@@ -82,11 +86,18 @@ let draw_canvas =
           | Black -> water
           | Wheat -> wheat
         in
-        C2d.draw_image context tile_img ~x:tile_x ~y:tile_y
+        C2d.draw_image context tile_img ~x:tile_x ~y:tile_y;
+        (* TODO *)
+        Herd.iter
+          (fun _v k ->
+            let pos = Animal.pos k in
+            if pos.x = map_x && pos.y = map_y then
+              C2d.draw_image context sheep ~x:tile_x ~y:tile_y )
+          state.animals
       done
     done;
     let papy =
-      match state.player_pos.dir with
+      match state.player.pos.dir with
       | Left -> papy_left
       | Right -> papy_right
       | Down -> papy_down
@@ -98,7 +109,7 @@ let draw_topbar state =
   (* draw mana level *)
   let mana_lvl = Jv.get Jv.global "mana_lvl" in
   Jv.set mana_lvl "innerHTML"
-    (Jv.of_string @@ string_of_int state.Shared.State.mana);
+    (Jv.of_string @@ string_of_int state.Shared.State.player.mana);
   (* draw wheat level *)
   let wheat_lvl = Jv.get Jv.global "wheat_lvl" in
   Jv.set wheat_lvl "innerHTML" (Jv.of_string @@ string_of_int state.wheat)
@@ -121,7 +132,8 @@ let send_action state = function
   end
   *)
   (* actions we want to send to the server *)
-  | (State.Move_offset _ | Move _ | Meditate | Plant_wheat) as action -> (
+  | (State.Move_offset _ | Move _ | Animal_move _ | Meditate | Plant_wheat) as
+    action -> (
     match State.check_action state action with
     | Error e ->
       (* TODO: display this in the window *)

src/map.ml

@@ -30,14 +30,24 @@ let pp_background fmt b =
   in
   Format.pp_print_string fmt s
 
-type position =
+type simple_position =
   { x : int
   ; y : int
   ; dir : dir
   }
 
+type position =
+  { x : int
+  ; y : int
+  ; offset_x : float
+  ; offset_y : float
+  ; dir : dir
+  }
+
 let pp_position fmt p =
-  Format.fprintf fmt "(x = %d; y = %d; dir = %a)" p.x p.y pp_dir p.dir
+  Format.fprintf fmt
+    "(x = %d; y = %d; offset_x = %03f; offset_y = %03f; dir = %a)" p.x p.y
+    p.offset_x p.offset_y pp_dir p.dir
 
 type t =
   { tiles : background array array

src/state.ml

@@ -37,22 +37,21 @@ end = struct
       else (x, y', None)
 end
 
+module Herd = Animal.Herd
+
 type t =
   { map : Map.t
-  ; mana : int
   ; wheat : int
-  ; player_pos : Map.position
-  ; offset_x : float
-  ; offset_y : float
+  ; player : Animal.fairy
+  ; animals : Herd.t
   }
 
 let init () =
-  { map = Map.init ()
-  ; mana = 0
+  let map = Map.init () in
+  { map
   ; wheat = 0
-  ; player_pos = { x = 0; y = 0; dir = Down }
-  ; offset_x = 0.
-  ; offset_y = 0.
+  ; player = Animal.make_fairy ~x:0 ~y:0
+  ; animals = Herd.init map
   }
 
 type action =
@@ -60,6 +59,7 @@ type action =
   (* TODO some action do not needs to be checked by server *)
   | Move_offset of Map.dir
   | Move of Map.dir
+  | Animal_move of int * Map.dir
   | Plant_wheat
 (* TODO: we don't need dir so we should change the type of Map.position *)
 
@@ -67,6 +67,7 @@ type action =
 type action' =
   | Add_mana of int
   | Set_player_position of Map.position
+  | Set_animal_position of (int * Map.position)
   | Set_offset of float * float
   | Plant_wheat of int * int
 
@@ -74,12 +75,16 @@ let pp_action fmt = function
   | Meditate -> Format.pp_print_string fmt "Meditate"
   | Move_offset dir -> Format.fprintf fmt "Move_offset %a" Map.pp_dir dir
   | Move dir -> Format.fprintf fmt "Move %a" Map.pp_dir dir
+  | Animal_move (id, dir) ->
+    Format.fprintf fmt "Animal_move %d %a" id Map.pp_dir dir
   | Plant_wheat -> Format.fprintf fmt "Plant_wheat"
 
 let pp_action' fmt = function
   | Add_mana n -> Format.fprintf fmt "Add_mana %d" n
   | Set_player_position pos ->
     Format.fprintf fmt "Set_player_position (%a)" Map.pp_position pos
+  | Set_animal_position (id, pos) ->
+    Format.fprintf fmt "Set_animal_position (%d,%a)" id Map.pp_position pos
   | Set_offset (x, y) -> Format.fprintf fmt "Set_offset (%f, %f)" x y
   | Plant_wheat (x, y) -> Format.fprintf fmt "Plant_wheat (%d, %d)" x y
 
@@ -87,20 +92,28 @@ let plant_wheat_cost = 10
 
 let rec check_action state = function
   | Meditate ->
-    if state.mana < 99 then Ok [ Add_mana 1 ] else Error "maximum mana"
+    if state.player.mana < 99 then Ok [ Add_mana 1 ] else Error "maximum mana"
   | Move dir -> (
-    match Map.check_move state.map state.player_pos dir with
+    match Map.check_move state.map state.player.pos dir with
     | Error _e as error -> error
     | Ok pos -> Ok [ Set_player_position pos ] )
+  | Animal_move (id, dir) -> (
+    match Herd.find_opt id state.animals with
+    | None -> Error (Format.sprintf "unknown animal id: %d" id)
+    | Some animal -> (
+      match Map.check_move state.map (Animal.pos animal) dir with
+      | Error _e as error -> error
+      | Ok pos -> Ok [ Set_animal_position (id, pos) ] ) )
   | Move_offset dir ->
-    if dir <> state.player_pos.dir then
-      Ok [ Set_player_position { state.player_pos with dir } ]
+    if dir <> state.player.pos.dir then
+      Ok [ Set_player_position { state.player.pos with dir } ]
     else
       let offset_x, offset_y, dir' =
-        Offset.check_move ~x:state.offset_x ~y:state.offset_y dir
+        Offset.check_move ~x:state.player.pos.offset_x
+          ~y:state.player.pos.offset_y dir
       in
       let offset_action =
-        [ Set_player_position { state.player_pos with dir }
+        [ Set_player_position { state.player.pos with dir }
         ; Set_offset (offset_x, offset_y)
         ]
       in
@@ -114,7 +127,7 @@ let rec check_action state = function
         end
       end
   | Plant_wheat -> (
-    let { Map.x; y; dir } = state.player_pos in
+    let { Map.x; y; dir; _ } = state.player.pos in
     let x, y =
       match dir with
       | Down -> (x, y + 1)
@@ -127,16 +140,27 @@ let rec check_action state = function
     | Water -> Error "can't plant wheat in water !"
     | Wheat -> Error "there's already some wheat there !"
     | Grass ->
-      if state.mana >= plant_wheat_cost then Ok [ Plant_wheat (x, y) ]
+      if state.player.mana >= plant_wheat_cost then Ok [ Plant_wheat (x, y) ]
       else Error "not enough mana..." )
 
 let perform_action state = function
-  | Add_mana n -> { state with mana = state.mana + n }
-  | Set_player_position player_pos -> { state with player_pos }
-  | Set_offset (offset_x, offset_y) -> { state with offset_x; offset_y }
+  | Add_mana n ->
+    { state with player = { state.player with mana = state.player.mana + n } }
+  | Set_player_position pos -> { state with player = { state.player with pos } }
+  | Set_animal_position (id, pos) ->
+    { state with
+      animals = Herd.update id (Option.map (Animal.set_pos pos)) state.animals
+    }
+  | Set_offset (offset_x, offset_y) ->
+    { state with
+      player =
+        { state.player with pos = { state.player.pos with offset_x; offset_y } }
+    }
   | Plant_wheat (x, y) ->
     state.map.tiles.(x).(y) <- Map.Wheat;
-    { state with mana = state.mana - plant_wheat_cost }
+    { state with
+      player = { state.player with mana = state.player.mana - plant_wheat_cost }
+    }
 
 let auto_update state =
   let state =
@@ -145,12 +169,12 @@ let auto_update state =
     | Ok actions -> List.fold_left perform_action state actions
   in
   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
 
-let pp fmt { mana; wheat; player_pos; map; offset_x; offset_y } =
-  let bg = Map.get_tile_kind ~x:player_pos.x ~y:player_pos.y map in
-  Format.fprintf fmt
-    "mana = %d; wheat = %d; player_pos = %a; %a; offset_x = %f; offset_y = %f"
-    mana wheat Map.pp_position player_pos Map.pp_background bg offset_x offset_y
+let pp fmt { wheat; player; map; animals } =
+  let bg = Map.get_tile_kind ~x:player.pos.x ~y:player.pos.y map in
+  Format.fprintf fmt "wheat = %d; player = %a; %a; animals = %a" wheat Animal.pp
+    (Fairy player) Map.pp_background bg Herd.pp animals