pellest/src/island_client.ml

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 -> Log.err "could not find element with 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_canvas =
  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
    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
        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 state.player_pos.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

let draw_topbar state =
  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)

(* 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 ->
    (* 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 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 render state =
  draw_canvas state;
  draw_topbar state

let rec game_loop state last_auto_update timestamp =
  render state;
  let should_auto_update =
    timestamp -. last_auto_update
    >= Time.ms_to_float (Time.s_to_ms State.auto_update_rate)
  in

  let last_auto_update =
    if should_auto_update then timestamp else last_auto_update
  in
  let state =
    (* apply queue of actions *)
    let state = Queue.fold State.perform_action state to_apply_queue in
    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
  G.request_animation_frame (game_loop state last_auto_update)

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 *)
        Log.debug "received `Full_state` message@\n"
      | 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 ) );
  (* 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 ->
        Log.err
          "invalid first server message received; received Update expected \
           Full_state"
      | Full_state state ->
        (* start game *)
        G.request_animation_frame (game_loop state 0.) )