better keyboard handling

src/island_client.ml

@@ -101,21 +101,82 @@ let send_action state action =
     Log.debug "sending action %a to server@\n" State.pp_action action;
     Ws_client.send (Network.Action_msg action)
 
-let keydown_handler ev =
+module Kb : sig
+  (* this keeps an ordered sequence of unique values,
+     it's the responsability of the caller to make sure
+     the same element is not added twice ! *)
+
+  type t = string
+
+  val add : t -> unit
+
+  val rm : t -> unit
+
+  val get_last : unit -> t option
+end = struct
+  type t = string
+
+  let last = ref []
+
+  let add k = last := k :: !last
+
+  let rm k = last := List.filter (( <> ) k) !last
+
+  let get_last () = match !last with [] -> None | key :: _keys -> Some key
+end
+
+let keypress_handler =
+  (* be careful to add in the correct array ! *)
+  let codes = Hashtbl.create 512 in
+  Array.iter
+    (fun code -> Hashtbl.add codes code ())
+    [| "ArrowDown"
+     ; "ArrowLeft"
+     ; "ArrowRight"
+     ; "ArrowUp"
+     ; "KeyA"
+     ; "KeyD"
+     ; "KeyS"
+     ; "KeyW"
+    |];
+  let keys = Hashtbl.create 512 in
+  Array.iter (fun key -> Hashtbl.add keys key ()) [| "m" |];
+  (* TODO: I'm not sure the Hashtbl business is worth it.
+     Before, we were matching on values instead of calling Hashtbl.mem.
+     It should be better with Hashtbl but it wasn't benchmarked. *)
+  fun ~down ->
+    let f = if down then Kb.add else Kb.rm in
+    fun ev ->
+      let ev = Ev.as_type ev in
+      (* repeat is true if and only if an event as already been sent since the key has been pressed
+         in this case, it's already in the sequence so we just skip it, we know it'll eventually be
+         released on keydown before it can appears again *)
+      if not @@ Ev.Keyboard.repeat ev then
+        let code = Ev.Keyboard.code ev |> Jstr.to_string in
+        if Hashtbl.mem codes code then f code
+        else
+          let key = Ev.Keyboard.key ev |> Jstr.to_string in
+          if Hashtbl.mem keys key then f key
+
+let apply_last_key () =
   let open State in
-  let ev = Ev.as_type ev in
+  Kb.get_last ()
-  let act =
+  |> Option.iter (fun code_or_key ->
-    match Ev.Keyboard.code ev |> Jstr.to_string with
+         let act =
-    | "KeyW" | "ArrowUp" -> Move Up
+           (* when you add something here, don't forget to add the corresponding case in `keypress_handler` *)
-    | "KeyA" | "ArrowLeft" -> Move Left
+           match code_or_key with
-    | "KeyS" | "ArrowDown" -> Move Down
+           | "KeyW" | "ArrowUp" -> Move Up
-    | "KeyD" | "ArrowRight" -> Move Right
+           | "KeyA" | "ArrowLeft" -> Move Left
-    | _code -> (
+           | "KeyS" | "ArrowDown" -> Move Down
-      match Ev.Keyboard.key ev |> Jstr.to_string with
+           | "KeyD" | "ArrowRight" -> Move Right
-      | "m" -> Meditate
+           | "m" -> Meditate
-      | _key -> Do_nothing )
+           | _ ->
-  in
+             (* if this happen, it means we're adding
-  Queue.add act input_queue
+                bad values in `keypress_handler`
+                and that should be fixed *)
+             assert false
+         in
+         Queue.add act input_queue )
 
 let render state =
   draw_canvas state;
@@ -131,6 +192,7 @@ let rec game_loop state last_auto_update timestamp =
   let last_auto_update =
     if should_auto_update then timestamp else last_auto_update
   in
+  apply_last_key ();
   let state =
     (* apply queue of actions *)
     let state = Queue.fold State.perform_action state to_apply_queue in
@@ -167,7 +229,14 @@ let () =
 
   (* bind keys *)
   let _e : Ev.listener =
-    Ev.listen Ev.keydown keydown_handler (Window.as_target G.window)
+    Ev.listen Ev.keydown
+      (keypress_handler ~down:true)
+      (Window.as_target G.window)
+  in
+  let _e : Ev.listener =
+    Ev.listen Ev.keyup
+      (keypress_handler ~down:false)
+      (Window.as_target G.window)
   in
 
   (* bind buttons *)