(* A Simple Abstract Shmup Game
 Copyright (C) 2019 Florent Monnier

 To the extent permitted by law, you can use, modify, and redistribute
 this software.
*)

type point2d = int * int  (* (x, y) *)
type vector2d = int * int  (* (x, y) *)

module Vector2d : sig
  type t = vector2d  (** (x, y) *)

  val add : t -> t -> t
  (** [a + b] *)

  val sub : t -> t -> t
  (** [a - b] *)

  val mul : t -> int -> t
  (** [v * k] *)

  val div : t -> int -> t
  (** [v / k] *)

  module Infix : sig
    val ( +. ) : t -> t -> t
    val ( -. ) : t -> t -> t
    val ( *. ) : t -> int -> t
    val ( /. ) : t -> int -> t
  end
end = struct
  type t = vector2d

  let add (ax, ay) (bx, by) =
    (ax + bx,
     ay + by)

  let sub (ax, ay) (bx, by) =
    (ax - bx,
     ay - by)

  let mul (x, y) k =
    (x * k,
     y * k)

  let div (x, y) k =
    (x / k,
     y / k)

  module Infix = struct
    let ( +. ) = add ;;
    let ( -. ) = sub ;;
    let ( *. ) = mul ;;
    let ( /. ) = div ;;
  end
end


module QuadraticBezierCurves : sig
  val interval : int * int
  (** The interval for interpolation is [(0, 1000)]
      instead of [(0.0, 1.0)] for [floats]. *)

  val point_on_curve :
    point2d * point2d * point2d ->
    int -> point2d
  (** [point_on_curve (p1, p2, p3) t] returns a point on the quadratic bezier
      curve defined by p1, p2 and p3, with t in the interval predefined above *)

end = struct
  let interval = (0, 1000)

  let point_on_curve (p1, p2, p3) t =
    let ti = 1000 - t in
    Vector2d.Infix.(
      ( p1 *. ((ti * ti) / 1000) +.
        p2 *. ((2 * ti * t) / 1000) +.
        p3 *. ((t * t) / 1000)
      ) /. 1000
    )
end


module Timeline : sig
  type time = int

  type ('a, 'b) animated = [
    | `From of time * 'a
      (** [From (t, v)] after time [t] is reach (and before next timeline chunk)
          the returned value will be [v] *)
    | `Evol of time * time * (time -> time -> time -> 'b -> 'a) * 'b
      (** [Evol (t1, t2, f, d)] when [t] is between [t1] and [t2] the value is
          the result of [f t1 t2 t d] *)
    ]

  val val_at :
    time -> ('a, 'b) animated list -> 'a

  val finished :
    time -> ('a, 'b) animated list -> bool

end = struct
  type time = int

  (* animating a value over time *)

  type ('a, 'b) animated = [
    | `From of time * 'a
    | `Evol of time * time * (time -> time -> time -> 'b -> 'a) * 'b
    ]

  (* timeline function *)

  let rec val_at t = function
    | `From(t1, v) :: `From(t2,_) :: _
    | `From(t1, v) :: `Evol(t2,_,_,_) :: _
      when t1 <= t && t < t2 -> v
    
    | `From(t, v) :: [] -> v
    
    | `Evol(t1, t2, f, v) :: []
      when t >= t2 -> f t1 t2 t2 v
    
    | `Evol(t1, t2, f, v) :: _
      when t1 <= t && t <= t2 -> f t1 t2 t v
    
    | _ :: tl -> val_at t tl
    
    | [] -> invalid_arg "val_at"


  let rec finished t = function
    | `From _ :: [] -> true
    | `Evol(_, t2, _, _) :: [] -> t > t2

    | `From(t2, _) :: tl -> if t < t2 then false else finished t tl
    | `Evol(_, t2, _, _) :: tl -> if t < t2 then false else finished t tl

    | _ -> false
end


module PausableTimer : sig

  type t

  val create : unit -> t
  val get_ticks : t -> float
  val pause : t -> unit
  val is_paused : t -> bool
  val toggle_pause : t -> unit
  val restart : t -> unit

end = struct
  type t = {
    mutable t1: float;
    mutable time: float;
    mutable paused: bool
  }

  let create () = {
      t1 = 0.0;
      time = 0.0;
      paused = false;
    }

  let is_paused timer =
    timer.paused

  let get_ticks timer =
    if timer.paused
    then timer.t1 -. timer.time
    else (Js.Date.now ()) -. timer.time

  let pause timer =
    if not timer.paused then begin
      timer.t1 <- Js.Date.now ();
      timer.paused <- true;
    end

  let restart timer =
    if timer.paused then begin
      let t2 = Js.Date.now () in
      timer.time <- timer.time +. (t2 -. timer.t1);
      timer.paused <- false;
    end

  let toggle_pause timer =
    if not timer.paused
    then pause timer
    else restart timer
end


module QBCurve = QuadraticBezierCurves
module PTimer = PausableTimer



type foe = {
  foe_pos: int * int;
  foe_anim:
    (point2d, point2d * point2d * point2d) Timeline.animated list;
  foe_last_shot: int;
  foe_shoot_freq: int;
  foe_texture: Dom.element;
}

type foe_bullet = {
  bullet_pos: int * int;
  bullet_line: (int * int) * (int * int);
  bullet_birth: int;
}

type player_dir = {
  left: bool;
  right: bool;
  up: bool;
  down: bool;
}

type player = {
  p_pos: int * int;
  p_size: int * int;
  p_last_shot: int;
  p_shoot_freq: int;
  p_shooting: bool;
  p_dir: player_dir;
  p_texture: Dom.element;
  p_game_over: bool;
}

type game_state = {
  player: player;
  foes: foe list;
  f_bullets: foe_bullet list;  (* foes bullets *)
  p_bullets: (int * int) list;  (* player bullets *)
  timer: PTimer.t;
}

type game_data = {
  f_bullet_tex: Dom.element;
  p_bullet_tex: Dom.element;
}


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


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

let width, height = (640, 480)

let blue   = (0, 0, 255)
let green  = (0, 255, 0)
let yellow = (255, 255, 0)
let alpha  = 255

let shot = ref 0
let missed = ref 0


module Rect : sig
  type t = {
    x: int;
    y: int;
    w: int;
    h: int;
  }

  val make1 : int * int * int * int -> t
  val make2 : pos:int * int -> dims:int * int -> t
  val make4 : int -> int -> int -> int -> t

  val has_intersection : t -> t -> bool

end = struct

  type t = {
    x: int;
    y: int;
    w: int;
    h: int;
  }

  let make1 (x, y, w, h) =
    { x; y; w; h }

  let make2 ~pos:(x, y) ~dims:(w, h) =
    { x; y; w; h }

  let make4 x y w h =
    { x; y; w; h }

  let has_intersection a b =
    if ((a.x + a.w) < b.x) then (false) else
    if (a.x > (b.x + b.w)) then (false) else
    if ((a.y + a.h) < b.y) then (false) else
    if (a.y > (b.y + b.h)) then (false) else
    (true)
  ;;
end


let _game_state = ref None
let _game_data = ref None

let get_ref r = match !r with Some v -> v | None -> assert false
let set_ref r v = r := Some v


let set_color color =
  let r, g, b = color in
  let color = Printf.sprintf "rgba(%d,%d,%d,%d)" r g b 255 in
  Canvas.fillStyle ctx color;
;;


let fill_rect40 color x y =
  set_color color;
  Canvas.fillRect ctx x y 40 40;
;;


let fill_rect20 color x y =
  set_color color;
  Canvas.fillRect ctx x y 20 20;
;;


let make_background () =
  Array.init 12 (fun y ->
    Array.init 16 (fun x ->
      let v = 90 + Random.int 20 in
      (v, v, v)))


let background =
  Random.self_init ();
  make_background ()


let display_background playing =
  Array.iteri (fun y row ->
    Array.iteri (fun x rgb ->
      let _x = x * 40
      and _y = y * 40 in
      if playing
      then fill_rect40 rgb _x _y
      else
        let r, g, b = rgb in
        fill_rect40 (r + 40, g / 2, b / 3) _x _y
    ) row
  ) background



let display ~playing game_state game_data =

  display_background playing;

  Canvas.font ctx "bold 18px Arial";
  Canvas.textBaseline ctx "top";
  set_color green;

  let s = Printf.sprintf "shot: %d" !shot in
  Canvas.fillText ctx s 10 10;

  let s = Printf.sprintf "missed: %d" !missed in
  Canvas.fillText ctx s (width - 120) 10;

  let s = Printf.sprintf "score: %d" (!shot - !missed) in
  Canvas.fillText ctx s 10 (height - 25);


  List.iter (fun bullet ->
    let x, y = bullet.bullet_pos in
    let sprite = game_data.f_bullet_tex in
    Canvas.drawImage ctx sprite x y;
  ) game_state.f_bullets;

  List.iter (fun foe ->
    let x, y = foe.foe_pos in
    let sprite = foe.foe_texture in
    Canvas.drawImage ctx sprite x y;
  ) game_state.foes;

  List.iter (fun pos ->
    let x, y = pos in
    let sprite = game_data.p_bullet_tex in
    Canvas.drawImage ctx sprite x y;
  ) game_state.p_bullets;

  begin
    let x, y = game_state.player.p_pos in
    let sprite = game_state.player.p_texture in
    Canvas.drawImage ctx sprite x y;
  end;
;;



type key_change = KeyDown | KeyUp

let ev_keychange key_change ev =
  let game_state = get_ref _game_state in
  let player = game_state.player in
  let player =
    match key_change, ev.Canvas.keyCode, ev.Canvas.key with

    | KeyDown, 37, _ -> (* Left *)
      { player with p_dir = { player.p_dir with left = true } }
    | KeyDown, 39, _ -> (* Right *)
      { player with p_dir = { player.p_dir with right = true } }
    | KeyDown, 38, _ -> (* Up *)
      { player with p_dir = { player.p_dir with up = true } }
    | KeyDown, 40, _ -> (* Down *)
      { player with p_dir = { player.p_dir with down = true } }

    | KeyUp, 37, _ -> (* Left *)
      { player with p_dir = { player.p_dir with left = false } }
    | KeyUp, 39, _ -> (* Right *)
      { player with p_dir = { player.p_dir with right = false } }
    | KeyUp, 38, _ -> (* Up *)
      { player with p_dir = { player.p_dir with up = false } }
    | KeyUp, 40, _ -> (* Down *)
      { player with p_dir = { player.p_dir with down = false } }

    | KeyDown, _, "z" ->
      { player with p_shooting = true }
    | KeyUp, _, "z" ->
      { player with p_shooting = false }

    | KeyDown, _, " "
    | KeyDown, _, "p" ->
      PTimer.toggle_pause game_state.timer;
      if player.p_game_over
      then { player with p_game_over = false }
      else player

    | _ -> player
  in
  set_ref _game_state { game_state with player };
;;



let _texture_of_pattern pattern ~color =
  let w, h = (5, 5) in  (* width, height *)
  let imgData = Canvas.createImageData ctx (w * 4) (h * 4) in
  let pixels = imgData.Canvas.data in
  let len = Array.length pixels in

  let (r,g,b) = color in
  let width = 4 * 5 in
  let height = 4 * 5 in

  for y = 0 to height - 1 do
    for x = 0 to width - 1 do
      let _x = x / 4 in
      let _y = y / 4 in
      let v = pattern.(_y).(_x) in
      let (r,g,b,a) =
        if v = 1
        then (r,g,b,255)
        else (0,0,0,0)  (* transparent alpha *)
      in
      let pos = y * width + x in
      pixels.(pos*4 + 0) <- r;
      pixels.(pos*4 + 1) <- g;
      pixels.(pos*4 + 2) <- b;
      pixels.(pos*4 + 3) <- a;
    done;
  done;
  (imgData)


let texture_of_pattern pattern ~color =
  let overlay_canvas = Canvas.createElement Canvas.doc "canvas" in
  Canvas.setWidth overlay_canvas (4*5);
  Canvas.setHeight overlay_canvas (4*5);
  let over_ctx = Canvas.getContext overlay_canvas "2d" in

  let imgData = _texture_of_pattern pattern ~color in

  Canvas.putImageData over_ctx imgData 0 0;
  (overlay_canvas)


let make_avatar ?color () =
  let color =
    match color with
    | Some rgb -> rgb
    | None ->
        (155 + Random.int 100,
         155 + Random.int 100,
         155 + Random.int 100)
  in
  let pattern = Array.make_matrix 5 5 (0) in
  for x1 = 0 to pred 3 do
    for y = 0 to pred 5 do
      let x2 = (pred 5) - x1 in
      if Random.bool ()
      then begin
        pattern.(y).(x1) <- 1;
        pattern.(y).(x2) <- 1;
      end else begin
        pattern.(y).(x1) <- 0;
        pattern.(y).(x2) <- 0;
      end
    done
  done;
  (texture_of_pattern pattern ~color)


let f_bullet_inside bullet =
  let x, y = bullet.bullet_pos in
  (y < height) &&
  (x < width) &&
  (y > -20) &&
  (x > -20)


let point_on_line (p1, p2) i t =
  let ti = i - t in
  Vector2d.Infix.(
    ( (p1 *. ti) +.
      (p2 *. t)
    ) /. i
  )


let step_foes_bullets  game_state t =
  let step_bullet bullet =
    let dt = t - bullet.bullet_birth in
    let p = point_on_line bullet.bullet_line 6000 dt in
    { bullet with bullet_pos = p }
  in
  let f_bullets = List.map step_bullet game_state.f_bullets in
  let f_bullets = List.filter f_bullet_inside f_bullets in
  { game_state with f_bullets }


let inter1 t t1 t2 v1 v2 =
  ((v2 - v1) * (t - t1)) / (t2 - t1) + v1

let min_t, max_t = QBCurve.interval

let fe t1 t2 t ps =
  let t = inter1 t t1 t2 min_t max_t in
  QBCurve.point_on_curve ps t


let make_foe_anim t =
  let t1 = t
  and t2 = t + 6000 + Random.int 4000 in
  match Random.int 7 with
  | 0 ->  (* left to right *)
      let p1, p2, p3 =
        (-20, Random.int (height - 20)),
        (Random.int width, Random.int (height - 20)),
        (width, Random.int (height - 20))
      in
      let ps = (p1, p2, p3) in
      [ `Evol (t1, t2, fe, ps) ]
  | 1 ->  (* right to left *)
      let p1, p2, p3 =
        (width, Random.int (height - 20)),
        (Random.int width, Random.int (height - 20)),
        (-20, Random.int (height - 20))
      in
      let ps = (p1, p2, p3) in
      [ `Evol (t1, t2, fe, ps) ]
  | 2 | 3 | 4 ->  (* top to bottom *)
      let p1, p2, p3 =
        (Random.int (width - 20), -20),
        (Random.int (width - 20), Random.int (height - 20)),
        (Random.int (width - 20), height)
      in
      let ps = (p1, p2, p3) in
      [ `Evol (t1, t2, fe, ps) ]
  | 5 | 6 ->  (* top to middle, pause, middle to bottom *)
      let t1 = t
      and t2 = t + 4000 + Random.int 3000 in
      let t3 = t2 + 2000 + Random.int 2000 in
      let t4 = t3 + 4000 + Random.int 3000 in
      let p1, p2, p3, p4, p5 =
        (Random.int (width - 20), -20),
        (Random.int (width - 20), Random.int (height - 20)),
        (Random.int (width - 20), Random.int (height - 20)),
        (Random.int (width - 20), Random.int (height - 20)),
        (Random.int (width - 20), height)
      in
      let ps1 = (p1, p2, p3) in
      let ps2 = (p3, p4, p5) in
      [ `Evol (t1, t2, fe, ps1);
        `From (t2, p3);
        `Evol (t3, t4, fe, ps2); ]
  | _ -> assert false


let make_new_foe t =
  let foe_texture = make_avatar () in
  let foe_pos = (Random.int (width - 20), -20) in
  let foe_anim = make_foe_anim t in
  let foe_last_shot = t in
  let foe_shoot_freq = 1800 + Random.int 2200 in
  { foe_texture; foe_pos; foe_anim; foe_last_shot; foe_shoot_freq }


let new_foes_opt game_state game_data t =
  if Random.int 100 > 2
  then game_state.foes
  else
    let new_foe = make_new_foe t in
    (new_foe :: game_state.foes)


let gun_new_f_bullets game_state foes t =
  let rec aux acc1 acc2 foes =
    match foes with
    | [] -> (acc1, acc2)
    | foe :: foes ->
        if t - foe.foe_last_shot < foe.foe_shoot_freq
        then aux acc1 (foe :: acc2) foes
        else
          let updated_foe = { foe with foe_last_shot = t } in
          let bullet =
            { bullet_pos = foe.foe_pos;
              bullet_line = (foe.foe_pos, game_state.player.p_pos);
              bullet_birth = t; }
          in
          aux (bullet :: acc1) (updated_foe :: acc2) foes
  in
  let new_f_bullets, foes = aux [] [] foes in
  let f_bullets = List.rev_append new_f_bullets game_state.f_bullets in
  let foes = List.rev foes in
  (f_bullets, foes)


let foe_inside t foe =
  not (Timeline.finished t foe.foe_anim)


let foe_touched p_bullets foe =
  let x, y = foe.foe_pos in
  let foe_rect = Rect.make4 x y 20 20 in
  List.exists (fun (x, y) ->
    let bullet_rect = Rect.make4 x y 20 20 in
    Rect.has_intersection foe_rect bullet_rect
  ) p_bullets


let step_foes  game_state game_data t =
  let step_foe foe =
    let new_pos = Timeline.val_at t foe.foe_anim in
    { foe with foe_pos = new_pos }
  in
  let foes = new_foes_opt game_state game_data t in
  let f_bullets, foes = gun_new_f_bullets game_state foes t in
  let foes = List.map step_foe foes in
  let foes =
    List.filter (fun foe ->
      if foe_inside t foe
      then true
      else (incr missed; false)
    ) foes
  in
  let foes =
    List.filter (fun foe ->
      if foe_touched game_state.p_bullets foe
      then (incr shot; false)
      else true
    ) foes
  in
  { game_state with foes; f_bullets }


let __player_touched  game_state =
  let player = game_state.player in
  let x, y = player.p_pos in
  let player_rect = Rect.make4 x y 20 20 in
  let p_game_over =
    List.exists (fun bullet ->
      let x, y = bullet.bullet_pos in
      let x, y = (x + 4, y + 4) in
      let bullet_rect = Rect.make4 x y 12 12 in
      Rect.has_intersection player_rect bullet_rect
    ) game_state.f_bullets
  in
  let player = { player with p_game_over } in
  { game_state with player }


let player_touched  game_state =
  let player = game_state.player in
  let x, y = player.p_pos in
  let w, h = player.p_size in
  let player_rect = Rect.make4 x y w h in
  let f_bullets_collide, f_bullets =
    List.partition (fun bullet ->
      let x, y = bullet.bullet_pos in
      let x, y = (x + 4, y + 4) in
      let bullet_rect = Rect.make4 x y 12 12 in
      Rect.has_intersection player_rect bullet_rect
    ) game_state.f_bullets
  in
  let player =
    match player.p_game_over, List.length f_bullets_collide with
    | true, _ -> player
    | _, 0 -> player
    | _, n -> { player with p_game_over = true; }
  in
  { game_state with player; f_bullets; }


let player_moving player =
  let x, y = player.p_pos in
  let _x, _y =
    match player.p_dir with
    | { left = true; right = false; up = false; down = false } -> (x - 10, y)
    | { left = false; right = true; up = false; down = false } -> (x + 10, y)
    | { left = false; right = false; up = true; down = false } -> (x, y - 10)
    | { left = false; right = false; up = false; down = true } -> (x, y + 10)

    | { left = true; right = false; up = true; down = false } -> (x - 7, y - 7)
    | { left = true; right = false; up = false; down = true } -> (x - 7, y + 7)
    | { left = false; right = true; up = true; down = false } -> (x + 7, y - 7)
    | { left = false; right = true; up = false; down = true } -> (x + 7, y + 7)

    | _ -> (x, y)
  in
  let x = min (max _x 0) (width - 20)
  and y = min (max _y 0) (height - 20) in
  { player with p_pos = (x, y) }


let step_player_bullets  game_state =
  let p_bullets =
    game_state.p_bullets
      |> List.map (fun (x, y) -> (x, y - 8))
      |> List.filter (fun (x, y) -> y > -20)
  in
  { game_state with p_bullets }


let player_shooting  player p_bullets t =
  if player.p_shooting
  && t - player.p_last_shot > player.p_shoot_freq
  then (* shoot *)
    let bullet = player.p_pos in
    let player = { player with p_last_shot = t } in
    (player, bullet :: p_bullets)
  else
    (player, p_bullets)


let step_player  game_state t =
  let player = player_moving game_state.player in
  let player, p_bullets = player_shooting  player game_state.p_bullets t in
  { game_state with player; p_bullets }


let step_background background =
  Array.iteri (fun y row ->
    Array.iteri (fun x _ ->
      let v = 90 + Random.int 20 in
      if Random.int 2600 = 0 then
        background.(y).(x) <- (v, v, v)
    ) row
  ) background


let update_game  game_state game_data t =
  step_background background;
  let game_state = step_foes  game_state game_data t in
  let game_state = step_foes_bullets  game_state t in
  let game_state = step_player_bullets  game_state in
  let game_state = step_player  game_state t in
  (game_state)



let init_game () =
  let player_texture = make_avatar ~color:blue () in
  let player = {
    p_pos = (width / 2 - 10, height - 70);
    p_size = (20, 20);
    p_last_shot = 0;
    p_shoot_freq = 240;
    p_shooting = false;
    p_game_over = false;
    p_dir =
      { left = false;
        right = false;
        up = false;
        down = false;
      };
    p_texture = player_texture;
  } in

  let fb_pattern = [|
    [| 0; 0; 0; 0; 0 |];
    [| 0; 1; 0; 1; 0 |];
    [| 0; 0; 0; 0; 0 |];
    [| 0; 1; 0; 1; 0 |];
    [| 0; 0; 0; 0; 0 |];
  |] in
  let pb_pattern = [|
    [| 1; 0; 0; 0; 1 |];
    [| 1; 0; 0; 0; 1 |];
    [| 0; 0; 0; 0; 0 |];
    [| 1; 0; 0; 0; 1 |];
    [| 1; 0; 0; 0; 1 |];
  |] in

  let f_bullet_tex = texture_of_pattern fb_pattern ~color:yellow in
  let p_bullet_tex = texture_of_pattern pb_pattern ~color:green in

  let timer = PTimer.create () in

  let game_state = {
    player;
    foes = [];
    p_bullets = [];
    f_bullets = [];
    timer;
  } in
  let game_data = {
    f_bullet_tex;
    p_bullet_tex;
  } in
  (game_state, game_data)



let animate () =
  let game_state = get_ref _game_state in
  let game_data = get_ref _game_data in

  let t = PTimer.get_ticks game_state.timer in
  let t = int_of_float t in
  let t = t - t0 in

  let game_state = player_touched  game_state in
  let game_over = game_state.player.p_game_over in

  if game_over
  then PTimer.pause game_state.timer;

  let game_state =
    if game_over || PTimer.is_paused game_state.timer
    then game_state
    else update_game  game_state game_data t
  in

  set_ref _game_state game_state;

  let playing = if game_over then false else true in

  display ~playing game_state game_data;
;;



let () =
  let game_state, game_data = init_game () in

  set_ref _game_state game_state;
  set_ref _game_data game_data;

  Canvas.addKeyEventListener Canvas.window "keydown" (ev_keychange KeyDown) true;
  Canvas.addKeyEventListener Canvas.window "keyup" (ev_keychange KeyUp) true;

  let loop = Canvas.setInterval animate (1000/25) in
  ignore(loop);
  ()
;;