wip entity

src/dune

@@ -45,8 +45,8 @@
 
 (library
  (name shared)
- (modules map network state)
+ (modules entity map network state)
- (libraries))
+ (libraries uuidm))
 
 (rule
  (target content.ml)

src/entity.ml

@@ -0,0 +1,24 @@
+type kind =
+  | Papy
+  | Tree0
+  | Tree1
+  | Wheat
+
+type dir =
+  | Left
+  | Right
+  | Down
+  | Up
+
+type position = int * int * dir
+
+type t =
+  { kind : kind
+  ; id : Uuidm.t
+  ; position : position
+  ; mana : int
+  }
+
+let set_pos v e = { e with position = v }
+
+let set_mana v e = { e with mana = v }

src/island.ml

@@ -18,7 +18,16 @@ let get request =
   in
   let images =
     List.map mk_img
-      [ "grass"; "papy_left"; "papy_right"; "papy_down"; "papy_up"; "water" ]
+      [ "grass"
+      ; "papy_left"
+      ; "papy_right"
+      ; "papy_down"
+      ; "papy_up"
+      ; "water"
+      ; "tree0"
+      ; "tree1"
+      ; "wheat"
+      ]
   in
 
   let page = div ~a:[ a_class [ "centered" ] ] @@ (canvas :: images) in

src/island_client.ml

@@ -51,12 +51,37 @@ let papy_up = C2d.image_src_of_el (get_el "papy_up")
 
 let water = C2d.image_src_of_el (get_el "water")
 
+let tree0 = C2d.image_src_of_el (get_el "tree0")
+
+let tree1 = C2d.image_src_of_el (get_el "tree1")
+
+let wheat = C2d.image_src_of_el (get_el "wheat")
+
+(* TODO FIX *)
+let draw_entity context entity =
+  let e_x, e_y, e_dir = entity.Entity.position in
+  let tile_x = float_of_int ((e_x * tile_size) + orig_x) in
+  let tile_y = float_of_int ((e_y * tile_size) + orig_y) in
+  let img =
+    match entity.kind with
+    | Papy -> (
+      match e_dir with
+      | Left -> papy_left
+      | Right -> papy_right
+      | Down -> papy_down
+      | Up -> papy_up )
+    | Tree0 -> tree0
+    | Tree1 -> tree1
+    | Wheat -> wheat
+  in
+  C2d.draw_image context img ~x:tile_x ~y:tile_y
+
 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 state ->
     let open State in
-    let player_x, player_y, player_dir = state.player_pos in
+    let player_x, player_y, player_dir = state.papy.position 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
@@ -79,7 +104,9 @@ let draw =
       | Down -> papy_down
       | Up -> papy_up
     in
-    C2d.draw_image context papy ~x:papy_x ~y:papy_y
+    C2d.draw_image context papy ~x:papy_x ~y:papy_y;
+    (*draw_entity context state.papy;*)
+    List.iter (draw_entity context) state.entities
 
 (* queue for action to be done *)
 let input_queue = ref []

src/map.ml

@@ -1,16 +1,16 @@
-type dir =
+type dir = Entity.dir =
   | Left
   | Right
   | Down
   | Up
 
+type position = int * int * dir
+
 type background =
   | Grass
   | Water
   | Black
 
-type position = int * int * dir
-
 type t =
   { tiles : background array array
   ; width : int
@@ -29,18 +29,3 @@ let init () =
 
 let get_tile_kind ~x ~y map =
   try map.tiles.(x).(y) with Invalid_argument _ -> Black
-
-let check_move map entity_pos dir =
-  let x, y, current_dir = entity_pos in
-  let x, y =
-    if current_dir <> dir then (x, y)
-    else
-      match dir with
-      | Left -> (x - 1, y)
-      | Right -> (x + 1, y)
-      | Down -> (x, y + 1)
-      | Up -> (x, y - 1)
-  in
-  match get_tile_kind ~x ~y map with
-  | Black | Water -> Error "invalid terrain"
-  | Grass -> Ok (x, y, dir)

src/state.ml

@@ -1,10 +1,41 @@
 type t =
   { map : Map.t
-  ; mana : int
+  ; papy : Entity.t
-  ; player_pos : Map.position
+  ; entities : Entity.t list
   }
 
-let init () = { map = Map.init (); mana = 0; player_pos = (20, 3, Down) }
+let random_state = Random.State.make_self_init ()
+
+let init () =
+  let map = Map.init () in
+  let papy =
+    Entity.
+      { kind = Papy
+      ; id = Uuidm.v4_gen random_state ()
+      ; position = (20, 3, Down)
+      ; mana = 0
+      }
+  in
+  (* add trees *)
+  let tree_kind = if Random.bool () then Entity.Tree0 else Entity.Tree1 in
+  let entities =
+    let n = 5 * (map.width * map.height / 100) in
+    let ws = List.init n (fun _i -> Random.int map.width) in
+    let hs = List.init n (fun _i -> Random.int map.height) in
+    List.combine ws hs
+    |> List.filter (fun (x, y) ->
+           match Map.get_tile_kind ~x ~y map with
+           | Water | Black -> false
+           | Grass -> true )
+    |> List.map (fun (x, y) ->
+           Entity.
+             { kind = tree_kind
+             ; id = Uuidm.v4_gen random_state ()
+             ; position = (x, y, Up)
+             ; mana = 0
+             } )
+  in
+  { map; papy; entities }
 
 type action =
   | Meditate
@@ -16,14 +47,37 @@ type action' =
   | Add_mana of int
   | Set_player_position of Map.position
 
+let check_papy_move state dir =
+  let x, y, current_dir = state.papy.position in
+  let x, y =
+    if current_dir <> dir then (x, y)
+    else
+      match dir with
+      | Map.Left -> (x - 1, y)
+      | Right -> (x + 1, y)
+      | Down -> (x, y + 1)
+      | Up -> (x, y - 1)
+  in
+  match Map.get_tile_kind ~x ~y state.map with
+  | Black | Water -> Error "invalid terrain"
+  | Grass ->
+    if
+      List.exists
+        (fun e -> e.Entity.position = state.papy.position)
+        state.entities
+    then Error "invalid move, space is occupied"
+    else Ok (x, y, dir)
+
 let check_action state = function
   | Meditate ->
-    if state.mana < 99 then Ok (Add_mana 1) else Error "maximum mana"
+    if state.papy.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 check_papy_move state dir with
     | Error _e as error -> error
     | Ok pos -> Ok (Set_player_position pos) )
 
 let perform_action state = function
-  | Add_mana n -> { state with mana = state.mana + n }
+  | Add_mana n ->
-  | Set_player_position pos -> { state with player_pos = pos }
+    { state with papy = Entity.set_mana (state.papy.mana + n) state.papy }
+  | Set_player_position pos ->
+    { state with papy = Entity.set_pos pos state.papy }