add topbar with mana, fix bug where newly created state was not stored

in the hashtbl 😠, clean code

src/map.ml

@@ -9,7 +9,30 @@ type background =
   | Water
   | Black
 
-type position = int * int * dir
+let pp_dir fmt dir =
+  let s =
+    match dir with
+    | Left -> "Left"
+    | Right -> "Right"
+    | Down -> "Down"
+    | Up -> "Up"
+  in
+  Format.pp_print_string fmt s
+
+let pp_background fmt b =
+  let s =
+    match b with Grass -> "Grass" | Water -> "Water" | Black -> "Black"
+  in
+  Format.pp_print_string fmt s
+
+type position =
+  { x : int
+  ; y : int
+  ; dir : dir
+  }
+
+let pp_position fmt p =
+  Format.fprintf fmt "(x = %d; y = %d; dir = %a)" p.x p.y pp_dir p.dir
 
 type t =
   { tiles : background array array
@@ -18,8 +41,8 @@ type t =
   }
 
 let init () =
-  let width = 1000 in
-  let height = 1000 in
+  let width = 100 in
+  let height = 90 in
   let tiles =
     Array.init width (fun _x ->
         Array.init height (fun _y ->
@@ -30,17 +53,17 @@ let init () =
 let get_tile_kind ~x ~y map =
   try map.tiles.(x).(y) with Invalid_argument _ -> Black
 
-let check_move map entity_pos dir =
-  let x, y, current_dir = entity_pos in
-  let x, y =
-    if current_dir <> dir then (x, y)
-    else
-      match dir with
+let check_move map ({ x; y; dir } as pos) movement_dir =
+  if dir <> movement_dir then Ok { pos with dir = movement_dir }
+  else
+    let x, y =
+      match movement_dir with
       | Left -> (x - 1, y)
       | Right -> (x + 1, y)
       | Down -> (x, y + 1)
       | Up -> (x, y - 1)
-  in
-  match get_tile_kind ~x ~y map with
-  | Black | Water -> Error "invalid terrain"
-  | Grass -> Ok (x, y, dir)
+    in
+    match get_tile_kind ~x ~y map with
+    | (Black | Water) as bg ->
+      Error (Format.asprintf "can't move on %a" pp_background bg)
+    | Grass -> Ok { pos with x; y }