otary/pellest
1
0
Fork 0
forked from zapashcanon/pellest
Code Issues Pull Requests Projects Releases Wiki Activity

implement wheat !

Browse Source
This commit is contained in:
zapashcanon 2023-01-15 02:23:14 +01:00
parent feebcd3841
commit acb2342081
Signed by untrusted user who does not match committer: zapashcanon
GPG Key ID: 8981C3C62D1D28F1
4 changed files with 98 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/island.ml
View File

@ -17,7 +17,11 @@ let get request =
let topbar =
let mana_img = mk_img false "mana" in
let mana_lvl = span ~a:[ a_id "mana_lvl" ] [ txt "0" ] in
div ~a:[ a_class [ "centered" ] ] [ mana_img; mana_lvl ]
let wheat_img = mk_img false "wheat" in
let wheat_lvl = span ~a:[ a_id "wheat_lvl" ] [ txt "0" ] in
div
~a:[ a_class [ "centered" ] ]
[ mana_img; mana_lvl; wheat_img; wheat_lvl ]
in
let canvas =
@ -32,14 +36,24 @@ let get request =
let canvas_images =
div
@@ List.map (mk_img true)
[ "grass"; "papy_left"; "papy_right"; "papy_down"; "papy_up"; "water" ]
[ "grass"
; "papy_left"
; "papy_right"
; "papy_down"
; "papy_up"
; "water"
; "wheat"
]
in
let bottombar =
let medidate_button =
button ~a:[ a_id "medidate_button" ] [ txt "Medidate" ]
in
div ~a:[ a_class [ "centered" ] ] [ medidate_button ]
let plant_wheat_button =
button ~a:[ a_id "plant_wheat_button" ] [ txt "Plant wheat" ]
in
div ~a:[ a_class [ "centered" ] ] [ medidate_button; plant_wheat_button ]
in
let page = div [ topbar; canvas; bottombar; canvas_images ] in

27
src/island_client.ml
View File

@ -51,6 +51,8 @@ let papy_up = C2d.image_src_of_el (get_el "papy_up")
let water = C2d.image_src_of_el (get_el "water")
let wheat = C2d.image_src_of_el (get_el "wheat")
let draw_canvas =
let offset_conv =
let m = float_of_int @@ (tile_size / 2) in
@ -78,6 +80,7 @@ let draw_canvas =
| Grass -> grass
| Water -> water
| Black -> water
| Wheat -> wheat
in
C2d.draw_image context tile_img ~x:tile_x ~y:tile_y
done
@ -92,9 +95,13 @@ let draw_canvas =
C2d.draw_image context papy ~x:papy_x ~y:papy_y
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.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)
(* queue for action to be done *)
let input_queue = Queue.create ()
@ -104,15 +111,17 @@ let to_apply_queue : State.action' Queue.t = Queue.create ()
let send_action state = function
(* actions we don't need to send to the server *)
| (State.Move_offset _ | Move _) as action -> begin
(*
| (State.Move_offset _ | Move _) as action -> begin
match State.check_action state action with
| Error e ->
(* TODO: display this in the window *)
Log.debug "invalid action: %s@\n" e
| Ok actions -> List.iter (fun a -> Queue.add a to_apply_queue) actions
end
*)
(* actions we want to send to the server *)
| Meditate as action -> (
| (State.Move_offset _ | Move _ | Meditate | Plant_wheat) as action -> (
match State.check_action state action with
| Error e ->
(* TODO: display this in the window *)
@ -160,7 +169,7 @@ let keypress_handler =
; "KeyW"
|];
let keys = Hashtbl.create 512 in
Array.iter (fun key -> Hashtbl.add keys key ()) [| "m" |];
Array.iter (fun key -> Hashtbl.add keys key ()) [| "m"; "p" |];
(* TODO: I'm not sure the Hashtbl business is worth it.
Before, we were matching on values instead of calling Hashtbl.mem.
It should be better with Hashtbl but it wasn't benchmarked. *)
@ -190,6 +199,7 @@ let apply_last_key () =
| "KeyS" | "ArrowDown" -> Move_offset Down
| "KeyD" | "ArrowRight" -> Move_offset Right
| "m" -> Meditate
| "p" -> Plant_wheat
| _ ->
(* if this happen, it means we're adding
bad values in `keypress_handler`
@ -270,6 +280,15 @@ let () =
meditate_button
in
let _e : Ev.listener =
let plant_wheat_button =
Jv.get Jv.global "plant_wheat_button" |> Ev.target_of_jv
in
Ev.listen Ev.click
(fun _ev -> Queue.add (State.Plant_wheat : State.action) input_queue)
plant_wheat_button
in
Fut.await initial_state_fut (fun msg ->
match Ws_client.to_server_msg msg with
| Update_result _res_msg ->

22
src/map.ml
View File

@ -8,6 +8,7 @@ type background =
| Grass
| Water
| Black
| Wheat
let pp_dir fmt dir =
let s =
@ -21,7 +22,11 @@ let pp_dir fmt dir =
let pp_background fmt b =
let s =
match b with Grass -> "Grass" | Water -> "Water" | Black -> "Black"
match b with
| Grass -> "Grass"
| Water -> "Water"
| Black -> "Black"
| Wheat -> "Wheat"
in
Format.pp_print_string fmt s
@ -53,6 +58,19 @@ let init () =
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
@ -64,4 +82,4 @@ 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 -> Ok { pos with x; y }
| Grass | Wheat -> Ok { pos with x; y }

44
src/state.ml
View File

@ -40,6 +40,7 @@ end
type t =
{ map : Map.t
; mana : int
; wheat : int
; player_pos : Map.position
; offset_x : float
; offset_y : float
@ -48,6 +49,7 @@ type t =
let init () =
{ map = Map.init ()
; mana = 0
; wheat = 0
; player_pos = { x = 0; y = 0; dir = Down }
; offset_x = 0.
; offset_y = 0.
@ -58,23 +60,30 @@ type action =
(* TODO some action do not needs to be checked by server *)
| Move_offset of Map.dir
| Move of 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 int
| Set_player_position of Map.position
| Set_offset of float * float
| Plant_wheat of int * int
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
| 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_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
let plant_wheat_cost = 10
let rec check_action state = function
| Meditate ->
@ -104,21 +113,44 @@ let rec check_action state = function
| Ok actions -> Ok (offset_action @ actions)
end
end
| Plant_wheat -> (
let { Map.x; y; dir } = state.player_pos in
let x, y =
match dir with
| Down -> (x, y + 1)
| Left -> (x - 1, y)
| Right -> (x + 1, y)
| Up -> (x, y - 1)
in
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 state.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 }
| Plant_wheat (x, y) ->
state.map.tiles.(x).(y) <- Map.Wheat;
{ state with mana = state.mana - plant_wheat_cost }
let auto_update state =
match check_action state Meditate with
| Error _e -> state
| Ok actions -> List.fold_left perform_action state actions
let state =
match check_action state Meditate with
| Error _e -> state
| Ok actions -> List.fold_left perform_action state actions
in
let count_wheat = Map.count_wheat state.map.tiles in
{ state with wheat = state.wheat + count_wheat }
let auto_update_rate = Time.mk_s 1
let pp fmt { mana; player_pos; map; offset_x; offset_y } =
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; player_pos = %a; %a; offset_x = %f; offset_y = %f" mana
Map.pp_position player_pos Map.pp_background bg offset_x offset_y
"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