open Brr open Brr_io open Brr_canvas open Shared module G = struct include Brr.G let request_animation_frame f = (ignore : int -> unit) @@ Brr.G.request_animation_frame f end let get_el id = match Document.find_el_by_id G.document (Jstr.of_string id) with | None -> failwith (Format.sprintf {|Could not find element by id: "%s"|} id) | Some el -> el let tile_size = 40 let width = 875 let height = 675 let canvas = let el = get_el "canvas" in Canvas.of_el el let context = C2d.get_context canvas let tiles_per_w = let n = width / tile_size in if n mod 2 = 0 then n - 1 else n let tiles_per_h = let n = height / tile_size in if n mod 2 = 0 then n - 1 else n let orig_x = (width - (tiles_per_w * tile_size)) / 2 let orig_y = (height - (tiles_per_h * tile_size)) / 2 let grass = C2d.image_src_of_el (get_el "grass") let papy_left = C2d.image_src_of_el (get_el "papy_left") let papy_right = C2d.image_src_of_el (get_el "papy_right") let papy_down = C2d.image_src_of_el (get_el "papy_down") let papy_up = C2d.image_src_of_el (get_el "papy_up") let water = C2d.image_src_of_el (get_el "water") 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 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 for y = 0 to tiles_per_h - 1 do let map_y = y + player_y - (tiles_per_h / 2) in let tile_y = float_of_int ((y * tile_size) + orig_y) in let tile_img = match Map.get_tile_kind ~x:map_x ~y:map_y state.map with | Grass -> grass | Water -> water | Black -> water in C2d.draw_image context tile_img ~x:tile_x ~y:tile_y done done; let papy = match player_dir with | Left -> papy_left | Right -> papy_right | Down -> papy_down | Up -> papy_up in C2d.draw_image context papy ~x:papy_x ~y:papy_y (* queue for action to be done *) 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 -> Format.printf "Invalid action: %s@\n" e | Ok _ -> Ws_client.send (Network.Action_msg action) let kb_handler ev = let open State in let act = match ev |> Ev.as_type |> Ev.Keyboard.code |> Jstr.to_string with | "KeyW" | "ArrowUp" -> Move Up | "KeyA" | "ArrowLeft" -> Move Left | "KeyS" | "ArrowDown" -> Move Down | "KeyD" | "ArrowRight" -> Move Right | "KeyM" -> Meditate | _s -> Do_nothing in Queue.add act input_queue let last_auto_state_update = ref 0. let rec game_loop state timestamp = draw state; let new_state = (* TODO repesct order of action *) (* apply to_apply_queue *) let state = Queue.fold State.perform_action state to_apply_queue in (* TODO can this bug because of concurrency? *) Queue.clear to_apply_queue; (* send input action to server *) Queue.iter (send_action state) input_queue; Queue.clear input_queue; (* auto_update *) if timestamp -. !last_auto_state_update >= float_of_int @@ (State.auto_state_update_rate * 1000) then ( Format.printf "MANA: %d@." state.mana; last_auto_state_update := timestamp; State.auto_update state ) else state in G.request_animation_frame (game_loop new_state) let () = (* init canvas *) Canvas.set_w canvas width; Canvas.set_h canvas height; C2d.set_fill_style context (C2d.color (Jstr.v "#FF1188")); C2d.fill_rect context ~x:0. ~y:0. ~w:(float_of_int width) ~h:(float_of_int height); (* get state from server*) let initial_state_fut = Ev.next Message.Ev.message Ws_client.ws_target in (* attach message listener to update state *) Ws_client.on_update_state_message (fun server_msg -> match server_msg with | Full_state _state -> (* TODO reset state to received state *) Format.printf "received Full_state message@\n" | Update_result res -> ( match res with | Error e -> Format.printf "received update result error: %s" e | Ok action' -> Queue.add action' to_apply_queue ) ); (* bind keys *) let _e : Ev.listener = Ev.listen Ev.keydown kb_handler (Window.as_target G.window) in Fut.await initial_state_fut (fun msg -> match Ws_client.to_server_msg msg with | Update_result _res_msg -> failwith "invalid first server message received; received Update expected \ Full_state" | Full_state state -> (* start game *) G.request_animation_frame (game_loop state) )