wip: state server side; websocket

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

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)
+ (modules island_client ws_client)
- (libraries js_of_ocaml brr)
+ (libraries js_of_ocaml brr shared)
  (modes js))
 
+(library
+ (name shared)
+ (modules map network state)
+ (libraries))
+
 (rule
  (target content.ml)
  (deps

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) )

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

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

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

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"

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 ())

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 ()

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";
+  ()