diff --git a/.ocamlformat b/.ocamlformat index c54116a..078d270 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version=0.24.1 +version=0.25.1 assignment-operator=end-line break-cases=fit break-fun-decl=wrap diff --git a/src/animal.ml b/src/animal.ml new file mode 100644 index 0000000..473f96b --- /dev/null +++ b/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 diff --git a/src/content/assets/img/sheep.png b/src/content/assets/img/sheep.png new file mode 100644 index 0000000..7ba231a Binary files /dev/null and b/src/content/assets/img/sheep.png differ diff --git a/src/dune b/src/dune index db008b0..9e5e468 100644 --- a/src/dune +++ b/src/dune @@ -45,7 +45,7 @@ (library (name shared) - (modules log map network state time) + (modules animal log map network state time) (libraries)) (rule diff --git a/src/island.ml b/src/island.ml index ad37b85..9e6bb4d 100644 --- a/src/island.ml +++ b/src/island.ml @@ -43,6 +43,7 @@ let get request = ; "papy_up" ; "water" ; "wheat" + ; "sheep" ] in diff --git a/src/island_client.ml b/src/island_client.ml index 1f25a64..e5d3593 100644 --- a/src/island_client.ml +++ b/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 *) diff --git a/src/map.ml b/src/map.ml index ea9c498..492cc97 100644 --- a/src/map.ml +++ b/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 diff --git a/src/state.ml b/src/state.ml index cc8af84..ea3913b 100644 --- a/src/state.ml +++ b/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