pellest/src/map.ml

type dir =
  | Left
  | Right
  | Down
  | Up

type background =
  | Grass
  | Water
  | Black
  | Wheat

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"
    | Wheat -> "Wheat"
  in
  Format.pp_print_string fmt s

type simple_position =
  { x : int
  ; y : int
  ; dir : dir
  }

type position =
  { x : int
  ; y : int
  ; offset_x : float
  ; offset_y : float
  ; dir : dir
  }

let pp_position fmt p =
  Format.fprintf fmt
    "(x = %d; y = %d; offset_x = %03f; offset_y = %03f; dir = %a)" p.x p.y
    p.offset_x p.offset_y pp_dir p.dir

type t =
  { tiles : background array array
  ; width : int
  ; height : int
  }

let init () =
  let width = 100 in
  let height = 90 in
  let tiles =
    Array.init width (fun _x ->
        Array.init height (fun _y ->
            if Random.int 1000 <= 42 then Water else Grass ) )
  in
  { tiles; width; height }

let get_tile_kind ~x ~y map =
  try map.tiles.(x).(y) with Invalid_argument _ -> Black

let count_wheat map =
  Array.fold_left
    (fun count a ->
      let count' =
        Array.fold_left
          (fun count -> function
            | Wheat -> succ count
            | Black | Grass | Water -> count )
          0 a
      in
      count + count' )
    0 map

let check_move map ({ x; y; _ } as pos) movement_dir =
  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) as bg ->
    Error (Format.asprintf "can't move on %a" pp_background bg)
  | Grass | Wheat -> Ok { pos with x; y }