From 0377fab55bd5a1213c29bba29ad25b17bc942bb5 Mon Sep 17 00:00:00 2001 From: Swrup Date: Mon, 17 Jul 2023 19:40:18 +0200 Subject: [PATCH] make wheat an entity --- src/entity.ml | 20 +++++++++++++++++--- src/island_client.ml | 27 +++++++++++++++------------ src/map.ml | 22 ++-------------------- src/pellest.ml | 4 +++- src/state.ml | 34 +++++++++++++++++++++------------- 5 files changed, 58 insertions(+), 49 deletions(-) diff --git a/src/entity.ml b/src/entity.ml index 9854203..b385835 100644 --- a/src/entity.ml +++ b/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' : (int * int, [ `S | `F ] t) Hashtbl.t + ; positions : ([ `S | `F | `W ] t, Map.position) 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 diff --git a/src/island_client.ml b/src/island_client.ml index c34c1ff..83d9ad0 100644 --- a/src/island_client.ml +++ b/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,16 +246,17 @@ 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; - (* send input action to server *) - 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 - in + + (* apply queue of actions *) + Queue.iter (State.perform_action state) to_apply_queue; + Queue.clear to_apply_queue; + (* send input action to server *) + Queue.iter (send_action state) input_queue; + Queue.clear input_queue; + (* state auto update *) + begin + if should_auto_update then State.auto_update state + end; G.request_animation_frame (game_loop state last_auto_update) let () = diff --git a/src/map.ml b/src/map.ml index 662a5dd..6d2efb5 100644 --- a/src/map.ml +++ b/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 - | Grass -> "Grass" - | Water -> "Water" - | Black -> "Black" - | Wheat -> "Wheat" + match b with Grass -> "Grass" | Water -> "Water" | Black -> "Black" 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 diff --git a/src/pellest.ml b/src/pellest.ml index 9ee23fa..3d609dd 100644 --- a/src/pellest.ml +++ b/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 () = diff --git a/src/state.ml b/src/state.ml index bfb4012..7a8ccab 100644 --- a/src/state.ml +++ b/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 of ([ `S | `F ] Entity.t * Map.dir) + | Move_offset of ([ `S | `F | `W ] 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_offset of ([ `S | `F ] Entity.t * (float * float)) + | Set_position of ([ `S | `F | `W ] Entity.t * Map.position) + | 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 -> - 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..." ) + | 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..." ) ) (* 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