diff --git a/src/content/assets/img/papy_bottom.png b/src/content/assets/img/papy_down.png similarity index 100% rename from src/content/assets/img/papy_bottom.png rename to src/content/assets/img/papy_down.png diff --git a/src/content/assets/img/papy_up.png b/src/content/assets/img/papy_up.png new file mode 100644 index 0000000..61698e4 Binary files /dev/null and b/src/content/assets/img/papy_up.png differ diff --git a/src/island.ml b/src/island.ml index 0631163..eab4678 100644 --- a/src/island.ml +++ b/src/island.ml @@ -16,7 +16,10 @@ let get request = ~a:[ a_id "canvas" ] [ txt "please update your browser or enable javascript" ] in - let images = List.map mk_img [ "grass"; "papy_bottom"; "water" ] in + let images = + List.map mk_img + [ "grass"; "papy_left"; "papy_right"; "papy_down"; "papy_up"; "water" ] + in let page = div ~a:[ a_class [ "centered" ] ] @@ (canvas :: images) in diff --git a/src/island_client.ml b/src/island_client.ml index 7f7a884..e1d6af9 100644 --- a/src/island_client.ml +++ b/src/island_client.ml @@ -10,6 +10,12 @@ end let () = Random.self_init () +type dir = + | Left + | Right + | Down + | Up + module Map = struct type background = | Grass @@ -22,6 +28,8 @@ module Map = struct let player_pos = ref (20, 3) + let player_dir = ref Down + let m = Array.init width (fun _x -> Array.init height (fun _y -> @@ -47,13 +55,6 @@ let canvas = let context = C2d.get_context canvas -let init () = - Canvas.set_w canvas width; - Canvas.set_h canvas height; - C2d.set_fill_style context (C2d.color (Jstr.v "#FF1188")); - C2d.fill_rect context ~x:0. ~y:0. ~w:(float_of_int width) - ~h:(float_of_int height) - let tiles_per_w = let n = width / tile_size in if n mod 2 = 0 then n - 1 else n @@ -68,65 +69,87 @@ let orig_y = (height - (tiles_per_h * tile_size)) / 2 let grass = C2d.image_src_of_el (get_el "grass") -let papy_bottom = C2d.image_src_of_el (get_el "papy_bottom") +let papy_left = C2d.image_src_of_el (get_el "papy_left") + +let papy_right = C2d.image_src_of_el (get_el "papy_right") + +let papy_down = C2d.image_src_of_el (get_el "papy_down") + +let papy_up = C2d.image_src_of_el (get_el "papy_up") let water = C2d.image_src_of_el (get_el "water") -let draw_map _timestamp = - 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 tile_img = - match Map.get_tile_kind ~x:mapx ~y:mapy with - | Grass -> grass - | Water -> water - | Black -> water - in - C2d.draw_image context tile_img - ~x:(float_of_int (orig_x + (x * tile_size))) - ~y:(float_of_int (orig_y + (y * tile_size))) - done - done; - C2d.draw_image context papy_bottom - ~x:(float_of_int (width - tile_size) /. 2.) - ~y:((float_of_int height /. 2.) -. float_of_int tile_size) +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 + fun () -> + let player_x, player_y = !Map.player_pos in + for x = 0 to tiles_per_w - 1 do + let map_x = x + player_x - (tiles_per_w / 2) in + let tile_x = float_of_int ((x * tile_size) + orig_x) in + for y = 0 to tiles_per_h - 1 do + 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 + | Grass -> grass + | Water -> water + | Black -> water + in + C2d.draw_image context tile_img ~x:tile_x ~y:tile_y + done + done; + let papy = + match !Map.player_dir with + | Left -> papy_left + | Right -> papy_right + | Down -> papy_down + | Up -> papy_up + in + C2d.draw_image context papy ~x:papy_x ~y:papy_y + +let move dir = + if !Map.player_dir = dir then begin + let x, y = !Map.player_pos in + let x, y = + match dir with + | Left -> (x - 1, y) + | Right -> (x + 1, y) + | Down -> (x, y + 1) + | Up -> (x, y - 1) + in + match Map.get_tile_kind ~x ~y with + | Black | Water -> () + | Grass -> Map.player_pos := (x, y) + end + else Map.player_dir := dir let kb_handler ev = - let x, y = !Map.player_pos in - let x, y = - match ev |> Ev.as_type |> Ev.Keyboard.code |> Jstr.to_string with - | "KeyW" | "ArrowUp" -> (x, max 0 (y - 1)) - | "KeyA" | "ArrowLeft" -> (max 0 (x - 1), y) - | "KeyS" | "ArrowDown" -> (x, min (Map.height - 1) y + 1) - | "KeyD" | "ArrowRight" -> (min (Map.width - 1) x + 1, y) - | _s -> (x, y) - in - Map.player_pos := (x, y) + match ev |> Ev.as_type |> Ev.Keyboard.code |> Jstr.to_string with + | "KeyW" | "ArrowUp" -> move Up + | "KeyA" | "ArrowLeft" -> move Left + | "KeyS" | "ArrowDown" -> move Down + | "KeyD" | "ArrowRight" -> move Right + | _s -> () let rec game_loop state _timestamp = draw_map (); let new_state = state in G.request_animation_frame (game_loop new_state) -let on_window_load f x = - (ignore : Ev.listener -> unit) - @@ Ev.listen Ev.load - (fun (_ev : Ev.Type.void Ev.t) -> f x) - (Window.as_target G.window) - -let bind_keys () = - (ignore : Ev.listener -> unit) - @@ Ev.listen Ev.keydown kb_handler (Window.as_target G.window) - -(* type will change later !*) +(* type will change later ! *) let initial_state = () let () = - on_window_load init (); - on_window_load bind_keys (); - on_window_load - (fun () -> G.request_animation_frame (game_loop initial_state)) - () + (* init canvas *) + Canvas.set_w canvas width; + Canvas.set_h canvas height; + C2d.set_fill_style context (C2d.color (Jstr.v "#FF1188")); + C2d.fill_rect context ~x:0. ~y:0. ~w:(float_of_int width) + ~h:(float_of_int height); + (* bind keys *) + 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)