swrup/pellest
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

implement grid offset

Browse source
This commit is contained in:
pena 2023-01-15 00:48:47 +01:00 • committed by Swrup
parent 03933d3fd4
commit 8e2faf3b21
5 changed files with 141 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

61
src/island_client.ml
View file

@ -52,16 +52,27 @@ let papy_up = C2d.image_src_of_el (get_el "papy_up")
let water = C2d.image_src_of_el (get_el "water")
let draw_canvas =
let offset_conv =
let m = float_of_int @@ (tile_size / 2) in
fun offset -> m *. offset
in
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
let half_tiles_per_w = tiles_per_w / 2 in
let half_tiles_per_h = tiles_per_h / 2 in
fun state ->
let open State in
for x = 0 to tiles_per_w - 1 do
let map_x = x + state.player_pos.x - (tiles_per_w / 2) in
let tile_x = float_of_int ((x * tile_size) + orig_x) in
for y = 0 to tiles_per_h - 1 do
let map_y = y + state.player_pos.y - (tiles_per_h / 2) in
let tile_y = float_of_int ((y * tile_size) + orig_y) 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 tile_x =
float_of_int ((x * tile_size) + orig_x) +. offset_conv state.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 tile_y =
float_of_int ((y * tile_size) + orig_y) +. offset_conv state.offset_y
in
let tile_img =
match Map.get_tile_kind ~x:map_x ~y:map_y state.map with
| Grass -> grass
@ -91,15 +102,24 @@ let input_queue = Queue.create ()
(* queue for action' to apply to client state *)
let to_apply_queue : State.action' Queue.t = Queue.create ()
let send_action state action =
match State.check_action state action with
| Error e ->
(* TODO: display this in the window *)
Log.debug "invalid action: %s@\n" e
| Ok Look_at_the_sky -> ()
| Ok _ ->
Log.debug "sending action %a to server@\n" State.pp_action action;
Ws_client.send (Network.Action_msg action)
let send_action state = function
(* actions we don't need to send to the server *)
| (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 -> (
match State.check_action state action with
| Error e ->
(* TODO: display this in the window *)
Log.debug "invalid action: %s@\n" e
| Ok _actions ->
Log.debug "sending action %a to server@\n" State.pp_action action;
Ws_client.send (Network.Action_msg action) )
module Kb : sig
(* this keeps an ordered sequence of unique values,
@ -165,10 +185,10 @@ let apply_last_key () =
let act =
(* when you add something here, don't forget to add the corresponding case in `keypress_handler` *)
match code_or_key with
| "KeyW" | "ArrowUp" -> Move Up
| "KeyA" | "ArrowLeft" -> Move Left
| "KeyS" | "ArrowDown" -> Move Down
| "KeyD" | "ArrowRight" -> Move Right
| "KeyW" | "ArrowUp" -> Move_offset Up
| "KeyA" | "ArrowLeft" -> Move_offset Left
| "KeyS" | "ArrowDown" -> Move_offset Down
| "KeyD" | "ArrowRight" -> Move_offset Right
| "m" -> Meditate
| _ ->
(* if this happen, it means we're adding
@ -225,7 +245,8 @@ let () =
| Update_result res -> (
match res with
| Error e -> Log.debug "received update result error: %s@\n" e
| Ok action' -> Queue.add action' to_apply_queue ) );
| Ok actions ->
List.iter (fun action -> Queue.add action to_apply_queue) actions ) );
(* bind keys *)
let _e : Ev.listener =

26
src/map.ml
View file

@ -53,17 +53,15 @@ let init () =
let get_tile_kind ~x ~y map =
try map.tiles.(x).(y) with Invalid_argument _ -> Black
let check_move map ({ x; y; dir } as pos) movement_dir =
if dir <> movement_dir then Ok { pos with dir = movement_dir }
else
let x, y =
match movement_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) as bg ->
Error (Format.asprintf "can't move on %a" pp_background bg)
| Grass -> Ok { pos with x; y }
let check_move map ({ x; y; _ } as pos) movement_dir =
let x, y =
match movement_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) as bg ->
Error (Format.asprintf "can't move on %a" pp_background bg)
| Grass -> Ok { pos with x; y }

2
src/network.ml
View file

@ -6,6 +6,6 @@ let unmarshal o =
type server_message =
| Full_state of State.t
| Update_result of (State.action', string) result
| Update_result of (State.action' list, string) result
type client_message = Action_msg of State.action

97
src/state.ml
View file

@ -1,59 +1,124 @@
module Offset : sig
val check_move :
x:float -> y:float -> Map.dir -> float * float * Map.dir Option.t
end = struct
let limit = 1.
let step = 0.25
let check_move ~x ~y = function
| Map.Left ->
let x' = x +. step in
if x' >= limit then begin
let x' = ~-.limit in
(x', y, Some Map.Left)
end
else (x', y, None)
| Right ->
let x' = x -. step in
if x' <= ~-.limit then begin
let x' = limit in
(x', y, Some Right)
end
else (x', y, None)
| Down ->
let y' = y -. step in
if y' <= ~-.limit then begin
let y' = limit in
(x, y', Some Down)
end
else (x, y', None)
| Up ->
let y' = y +. step in
if y' >= limit then begin
let y' = ~-.limit in
(x, y', Some Up)
end
else (x, y', None)
end
type t =
{ map : Map.t
; mana : int
; player_pos : Map.position
; offset_x : float
; offset_y : float
}
let init () =
{ map = Map.init (); mana = 0; player_pos = { x = 0; y = 0; dir = Down } }
{ map = Map.init ()
; mana = 0
; player_pos = { x = 0; y = 0; dir = Down }
; offset_x = 0.
; offset_y = 0.
}
type action =
| Meditate
(* TODO some action do not needs to be checked by server *)
| Move_offset of Map.dir
| Move of Map.dir
| Do_nothing
(* type for result of action send to the client by the server *)
type action' =
| Add_mana of int
| Set_player_position of Map.position
| Look_at_the_sky
| Set_offset of float * float
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
| Do_nothing -> Format.pp_print_string fmt "Do_nothing"
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
| Look_at_the_sky -> Format.pp_print_string fmt "Look_at_the_sky"
| Set_offset (x, y) -> Format.fprintf fmt "Set_offset (%f, %f)" x y
let check_action state = function
let rec check_action state = function
| Meditate ->
if state.mana < 99 then Ok (Add_mana 1) else Error "maximum mana"
if state.mana < 99 then Ok [ Add_mana 1 ] else Error "maximum mana"
| Move dir -> (
match Map.check_move state.map state.player_pos dir with
| Error _e as error -> error
| Ok pos -> Ok (Set_player_position pos) )
| Do_nothing -> Ok Look_at_the_sky
| Ok pos -> Ok [ Set_player_position pos ] )
| Move_offset 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
in
let offset_action =
[ Set_player_position { state.player_pos with dir }
; Set_offset (offset_x, offset_y)
]
in
begin
match dir' with
| None -> Ok offset_action
| Some dir' -> begin
match check_action state (Move dir') with
| Error _e as e -> e
| Ok actions -> Ok (offset_action @ actions)
end
end
let perform_action state = function
| Add_mana n -> { state with mana = state.mana + n }
| Set_player_position player_pos -> { state with player_pos }
| Look_at_the_sky -> state
| Set_offset (offset_x, offset_y) -> { state with offset_x; offset_y }
let auto_update state =
match check_action state Meditate with
| Error _e -> state
| Ok action' ->
let state = perform_action state action' in
state
| Ok actions -> List.fold_left perform_action state actions
let auto_update_rate = Time.mk_s 1
let pp fmt { mana; player_pos; map } =
let pp fmt { mana; 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" mana Map.pp_position
player_pos Map.pp_background bg
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

8
src/ws.ml
View file

@ -35,8 +35,12 @@ let handle_client request client =
Dream.log "check_action error: %s" msg;
e
| Ok action' ->
Dream.log "check_action ok: %a" State.pp_action' action';
let state = State.perform_action state action' in
Dream.log "check_action ok: %a"
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt " ; ")
State.pp_action' )
action';
let state = List.fold_left State.perform_action state action' in
User.set_state user_id state;
Ok action'
in