(* A Simple Mini-World Map Generator
 Copyright (C) 2024 Florent Monnier
 
 To the extent permitted by law, you can use, modify, and redistribute
 this software, and the associated elements, as long as you also respect
 the distribution agreements of these associated elements.
*)

let canvas = Canvas.getElementById Canvas.doc "my_canvas"
let ctx = Canvas.getContext canvas "2d"

let width, height = (800, 544)

let t0 = int_of_float (Js.Date.now ())

let texture_loaded = ref false

type cell =
  | Grass
  | Water1 | Water2
  | Sand
  | Bridge1 | Bridge2
  | Road
  | Tree1 | Tree2 | Tree3
  | Field1 | Field2 | Field3
  | House of int


let tree () =
  match Random.int 7 with
  | 0 | 1 -> Tree1 | 2 | 3 -> Tree2 | 4 | 5 -> Tree3
  | _ -> Grass

let field () =
  match Random.int 6 with
  | 0 -> Field1 | 1 -> Field2 | 2 -> Field3
  | _ -> Grass

let field2 () =
  match Random.int 3 with
  | 0 -> Field1 | 1 -> Field2 | _ -> Field3

let tree_f () =
  match Random.int 7 with
  | 0 -> Tree1 | 1 -> Tree2 | 2 -> Tree3
  | 3 -> Field1 | 4 -> Field2 | 5 -> Field3
  | _ -> Grass

let house () =
  House (1 + Random.int 11)

let rand_char () =
  match Random.int 8 with
  | 0 -> (944, 128)
  | 1 -> (272, 0)
  | 2 -> (192, 0)
  | 3 -> (352, 0)
  | 4 -> (512, 0)
  | 5 -> (432, 0)
  | 6 -> (496, 96)
  | _ -> (608, 0)


let init_world () =
  Random.self_init ();
  Noise.seed (Random.float 1.0);

  let world = Array.make_matrix 34 50 Grass in
  let chars = ref [] in

  (* 16 * 34 = 544 *)
  (* 16 * 50 = 800 *)
  for i = 0 to pred 50 do
    for j = 0 to pred 34 do
      let x, y = (i * 16, j * 16) in

      (* All noise functions return values in the range of -1 to 1. *)
      let v1 = Noise.perlin2 (float x /. 320.0) (float y /. 320.0) in
      let v2 = (v1 +. 1.0) /. 2.0 in  (* range 0 to 1 *)
      let v3 = abs_float v1 in

      let cell =
        if v3 < 0.014 then Water2 else
        if v3 < 0.056 then Water1 else
        if v3 < 0.086 then Sand else
        if v3 > 0.15 then tree () else
        if v3 > 0.14 then tree_f () else
        if v3 > 0.12 then field () else Grass
      in
      world.(j).(i) <- cell;
    done;
  done;

  (* roads *)
  Noise.seed (Random.float 1.0);
  for i = 0 to pred 50 do
    for j = 0 to pred 34 do
      let x, y = (i * 16, j * 16) in
      let v1 = Noise.perlin2 (float x /. 280.0) (float y /. 280.0) in
      let v3 = abs_float v1 in

      if v3 < 0.04 then
      begin
        match world.(j).(i) with
        | Water1 | Water2 -> ()
        | _ -> world.(j).(i) <- Road
      end;
    done;
  done;

  (* check for diagonal roads *)
  for i = 1 to pred 50 do
    for j = 1 to pred 34 do

      let is_road i j =
        match world.(j).(i) with
        | Road -> true | _ -> false
      in
      let is_tree i j =
        match world.(j).(i) with
        | Tree1 | Tree2 | Tree3 -> true
        | _ -> false
      in

      if is_road i j &&
         is_tree (i-1) j &&
         is_road (i-1) (j-1) &&
         is_tree  i    (j-1)
      then
        world.(j).(i-1) <- Grass;

      if is_tree i j &&
         is_road (i-1) j &&
         is_tree (i-1) (j-1) &&
         is_road  i    (j-1)
      then
        world.(j).(i) <- Grass;

    done;
  done;

  (* houses *)
  Noise.seed (Random.float 1.0);
  for i = 0 to pred 50 do
    for j = 0 to pred 34 do
      let x, y = (i * 16, j * 16) in
      let v1 = Noise.perlin2 (float x /. 120.0) (float y /. 120.0) in
      let v2 = (v1 +. 1.0) /. 2.0 in  (* range 0 to 1 *)

      let is_water i j =
        try
          match world.(j).(i) with
          | Water1 | Water2 -> true
          | _ -> false
        with _ -> false
      in
      let water_next i j =
        is_water (i+1) j ||
        is_water (i-1) j ||
        is_water i (j+1) ||
        is_water i (j-1) ||
        is_water i j
      in

      if v2 < 0.35 then
      begin
        if water_next i j then () else
          if Random.int 10 > 5
          then world.(j).(i) <- house ()
          else world.(j).(i) <- Sand;
      end;

      if v2 > 0.36 && v2 < 0.37 then
      begin
        match world.(j).(i) with
        | Grass | Tree1 | Tree2 | Tree3 -> world.(j).(i) <- field2 ()
        | _ -> ()
      end;
    done;
  done;

  (* bridges *)
  for i = 1 to 50 - 3 do
    for j = 1 to 34 - 3 do
      let is_ground i j =
        match world.(j).(i) with
        | Sand | Grass | Road -> true | _ -> false
      in
      let is_water i j =
        match world.(j).(i) with
        | Water1 | Water2 -> true | _ -> false
      in

      if is_ground (i-1) (j) &&
         is_water  (i)   (j) &&
         is_ground (i+1) (j)
      then begin
        if Random.int 18 < 3
        then world.(j).(i) <- Bridge1
      end;

      if is_ground (i) (j-1) &&
         is_water  (i) (j)   &&
         is_ground (i) (j+1)
      then begin
        if Random.int 18 < 3
        then world.(j).(i) <- Bridge2
      end;

      if is_ground (i-1) (j) &&
         is_water  (i)   (j) &&
         is_water  (i+1) (j) &&
         is_ground (i+2) (j)
      then begin
        if Random.int 18 < 3
        then ( world.(j).(i) <- Bridge1;
               world.(j).(i+1) <- Bridge1; )
      end;

      if is_ground (i) (j-1) &&
         is_water  (i) (j)   &&
         is_water  (i) (j+1) &&
         is_ground (i) (j+2)
      then begin
        if Random.int 18 < 3
        then ( world.(j).(i) <- Bridge2;
               world.(j+1).(i) <- Bridge2; )
      end;

    done;
  done;

  (* add characters *)
  for i = 0 to pred 50 do
    for j = 0 to pred 34 do
      let is_tree i j =
        try
          match world.(j).(i) with
          | Tree1 | Tree2 | Tree3 -> true
          | _ -> false
        with _ -> true
      in
      if is_tree (i-1) j &&
         is_tree i (j-1) &&
         is_tree (i+1) j &&
         is_tree i (j+1)
      then () else
        match world.(j).(i) with
        | Sand | Grass | Road ->
            if Random.int 100 < 3
            then chars := (i, j, rand_char ()) :: !chars
        | _ -> ()
    done;
  done;

  (chars, world)
;;


(* display *)
let display texture world chars =
  Array.iteri (fun j line ->
    Array.iteri (fun i cell ->
      let x, y = (i * 16, j * 16) in

      let color0 = "#42acaf" in (* dark blue *)
      let color1 = "#4ebcb9" in (* blue *)
      let color2 = "#b1d354" in (* green *)
      let color3 = "#e7d593" in (* sand *)
      let color4 = "#d3a061" in (* wood *)

      let color =
        match cell with
        | Water1 -> color1
        | Water2 -> color0
        | Grass -> color2
        | Tree1 | Tree2 | Tree3 -> color2
        | Sand -> color3
        | Bridge1 -> color4
        | Bridge2 -> color4
        | Road -> color3
        | House _ -> color3
        | _ -> color2
      in
      Canvas.fillStyle ctx color;
      Canvas.fillRect ctx x y 16 16;

      begin
        let tile =
          match cell with
          | Tree1 -> Some (16, 240)
          | Tree2 -> Some (32, 240)
          | Tree3 -> Some (48, 240)
          | House 1 -> Some (96, 48)
          | House 2 -> Some (112, 48)
          | House 3 -> Some (128, 48)
          | House 4 -> Some (96, 80)
          | House 5 -> Some (112, 80)
          | House 6 -> Some (128, 80)
          | House 7 -> Some (144, 64)
          | House 8 -> Some (160, 64)
          | House 9 -> Some (176, 64)
          | House 10 -> Some (160, 48)
          | House 11 -> Some (176, 48)
          | Bridge1 -> Some (176, 288)
          | Bridge2 -> Some (144, 288)
          | Field1 -> Some (16, 256)
          | Field2 -> Some (32, 256)
          | Field3 -> Some (48, 256)
          | _ -> None
        in
        match tile with
        | None -> ()
        | Some (sx, sy) ->
            let sw, sh = (16, 16) in
            let dx, dy, dw, dh = (x, y, 16, 16) in
            Canvas.drawImage8 ctx texture sx sy sw sh dx dy dw dh;
      end;
    ) line;
  ) world;

  List.iter (fun (i, j, sxy) ->
    let x, y = (i * 16, j * 16) in
    let dx, dy, dw, dh = (x, y, 16, 16) in
    let sw, sh = (16, 16) in
    let sx, sy = sxy in
    Canvas.drawImage8 ctx texture sx sy sw sh dx dy dw dh;
  ) !chars;

  ()
;;


let animate texture world chars () =
  display texture world chars;

  let free_at i j =
    try
      match world.(j).(i) with
      | Sand | Grass | Road | Bridge1 | Bridge2 -> true
      | _ -> false
    with _ -> false
  in
  let next_pos i j =
    match Random.int 6 with
    | 0 -> (i+1, j)
    | 1 -> (i-1, j)
    | 2 -> (i, j+1)
    | 3 -> (i, j-1)
    | _ -> (i, j)
  in

  chars :=
    List.map (fun (i, j, sxy) ->
      let _i, _j = next_pos i j in
      if free_at _i _j
      then (_i, _j, sxy)
      else (i, j, sxy)
    ) !chars;

  ()
;;


let init_texture () =
  Canvas.imageSmoothingEnabled ctx false;

  let tex_file = "./AllAssetsPreviewi.png" in

  (*
     For details about this .png file, see:

     Origin of this file:
       https://opengameart.org/content/miniworld-sprites
  *)

  (* Load the sprite sheets from image files *)

  let texture = Canvas.newImage () in
  Canvas.setImgSrc texture tex_file;

  (* Report when the sprite sheets are loaded *)
  Canvas.imgOnload texture (fun () ->
    texture_loaded := true;
  );

  (texture)
;;


(* main *)
let () =
  let chars, world = init_world () in
  let texture = init_texture () in

  let loop = Canvas.setInterval (animate texture world chars) (1000/2) in
  ignore(loop);
  ()
;;