draw canvas from a map

src/island.ml

@@ -1,6 +1,13 @@
 open Tyxml.Html
 open Syntax
 
+let mk_img name =
+  img
+    ~src:(Format.sprintf "/assets/img/%s.png" name)
+    ~alt:name
+    ~a:[ a_hidden (); a_id name ]
+    ()
+
 let get request =
   let** () = User.assert_logged request in
   let title = "Your island" in
@@ -9,12 +16,14 @@ let get request =
       ~a:[ a_id "canvas" ]
       [ txt "please update your browser or enable javascript" ]
   in
-  let img_grass =
-    img ~src:"/assets/img/grass.png" ~alt:"grass"
-      ~a:[ a_hidden (); a_id "grass" ]
-      ()
+  let img_grass = mk_img "grass" in
+  let img_papy_bottom = mk_img "papy_bottom" in
+  let img_water = mk_img "water" in
+
+  let page =
+    div ~a:[ a_class [ "centered" ] ]
+    @@ [ canvas; img_grass; img_papy_bottom; img_water ]
   in
-  let page = div ~a:[ a_class [ "centered" ] ] @@ [ canvas; img_grass ] in
 
   let js =
     script

src/island_client.ml

@@ -1,3 +1,23 @@
+module Map = struct
+  type background =
+    | Grass
+    | Water
+    | Black
+
+  let width = 1000
+
+  let height = 1000
+
+  let player_pos = ref (500, 500)
+
+  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 tile_size = 40
 
 let width = 835
@@ -33,19 +53,63 @@ let orig_y = (height - (tiles_per_h * tile_size)) / 2
 
 let grass = Jv.get Jv.global "grass"
 
-let draw_background () =
+let papy_bottom = Jv.get Jv.global "papy_bottom"
+
+let water = Jv.get Jv.global "water"
+
+let draw_map () =
+  let player_x, player_y = !Map.player_pos in
+  Format.printf "player_x = %d@\nplayer_y = %d@\n" player_x player_y;
   for x = 0 to tiles_per_w - 1 do
+    let mapx = x + player_x - (tiles_per_w / 2) in
     for y = 0 to tiles_per_h - 1 do
+      let mapy = y + player_y - (tiles_per_h / 2) in
+      let img =
+        match Map.get_tile_kind ~x:mapx ~y:mapy with
+        | Grass -> grass
+        | Water -> water
+        | Black -> water
+      in
       let (_ : Jv.t) =
         Jv.call context "drawImage"
-          [| grass
+          [| img
            ; Jv.of_int (orig_x + (x * tile_size))
            ; Jv.of_int (orig_y + (y * tile_size))
           |]
       in
       ()
     done
-  done
+  done;
+  let (_ : Jv.t) =
+    Jv.call context "drawImage"
+      [| papy_bottom
+       ; Jv.of_int ((width / 2) - (tile_size / 2))
+       ; Jv.of_int ((height / 2) - (tile_size / 2))
+      |]
+  in
+  ()
+
+let () =
+  let (_ : Jv.t) =
+    Jv.call window "addEventListener"
+      [| Jv.of_string "load"; Jv.repr draw_map |]
+  in
+  ()
+
+(*
+  let draw_background () =
+    for x = 0 to tiles_per_w - 1 do
+      for y = 0 to tiles_per_h - 1 do
+        let (_ : Jv.t) =
+          Jv.call context "drawImage"
+            [| grass
+             ; Jv.of_int (orig_x + (x * tile_size))
+             ; Jv.of_int (orig_y + (y * tile_size))
+            |]
+        in
+        ()
+      done
+    done
 
 let () =
   let (_ : Jv.t) =
@@ -53,3 +117,22 @@ let () =
       [| Jv.of_string "load"; Jv.repr draw_background |]
   in
   ()
+
+let draw_papy () =
+  let (_ : Jv.t) =
+    Jv.call context "drawImage"
+      [| papy_bottom
+       ; Jv.of_int ((width / 2) - (tile_size / 2))
+       ; Jv.of_int ((height / 2) - (tile_size / 2))
+      |]
+  in
+  ()
+
+let () =
+  let (_ : Jv.t) =
+    Jv.call window "addEventListener"
+      [| Jv.of_string "load"; Jv.repr draw_papy |]
+  in
+  ()
+
+*)