diff --git a/src/app.ml b/src/app.ml index 9c3c619..543afc7 100644 --- a/src/app.ml +++ b/src/app.ml @@ -78,10 +78,6 @@ let log = let () = Dream.log "log: %b" log -let random_state = Random.State.make_self_init () - -let () = Random.set_state random_state - let about = let default_about = "Pellest is great !" in match Scfg.Query.get_dir "about" config with @@ -90,3 +86,7 @@ let about = match Scfg.Query.get_param 0 about with | Error e -> failwith e | Ok about -> about ) + +let random_state = Random.State.make_self_init () + +let () = Random.set_state random_state diff --git a/src/common.ml b/src/common.ml new file mode 100644 index 0000000..e69de29 diff --git a/src/dune b/src/dune index 5d3e288..c5a5f3a 100644 --- a/src/dune +++ b/src/dune @@ -14,7 +14,8 @@ syntax template tyx_util - user) + user + ws) (libraries bos caqti @@ -23,6 +24,7 @@ directories dream emile + shared fpath lambdasoup lwt @@ -37,10 +39,15 @@ (executable (name island_client) - (modules island_client) - (libraries js_of_ocaml brr) + (modules island_client ws_client) + (libraries js_of_ocaml brr shared) (modes js)) +(library + (name shared) + (modules map network state) + (libraries)) + (rule (target content.ml) (deps diff --git a/src/island_client.ml b/src/island_client.ml index e1d6af9..2fcc70f 100644 --- a/src/island_client.ml +++ b/src/island_client.ml @@ -1,5 +1,7 @@ open Brr +open Brr_io open Brr_canvas +open Shared module G = struct include Brr.G @@ -8,36 +10,6 @@ module G = struct (ignore : int -> unit) @@ Brr.G.request_animation_frame f end -let () = Random.self_init () - -type dir = - | Left - | Right - | Down - | Up - -module Map = struct - type background = - | Grass - | Water - | Black - - let width = 1000 - - let height = 1000 - - let player_pos = ref (20, 3) - - let player_dir = ref Down - - let m = - Array.init width (fun _x -> - Array.init height (fun _y -> - if Random.int 1000 <= 42 then Water else Grass ) ) - - let get_tile_kind ~x ~y = try m.(x).(y) with Invalid_argument _ -> Black -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) @@ -79,6 +51,11 @@ let papy_up = C2d.image_src_of_el (get_el "papy_up") let water = C2d.image_src_of_el (get_el "water") +let map = + (* TODO receive map / state *) + (* dummy map; should ask for map to server *) + ref (Map.init ()) + let draw_map = 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 @@ -91,7 +68,7 @@ let draw_map = 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 with + match Map.get_tile_kind ~x:map_x ~y:map_y !map with | Grass -> grass | Water -> water | Black -> water @@ -118,7 +95,7 @@ let move dir = | Down -> (x, y + 1) | Up -> (x, y - 1) in - match Map.get_tile_kind ~x ~y with + match Map.get_tile_kind ~x ~y !map with | Black | Water -> () | Grass -> Map.player_pos := (x, y) end @@ -130,6 +107,7 @@ let kb_handler ev = | "KeyA" | "ArrowLeft" -> move Left | "KeyS" | "ArrowDown" -> move Down | "KeyD" | "ArrowRight" -> move Right + | "KeyM" -> Ws_client.send State.Meditate | _s -> () let rec game_loop state _timestamp = @@ -137,9 +115,6 @@ let rec game_loop state _timestamp = let new_state = state in G.request_animation_frame (game_loop new_state) -(* type will change later ! *) -let initial_state = () - let () = (* init canvas *) Canvas.set_w canvas width; @@ -151,5 +126,16 @@ let () = let _e : Ev.listener = Ev.listen Ev.keydown kb_handler (Window.as_target G.window) in - (* start game *) - G.request_animation_frame (game_loop initial_state) + + (* get state from server*) + let initial_state_fut = Ev.next Message.Ev.message Ws_client.ws_target in + + Fut.await initial_state_fut (fun msg -> + let initial_state = Ws_client.to_server_msg msg in + let state_ref = ref initial_state in + (* attach message listener to update state *) + Ws_client.on_update_state_message (fun received -> + state_ref := received; + Format.printf "YOUR MANA IS: %d@." !state_ref.mana ); + (* start game *) + G.request_animation_frame (game_loop state_ref) ) diff --git a/src/map.ml b/src/map.ml new file mode 100644 index 0000000..ffcc2b6 --- /dev/null +++ b/src/map.ml @@ -0,0 +1,27 @@ +type dir = + | Left + | Right + | Down + | Up + +type background = + | Grass + | Water + | Black + +type t = background array array + +let width = 1000 + +let height = 1000 + +let player_pos = ref (20, 3) + +let player_dir = ref Down + +let init () = + Array.init width (fun _x -> + Array.init height (fun _y -> + if Random.int 1000 <= 42 then Water else Grass ) ) + +let get_tile_kind ~x ~y map = try map.(x).(y) with Invalid_argument _ -> Black diff --git a/src/network.ml b/src/network.ml new file mode 100644 index 0000000..aecc640 --- /dev/null +++ b/src/network.ml @@ -0,0 +1,5 @@ +let marshal o = Marshal.to_string o [] |> Format.sprintf "%S" + +let unmarshal o = + let s = Scanf.sscanf o "%S" (fun s -> s) in + Marshal.from_string s 0 diff --git a/src/pellest.ml b/src/pellest.ml index 3d1d478..92b30e6 100644 --- a/src/pellest.ml +++ b/src/pellest.ml @@ -6,6 +6,8 @@ let () = [ get "/assets/**" Asset.get ; get "/" Home.get ; get "/island" Island.get + ; get "/island/ws" (fun request -> + Dream.websocket @@ Ws.handle_client request ) ; get "/login" Login.get ; post "/login" Login.post ; get "logout" Logout.get diff --git a/src/state.ml b/src/state.ml new file mode 100644 index 0000000..fa434c8 --- /dev/null +++ b/src/state.ml @@ -0,0 +1,17 @@ +type t = + { map : Map.t + ; mutable mana : int + } + +let init () = { map = Map.init (); mana = 0 } + +type action = Meditate + +(* TODO do not send whole state *) +let handle_action state action = + match action with + | Meditate -> + if state.mana < 99 then ( + state.mana <- succ state.mana; + Ok state ) + else Error "maximum mana" diff --git a/src/user.ml b/src/user.ml index 2b2b354..a3dfe83 100644 --- a/src/user.ml +++ b/src/user.ml @@ -223,3 +223,14 @@ let assert_logged request = let assert_not_logged request = if is_logged_in request then Error (`Forbidden, "you shoudn't be logged in") else Ok () + +(* TODO save states *) + +let state_ht : (string, Shared.State.t) Hashtbl.t = Hashtbl.create 1 + +let set_state = Hashtbl.replace state_ht + +let get_state user_id = + match Hashtbl.find_opt state_ht user_id with + | Some state -> Ok state + | None -> Ok (Shared.State.init ()) diff --git a/src/ws.ml b/src/ws.ml new file mode 100644 index 0000000..b551e89 --- /dev/null +++ b/src/ws.ml @@ -0,0 +1,27 @@ +open Lwt.Syntax +open Shared + +let handle_client request client = + match Dream.session "user_id" request with + | None -> Dream.log "User does not exists" |> Lwt.return + | Some user_id -> + (* TODO catch marshal failure *) + + (* send user island state *) + let state = + match User.get_state user_id with + | Error _e -> assert false + | Ok state -> state + in + let* () = Dream.send ~text_or_binary:`Text client (Network.marshal state) in + + let rec loop () = + match%lwt Dream.receive client with + | None -> Dream.close_websocket client + | Some s -> + let action : State.action = Network.unmarshal s in + let state_res = State.handle_action state action in + let* () = Dream.send client (Network.marshal state_res) in + loop () + in + loop () diff --git a/src/ws_client.ml b/src/ws_client.ml new file mode 100644 index 0000000..ab612ef --- /dev/null +++ b/src/ws_client.ml @@ -0,0 +1,43 @@ +open Brr +open Brr_io +open Shared + +let ws = + Format.printf "create websocket@\n"; + let ws_url = + (* TODO fix hostname *) + Jstr.of_string "ws://localhost:3696/island/ws" + in + Websocket.create ws_url + +let ws_target = Websocket.as_target ws + +let on_event ws_event log_msg f = + let (_ : Ev.listener) = + Ev.listen ws_event + (fun ev -> + Format.printf "%s@\n" log_msg; + f ev ) + ws_target + in + () + +let to_server_msg ev = + Format.printf "to_server_msg@."; + let data = Message.Ev.data (Ev.as_type ev) |> Jstr.to_string in + let state_res : (State.t, string) result = Network.unmarshal data in + Format.printf "un-marshaled message from server yay ~ @\n"; + match state_res with + | Error e -> failwith (Format.sprintf "action resulted in error: %s" e) + | Ok state -> state + +let on_update_state_message f = + on_event Message.Ev.message "Websocket reveived message!" (fun ev -> + f (to_server_msg ev) ) + +let send msg = + Format.printf "send msg on websocket ~~ @\n"; + let s = Jstr.of_string (Network.marshal msg) in + Websocket.send_string ws s; + Format.printf "send action on websocket ~~ DONE @\n"; + ()