(* A Simple Shmup Game
 Copyright (C) 2019, 2022, 2023 Florent Monnier

 To the extend permitted by the local 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.
*)

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 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 rects_collide : 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 rects_collide 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



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
module Tmn = Timeline



(* (x, y, width, height) *)
type tile = int * int * int * int
type sprite = int * int * int * int

type shoot_kind =
  | Front
  | Circle

type p_bullet_kind =
  | InFront of (int * int)
  | Line of (int * int) * (int * int) * (int * int) * int


type foe = {
  foe_pos: int * int;
  foe_anim:
    (point2d, point2d * point2d * point2d) Timeline.animated list;
  foe_last_shot: int;
  foe_shoot_freq: int;
  foe_sprite: int * int * int * int;
  foe_size: int * int;

  (* methods *)
  foe_gun: foe -> game_state -> int -> foe * foe_bullet list;
}

and foe_bullet = {
  bullet_pos: int * int;
  bullet_line: (int * int) * (int * int);
  bullet_birth: int;
  bullet_expiration_date: int;
  bullet_sprite: sprite;
  bullet_size: int * int;
}

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

and player = {
  p_pos: int * int;
  p_size: int * int;
  p_sprite: int * int * int * int;
  p_last_shot: int;
  p_shoot_freq: int;
  p_shooting: bool;
  p_shoot_kind: shoot_kind;
  p_dir: player_dir;
  p_game_over: bool;
}

and game_state = {
  player: player;
  foes: foe list;

  f_bullets: foe_bullet list;  (* foes bullets *)
  p_bullets: p_bullet_kind list;  (* player bullets *)

  background: tile array array;
  tiles: int array array;
  scroll: int;

  p_bullet_sprite1: sprite;
  p_bullet_sprite2: sprite;

  p_bullet_size1: int * int;
  p_bullet_size2: int * int;

  timer: PTimer.t;
}

type game_data = {
  texture: Canvas.image;
  mutable texture_loaded: bool;
}


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 + 4 * 16, 480)

let blue   = (0, 0, 255)
let green  = (0, 255, 0)
let red    = (255, 0, 0)
let yellow = (255, 255, 0)
let white  = (255, 255, 255)
let black  = (0, 0, 0)
let alpha  = 255

let shot = ref 0
let missed = ref 0
let bumps = ref 0



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 () = Random.self_init () ;;

let ( += ) r v =
  r := !r + v;
;;

let ( -= ) r v =
  r := !r - v;
;;



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


let set_color_bg playing =
  if playing then () else
    begin
      let color = "rgba(220, 0, 0, 0.6)" in
      Canvas.fillStyle ctx color;
      Canvas.fillRect ctx 0 0 width height;
    end;
  ()
;;


(* probabilistic choice *)
let rec prob_take k = function
  | (p, v)::tl -> if k < p then v else prob_take (k - p) tl
  | _ -> invalid_arg "prob_take"


let prob_total lst =
  List.fold_left (fun tot (p, _) -> tot + p) 0 lst



let rand_take arr =
  let n = Array.length arr in
  arr.(Random.int n)

let rand_takei arr =
  let n = Array.length arr in
  let i = Random.int n in
  (i, arr.(i))


let rand_takel l =
  rand_take (Array.of_list l)




let bg_tiles = [|
(* 0 *) 25, (32, 64, 16, 16);  (* grass bg 1 *)
(* 1 *) 25, (32, 144, 16, 16); (* grass bg 2 *)

(* 2 *)  1, (0, 96, 16, 16);   (* house 1 *)
(* 3 *)  1, (0, 112, 16, 16);  (* house 2 *)
(* 4 *)  5, (0, 64, 16, 16);   (* tree 1 *)
(* 5 *)  4, (0, 80, 16, 16);   (* tree 2 *)
(* 6 *)  3, (0, 48, 16, 16);   (* tree 3 *)
(* 7 *)  1, (0, 128, 16, 16);  (* flag *)
(* 8 *)  1, (16, 144, 16, 16); (* field 1 *)
(* 9 *)  1, (16, 160, 16, 16); (* field 2 *)
(* 10 *) 1, (48, 144, 16, 16); (* whole *)

(* 11 *) 1, (16, 96, 16, 16);  (* path, bot-right *)
(* 12 *) 1, (16, 112, 16, 16); (* path, top-bot *)
(* 13 *) 1, (16, 128, 16, 16); (* path, top-right *)
(* 14 *) 1, (32, 128, 16, 16); (* path, left-right *)
(* 15 *) 1, (48, 128, 16, 16); (* path, left-top *)
(* 16 *) 1, (64, 128, 16, 16); (* path, bot-end *)
(* 17 *) 1, (64, 144, 16, 16); (* path, top-end *)
(* 18 *) 1, (80, 128, 16, 16); (* path, right-end *)
(* 19 *) 1, (80, 144, 16, 16); (* path, left-end *)
(* 20 *) 1, (48, 96, 16, 16);  (* path, left-bot *)
(* 21 *) 1, (32, 128, 16, 16); (* path, left-right *)

(* 22 *) 1, (48, 112, 16, 16); (* path, top-bot *)
(* 23 *) 1, (32, 112, 16, 16); (* path, cross *)

(* 24 *) 1, (0, 144, 16, 16);  (* pipe *)

(* 25 *) 1, (32, 48, 16, 16);  (* sea border, ground-bot *)
(* 26 *) 1, (32, 80, 16, 16);  (* sea border, ground-top *)
(* 27 *) 1, (16, 64, 16, 16);  (* sea border, ground-right *)
(* 28 *) 1, (48, 64, 16, 16);  (* sea border, ground-left *)

(* 29 *) 1, (16, 48, 16, 16);  (* sea border, ground-right-bot *)
(* 30 *) 1, (48, 48, 16, 16);  (* sea border, ground-left-bot *)
(* 31 *) 1, (16, 80, 16, 16);  (* sea border, ground-right-top *)
(* 32 *) 1, (48, 80, 16, 16);  (* sea border, ground-left-top *)

(* 33 *) 1, (64, 48, 16, 16);  (* sea border, ground-left-top *)
(* 34 *) 1, (80, 48, 16, 16);  (* sea border, ground-right-top *)
(* 35 *) 1, (80, 64, 16, 16);  (* sea border, ground-right-bot *)
(* 36 *) 1, (64, 64, 16, 16);  (* sea border, ground-left-bot *)

(* 37 *) 1, (96, 48, 16, 16);  (* sea 1 *)
(* 38 *) 1, (64, 80, 16, 16);  (* sea 2 *)
(* 39 *) 1, (80, 80, 16, 16);  (* sea 3 *)

(* 40 *) 1, (64, 112, 16, 16); (* t-path, left-right-bot *)
(* 41 *) 1, (80, 112, 16, 16); (* t-path, left-right-top *)
(* 42 *) 1, (64, 96, 16, 16);  (* t-path, top-bot-right *)
(* 43 *) 1, (80, 96, 16, 16);  (* t-path, top-bot-left *)

(* 44 *) 1, (0, 176, 16, 16);  (* path sea border, ground-left *)
(* 45 *) 1, (16, 176, 16, 16); (* path sea border, ground-bot *)

  (*
(* __ *) 1, (128, 64, 16, 16); (* dust *)
  *)
|]

(*
let _bg_tiles = [|

(* 29 *) 1, (16, 48, 16, 16);  (* sea border, ground-corner-bot-right, sea-top-left  *)
(* 30 *) 1, (48, 48, 16, 16);  (* sea border, ground-corner-bot-left,  sea-top-right *)
(* 31 *) 1, (16, 80, 16, 16);  (* sea border, ground-corner-top-right, sea-bot-left  *)
(* 32 *) 1, (48, 80, 16, 16);  (* sea border, ground-corner-left-top,  sea-bot-right *)

(* 33 *) 1, (64, 48, 16, 16);  (* sea border, ground-left-top, sea-corner-bot-right *)
(* 34 *) 1, (80, 48, 16, 16);  (* sea border, ground-right-top, sea-corner-bot-left *)
(* 35 *) 1, (80, 64, 16, 16);  (* sea border, ground-right-bot, sea-corner-top-left *)
(* 36 *) 1, (64, 64, 16, 16);  (* sea border, ground-left-bot, sea-corner-top-right *)
|]
*)

let sea = [37; 37; 37; 37; 37; 37; 37; 37; 38; 39]


(* vertical adjacencies *)

let vert_adj_any =
  0 :: 1 :: 0 :: 1 :: 0 :: 1 ::
  0 :: 1 :: 0 :: 1 :: 0 :: 1 ::
  0 :: 1 :: 0 :: 1 :: 0 :: 1 ::
  4 :: 5 :: 6 :: 4 :: 5 :: 6 :: 2 :: 3 ::
  [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 13; 14; 15; 17; 18; 19; 21;
    25; 35; 36;
  ]

let vert_adj = [|
  ( 0, 41 :: vert_adj_any);
  ( 1, 41 :: vert_adj_any);
  ( 2, vert_adj_any);
  ( 3, vert_adj_any);
  ( 4, vert_adj_any);
  ( 5, vert_adj_any);
  ( 6, vert_adj_any);
  ( 7, vert_adj_any);
  ( 8, vert_adj_any);
  ( 9, vert_adj_any);
  (10, vert_adj_any);
  (11, vert_adj_any);
  (12, [11; 12; 16; 16; 16; 20; 23; 45]);
  (13, [11; 12; 16; 16; 16; 20; 23; 45]);
  (14, vert_adj_any);
  (15, [11; 12; 16; 16; 16; 20; 23; 45]);
  (16, vert_adj_any);
  (17, [11; 12; 16; 16; 16; 20; 23; 45]);
  (18, vert_adj_any);
  (19, vert_adj_any);
  (20, vert_adj_any);
  (21, vert_adj_any);
  (22, [11; 12; 16; 16; 16; 20; 23; 45]);
  (23, [11; 12; 16; 16; 16; 20; 23; 45]);
  (24, vert_adj_any);

  (25, 26 :: 31::32::sea);
  (26, vert_adj_any);
  (27, [27; 27; 29; 34]);

  (28, [28; 28; 30; 33; 44]);

  (29, 26 :: 31::32::sea);
  (30, 26 :: 31::32::sea);
  (31, [27; 27; 29; 34]);
  (32, [28; 28; 30; 33; 44]);
  (33, vert_adj_any);
  (34, vert_adj_any);
  (35, [27; 27; 29; 34]);
  (36, [28; 28; 30; 33; 44]);

  (37, 26::31::32::sea);
  (38, 26::31::32::sea);
  (39, 26::31::32::sea);

  (40, vert_adj_any);

  (41, 45 :: [11; 12; 16; 16; 16; 20; 22; 23; 40; 42; 43]);
  (42, 45 :: [11; 12; 16; 16; 16; 20; 22; 40; 43]);
  (43, 45 :: [11; 12; 16; 16; 16; 20; 22; 40; 42]);

  (44, [28; 28; 30; 33; 44]);

  (45, 26 :: 31::32::sea);
|]



(* horizontal adjacencies *)
let horiz_adj_any =
  0 :: 1 :: 0 :: 1 :: 0 :: 1 ::
  0 :: 1 :: 0 :: 1 :: 0 :: 1 ::
  0 :: 1 :: 0 :: 1 :: 0 :: 1 ::
  4 :: 5 :: 6 :: 4 :: 5 :: 6 :: 2 :: 3 ::
  [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 16; 17; 18; 24;
    28; 33; 36;
  ]

let horiz_adj = [|
  ( 0, horiz_adj_any);
  ( 1, horiz_adj_any);
  ( 2, horiz_adj_any);
  ( 3, horiz_adj_any);
  ( 4, horiz_adj_any);
  ( 5, horiz_adj_any);
  ( 6, horiz_adj_any);
  ( 7, horiz_adj_any);
  ( 8, horiz_adj_any);
  ( 9, horiz_adj_any);
  (10, horiz_adj_any);
  (11, [14; 15; 19; 19; 19; 20; 21; 23; 40; 41; 44]);
  (12, horiz_adj_any);
  (13, [14; 15; 19; 19; 19; 20; 21; 23; 40; 41; 44]);
  (14, [14; 15; 19; 19; 19; 20; 21; 23; 40; 41; 44]);
  (15, horiz_adj_any);
  (16, horiz_adj_any);
  (17, horiz_adj_any);
  (18, [14; 15; 19; 19; 19; 20; 21; 23; 40; 41; 44]);
  (19, horiz_adj_any);
  (20, horiz_adj_any);
  (21, [14; 15; 19; 19; 19; 20; 21; 23; 40; 41; 44]);
  (22, horiz_adj_any);
  (23, [14; 15; 19; 19; 19; 20; 21; 23; 40; 41; 44]);
  (24, horiz_adj_any);

  (25, [25; 25; 30; 35; 45]);
  (26, [26; 26; 32; 34]);
  (27, horiz_adj_any);
  (28, 27::29::31::sea);
  (29, [25; 25; 30; 35; 45]);
  (30, 27::29::31::sea);
  (31, [26; 26; 32; 34]);
  (32, 27::29::31::sea);
  (33, [26; 26; 32; 34]);
  (34, horiz_adj_any);
  (35, horiz_adj_any);
  (36, [25; 25; 30; 35; 45]);

  (37, 27::29::31::sea);
  (38, 27::29::31::sea);
  (39, 27::29::31::sea);

  (40, 44 :: [14; 15; 19; 20; 21]);
  (41, 44 :: [14; 15; 19; 19; 19; 20; 21]);
  (42, 44 :: [14; 15; 19; 19; 19; 20; 21]);
  (43, horiz_adj_any);

  (44, 27::28::29::31::sea);
  (45, [25; 25; 30; 35; 45]);
|]



(* size in tiles: 15 x 22 *)
(*
  2 screens, one above each other for scrolling
  so the background is 30 x 22
*)
let make_background () =
  let bg = Array.make_matrix 22 30 0 in

  (* x = 0 *)
  let i = Random.int 40 in
  bg.(0).(0) <- i;

  (* first line *)
  let y = 0 in
  for x = 1 to pred 22 do
    let prev = bg.(x - 1).(y) in
    let possible = snd horiz_adj.(prev) in
    let i = rand_takel possible in
    bg.(x).(y) <- i;
  done;

  (* first column *)
  for y = 1 to pred 30 do
    let x = 0 in
    begin
      let prev_v = bg.(x).(y - 1) in
      let possible = snd vert_adj.(prev_v) in
      let i = rand_takel possible in
      bg.(x).(y) <- i;
    end
  done;

  for y = 1 to pred 30 do
    for x = 1 to pred 22 do
      let prev_v = bg.(x).(y - 1) in
      let prev_h = bg.(x - 1).(y) in
      let possible1 = snd vert_adj.(prev_v) in
      let possible2 = snd horiz_adj.(prev_h) in
      let possible =
        List.filter (fun v ->
          List.mem v possible2
        ) possible1
      in
      if possible <> [] then
        let i = rand_takel possible in
          bg.(x).(y) <- i;
    done;
  done;

  let tiles = Array.make_matrix 22 30 (0, 0, 0, 0) in
  for y = 0 to pred 30 do
    for x = 0 to pred 22 do
      let i = bg.(x).(y) in
      tiles.(x).(y) <- snd bg_tiles.(i)
    done;
  done;
  (bg, tiles)



let update_background game_state =
  let tiles = game_state.background in
  let bg = game_state.tiles in

  for y = 15 to pred 30 do
    for x = 0 to pred 22 do
      let y2 = y - 15 in
      bg.(x).(y2) <- bg.(x).(y);
      tiles.(x).(y2) <- tiles.(x).(y);
    done;
  done;

  for y = 15 to pred 30 do
    let x = 0 in
    begin
      let prev_v = bg.(x).(y - 1) in
      let possible = snd vert_adj.(prev_v) in
      let i = rand_takel possible in
      bg.(x).(y) <- i;
    end
  done;

  for y = 15 to pred 30 do
    for x = 1 to pred 22 do
      let prev_v = bg.(x).(y - 1) in
      let prev_h = bg.(x - 1).(y) in
      let possible1 = snd vert_adj.(prev_v) in
      let possible2 = snd horiz_adj.(prev_h) in
      let possible =
        List.filter (fun v ->
          List.mem v possible2
        ) possible1
      in
      if possible <> [] then
        let i = rand_takel possible in
          bg.(x).(y) <- i;
    done;
  done;

  for y = 15 to pred 30 do
    for x = 0 to pred 22 do
      let i = bg.(x).(y) in
      tiles.(x).(y) <- snd bg_tiles.(i)
    done;
  done;
  (bg, tiles)



let display_background game_state tex =
  let background = game_state.background in
  let scroll = game_state.scroll / 2 in
 
  for y = 0 to pred 30 do
    for x = 0 to pred 22 do
      let sx, sy, sw, sh = background.(x).(y) in
      let y = (pred 30) - y in
      let dx, dy = (x * 16 * 2, y * 16 * 2) in
      let dw, dh = (16 * 2, 16 * 2) in
      let dy = dy + scroll in
      let dy = dy - height in
      if dy > height || (dy + dh) < 0 then () else
        Canvas.drawImage8 ctx tex sx sy sw sh dx dy dw dh;
    done;
  done;
  ()


let step_background game_state t =
  let scroll = game_state.scroll + 1 in
  if (scroll / 2) <= height then
    { game_state with scroll }
  else begin
    let scroll = scroll - (height * 2) in
    let tiles, background = update_background game_state in
    { game_state with scroll; tiles; background }
  end



let display ~playing game_state game_data =
  if game_data.texture_loaded then
  begin
    display_background game_state game_data.texture;

    set_color_bg playing;

    Canvas.font ctx "bold 17px Arial";
    Canvas.textBaseline ctx "top";
    set_color black;

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

    let s = Printf.sprintf "went through: %d" !missed in
    Canvas.fillText ctx s (width - 160) 8;

    let s = Printf.sprintf "bumps: %d" !bumps in
    Canvas.fillText ctx s 10 (height - 20);

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


    (* display foe bullets *)
    List.iter (fun bullet ->
      let x, y = bullet.bullet_pos in

      let sx, sy, sw, sh = bullet.bullet_sprite in
      let dx, dy, dw, dh = (x, y, sw * 2, sh * 2) in

      let tex = game_data.texture in
      Canvas.drawImage8 ctx tex sx sy sw sh dx dy dw dh;
    ) game_state.f_bullets;


    (* display foes *)
    List.iter (fun foe ->
      let dx, dy = foe.foe_pos in
      let dw, dh = foe.foe_size in
      let sx, sy, sw, sh = foe.foe_sprite in
      let foe_tex = game_data.texture in
      Canvas.drawImage8 ctx foe_tex sx sy sw sh dx dy dw dh;
    ) game_state.foes;


    (* display player bullets *)
    List.iter (fun b ->
      let x, y =
        match b with
        | InFront (x, y) -> (x, y)
        | Line ((x, y), _, _, _) -> (x, y)
      in
      let bullet_sprite =
        match b with
        | InFront _ -> game_state.p_bullet_sprite1  (* parallel yellow *)
        | Line _ -> game_state.p_bullet_sprite2  (* medium green *)
      in

      let sx, sy, sw, sh = bullet_sprite in
      let dx, dy, dw, dh = (x, y, sw * 2, sh * 2) in

      let tex = game_data.texture in
      Canvas.drawImage8 ctx tex sx sy sw sh dx dy dw dh;
    ) game_state.p_bullets;


    (* display player *)
    let player = game_state.player in
    begin
      let dx, dy = player.p_pos in
      (*
      let pw, ph = player.p_size in
      *)
      let sx, sy, sw, sh = player.p_sprite in
      let dw, dh = (sw * 2, sh * 2) in
      let sprite = game_data.texture in
      Canvas.drawImage8 ctx sprite sx sy sw sh dx dy dw dh;
    end;

  end
  else begin
    (* loading *)

    let color = "rgba(200, 200, 200, 1.0)" in
    Canvas.fillStyle ctx color;
    Canvas.fillRect ctx 0 0 width height;

    Canvas.font ctx "bold 24px Arial";
    Canvas.textBaseline ctx "top";
    set_color black;

    let s = "loading..." in
    Canvas.fillText ctx s 180 120;
  end;
  ()
;;



type key_change = KeyDown | KeyUp

let _ev_keychange key_change ev game_state =
  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, _, "s" ->
      { player with p_shooting = not player.p_shooting }

    | KeyDown, _, "d" ->
      { player with p_shoot_freq = 2200; p_shoot_kind = Circle }
    | KeyDown, _, "f" ->
      { player with p_shoot_freq = 280; p_shoot_kind = Front }

    | KeyDown, _, "p" ->
      PTimer.toggle_pause game_state.timer;
      player

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

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


let ev_keychange key_change ev =
  let game_state = get_ref _game_state in
  let game_state = _ev_keychange key_change ev game_state in
  set_ref _game_state game_state;
  ()
;;

let ev_mousechange change ev =
  ()
;;


let f_bullet_expired t bullet =
  bullet.bullet_expiration_date > t


let f_bullet_inside bullet =
  let x, y = bullet.bullet_pos in
  (*
  let _, _, sw, sh = bullet.bullet_sprite in
  let bw, bh = (sw * 2, sh * 2) in
  *)
  let bw, bh = bullet.bullet_size in
  (y < height) &&
  (x < width) &&
  (y > -bh) &&
  (x > -bw)


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
  let f_bullets = List.filter (f_bullet_expired t) 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 foe_size t =
  let t1 = t
  and t2 = t + 6000 + Random.int 4000 in
  let dw, dh = foe_size in
  match Random.int 7 with
  | 0 ->  (* left to right *)
      let p1, p2, p3 =
        (- dw, Random.int (height - dh)),
        (Random.int width, Random.int (height - dh)),
        (width, Random.int (height - dh))
      in
      let ps = (p1, p2, p3) in
      [ Tmn.Evol (t1, t2, fe, ps) ]
  | 1 ->  (* right to left *)
      let p1, p2, p3 =
        (width, Random.int (height - dh)),
        (Random.int width, Random.int (height - dh)),
        (- dw, Random.int (height - dh))
      in
      let ps = (p1, p2, p3) in
      [ Tmn.Evol (t1, t2, fe, ps) ]
  | 2 | 3 | 4 ->  (* top to bottom *)
      let p1, p2, p3 =
        (Random.int (width - dw), - dh),
        (Random.int (width - dw), Random.int (height - dh)),
        (Random.int (width - dw), height)
      in
      let ps = (p1, p2, p3) in
      [ Tmn.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 - dw), - dh),
        (Random.int (width - dw), Random.int (height - dh)),
        (Random.int (width - dw), Random.int (height - dh)),
        (Random.int (width - dw), Random.int (height - dh)),
        (Random.int (width - dw), height)
      in
      let ps1 = (p1, p2, p3) in
      let ps2 = (p3, p4, p5) in
      [ Tmn.Evol (t1, t2, fe, ps1);
        Tmn.From (t2, p3);
        Tmn.Evol (t3, t4, fe, ps2);
      ]
  | _ -> assert false



let f_ships_sprites = [|
  (196, 1, 26, 16);
  (197, 20, 24, 19);
  (193, 41, 32, 24);

  (229, 0, 24, 17);
  (226, 20, 30, 19);
  (225, 41, 31, 24);

  (263, 0, 20, 17);
  (262, 21, 22, 18);
  (257, 41, 32, 24);

  (294, 0, 24, 17);
  (292, 18, 28, 23);
  (290, 42, 32, 23);
|]

let p_ships_sprites = [|
  (326, 1, 26, 16);
  (327, 20, 24, 19);
  (323, 41, 32, 24);

  (359, 0, 24, 17);
  (356, 20, 30, 19);
  (356, 41, 30, 24);

  (393, 0, 20, 17);
  (392, 21, 22, 18);
  (387, 41, 32, 24);

  (424, 0, 24, 17);
  (422, 18, 28, 23);
  (420, 42, 32, 23);
|]



(* send a bullet in a random direction *)
let foe_gun0 foe game_state t =
  if t - foe.foe_last_shot < foe.foe_shoot_freq
  then (foe, game_state.f_bullets)
  else begin
    let updated_foe = { foe with foe_last_shot = t } in

    (* initial position of bullet *)
    let (_, _, sw, sh) as bullet_sprite = (51, 163, 10, 10) in
    let (bw, bh) as bullet_size = (sw * 2, sh * 2) in
    let x, y = foe.foe_pos in
    let w, h = foe.foe_size in
    let _x = x + (w / 2) - (bw / 2) in
    let _y = y + h - bh in
    let bullet_pos = (_x, _y) in
    let dest = (Random.int width, Random.int height) in

    let new_bullet =
      { bullet_pos;
        bullet_line = (bullet_pos, dest);
        bullet_birth = t;
        bullet_expiration_date = t + 12000;

        bullet_sprite;
        bullet_size;
      }
    in
    (updated_foe, new_bullet :: game_state.f_bullets)
  end



(* send a bullet in the direction of the player *)
let foe_gun1 foe game_state t =
  if t - foe.foe_last_shot < foe.foe_shoot_freq
  then (foe, game_state.f_bullets)
  else begin
    let updated_foe = { foe with foe_last_shot = t } in

    (* initial position of bullet *)
    let (_, _, sw, sh) as bullet_sprite = (34, 162, 12, 12) in
    let (bw, bh) as bullet_size = (sw * 2, sh * 2) in
    let x, y = foe.foe_pos in
    let w, h = foe.foe_size in
    let _x = x + (w / 2) - (bw / 2) in
    let _y = y + h - bh in
    let bullet_pos = (_x, _y) in

    let new_bullet =
      { bullet_pos;
        bullet_line = (bullet_pos, game_state.player.p_pos);
        bullet_birth = t;
        bullet_expiration_date = t + 12000;

        bullet_sprite;
        bullet_size;
      }
    in
    (updated_foe, new_bullet :: game_state.f_bullets)
  end



let circle n =
  let nf = float n in
  let pi = 3.14159265358979312 in
  let angle_step = (pi *. 2.0) /. nf in
  let int = int_of_float in

  let rec aux acc i =
    if i >= n then (acc)
    else begin
      let j = float i in
      let angle = angle_step *. j in
      let x = 300.0 *. (cos angle) in
      let y = 300.0 *. (sin angle) in
      let this = (int x, int y) in
      aux (this :: acc) (i + 1)
    end
  in
  aux [] 0


(* number of bullets to create: 12 *)
let circle_12 = circle 12


(* bullets spread around in a circle *)
let foe_gun2 foe game_state t =
  if t - foe.foe_last_shot < foe.foe_shoot_freq
  then (foe, game_state.f_bullets)
  else begin
    let updated_foe = { foe with foe_last_shot = t } in

    (* initial position of bullets *)
    let (_, _, sw, sh) as bullet_sprite = (51, 163, 10, 10) in
    let (bw, bh) as bullet_size = (sw * 2, sh * 2) in
    let x, y = foe.foe_pos in
    let w, h = foe.foe_size in
    let _x = x + (w / 2) - (bw / 2) in
    let _y = y + (h / 2) - (bh / 2) in
    let bullet_pos = (_x, _y) in

    let f_bullets =
      List.fold_left (fun acc (x, y) ->
        let dest = (_x + x, _y + y) in
        let new_bullet =
          { bullet_pos;
            bullet_line = (bullet_pos, dest);
            bullet_birth = t;
            bullet_expiration_date = t + 8000;

            bullet_sprite;
            bullet_size;
          }
        in
        (new_bullet :: acc)
      ) game_state.f_bullets
        circle_12
    in
    (updated_foe, f_bullets)
  end



(* leave bullet wake behind *)
let foe_gun3 foe game_state t =
  if t - foe.foe_last_shot < foe.foe_shoot_freq
  then (foe, game_state.f_bullets)
  else begin
    let updated_foe = { foe with foe_last_shot = t } in

    (* initial position of bullets *)
    let (_, _, sw, sh) as bullet_sprite = (68, 180, 8, 8) in
    let (bw, bh) as bullet_size = (sw * 2, sh * 2) in
    let x, y = foe.foe_pos in
    let w, h = foe.foe_size in
    let _x = x + (w / 2) - (bw / 2) in
    let _y = y + (h / 2) - (bh / 2) in
    let bullet_pos = (_x, _y) in
    let dest = (_x, _y + 32) in
    let new_bullet =
      { bullet_pos;
        bullet_line = (bullet_pos, dest);
        bullet_birth = t;
        bullet_expiration_date = t + 4000;  (* 4 seconds *)
        bullet_sprite;
        bullet_size;
      }
    in
    (updated_foe, new_bullet :: game_state.f_bullets)
  end



let select_foe_gun () =
  let foe_shoot_freq0 = 1200 + Random.int 1600 in
  let foe_shoot_freq1 = 1000 + Random.int 1800 in
  let foe_shoot_freq2 = 1800 + Random.int 2600 in
  let foe_shoot_freq3 =  300 + Random.int 200 in
  (* gun0: send a bullet in a random direction *)
  (* gun1: send a bullet in the direction of the player *)
  (* gun2: bullets spread around in a circle *)
  (* gun3: leave bullet wake behind *)
  let foe_gun, foe_shoot_freq =
    match Random.int 4 with
    | 0 -> (foe_gun2, foe_shoot_freq2)
    | 1 -> (foe_gun3, foe_shoot_freq3)
    | 2 -> (foe_gun0, foe_shoot_freq0)
    | _ -> (foe_gun1, foe_shoot_freq1)
  in
  (foe_gun, foe_shoot_freq)



let make_new_foe t =
  let foe_sprite, foe_size =
    let sx, sy, sw, sh = rand_take f_ships_sprites in
    let dw, dh = (sw * 2, sh * 2) in
    (sx, sy, sw, sh),
    (dw, dh)
  in
  let foe_last_shot = t in
  let foe_anim = make_foe_anim foe_size t in
  let foe_pos = Timeline.val_at t foe_anim in
  let foe_gun, foe_shoot_freq = select_foe_gun () in
  { foe_sprite; foe_pos; foe_size; foe_anim;
    foe_last_shot; foe_shoot_freq; foe_gun;
  }



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



let gun_new_foe_bullets game_state foes t =
  let rec aux f_acc f_bullets foes =
    match foes with
    | [] -> (f_acc, f_bullets)
    | foe :: foes ->
        let updated_foe, f_bullets = foe.foe_gun foe game_state t in
        aux (updated_foe :: f_acc) f_bullets foes
  in
  let foes, f_bullets = aux [] game_state.f_bullets foes 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 game_state foe =
  let x, y = foe.foe_pos in
  let dw, dh = foe.foe_size in
  let foe_rect = Rect.make4 x y dw dh in
  List.exists (fun b ->
    let pos = match b with
    | InFront (x, y) -> (x, y)
    | Line ((x, y), _, _, _) -> (x, y)
    in
    let dims = match b with
    | Line _ -> game_state.p_bullet_size2
    | InFront _ -> game_state.p_bullet_size1
    in
    let bullet_rect = Rect.make2 ~pos ~dims in
    Rect.rects_collide 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_foe_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 game_state 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 w, h = player.p_size in
  let player_rect = Rect.make4 x y w h in
  let f_bullets_touched, f_bullets =
    List.partition (fun bullet ->
      let x, y = bullet.bullet_pos in
      let w, h = bullet.bullet_size in
      let bullet_rect = Rect.make4 x y w h in
      Rect.rects_collide player_rect bullet_rect
    ) game_state.f_bullets
  in
  let player =
    match player.p_game_over, f_bullets_touched with
    | true, _ -> player
    | _, [] -> player
    | _, _ -> bumps += 1; { 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 w, h = player.p_size in
  let x = min (max _x 0) (width - w)
  and y = min (max _y 0) (height - h) in
  { player with p_pos = (x, y) }


let step_player_bullets  game_state t =
  let p_bullets = game_state.p_bullets in
  let p_bullets =
    List.map (function
    | InFront (x, y) -> InFront (x, y - 8)
    | Line ((x, y), (bx, by), (dx, dy), t0) ->
        let dt = t - t0 in
        let bullet_line = ((bx, by), (dx, dy)) in
        let x, y = point_on_line bullet_line 5800 dt in
        Line ((x, y), (bx, by), (dx, dy), t0)

    ) p_bullets
  in
  let p_bullets =
    List.filter (function
    | InFront (x, y) -> (y > -20)
    | Line ((x, y), _, _, _) -> (y > -20)
    ) p_bullets
  in
  { game_state with p_bullets }



let circle_16 = circle 16


let player_shooting  player game_state t =
  let p_bullets = game_state.p_bullets in
  if player.p_shooting
  && t - player.p_last_shot > player.p_shoot_freq
  then begin  (* shoot *)
    match player.p_shoot_kind with
    | Front ->
        let b_size = game_state.p_bullet_size1 in
        let x, y = player.p_pos in
        let w, h = player.p_size in
        let bw, bh = b_size in
        let bx = x + (w / 2) - (bw / 2) in
        let by = y in
        let bullet = InFront (bx, by) in
        let player = { player with p_last_shot = t } in
        (player, bullet :: p_bullets)

    | Circle ->
        let player = { player with p_last_shot = t } in
        let b_size = game_state.p_bullet_size2 in
        let x, y = player.p_pos in
        let w, h = player.p_size in
        let bw, bh = b_size in
        let bx = x + (w / 2) - (bw / 2) in
        let by = y + (h / 2) - (bh / 2) in
        let bullets =
          List.map (fun (_x, _y) ->
            let dx, dy = (_x + bx, _y + by) in
            let bullet = Line ((bx, by), (bx, by), (dx, dy), t) in
            (bullet)
          ) circle_16
        in
        (player, bullets @ p_bullets)
  end
  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 t
  in
  { game_state with player; p_bullets }



let update_game  game_state game_data t =
  let game_state = step_background  game_state t in
  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 t in
  let game_state = step_player  game_state t in
  (game_state)




let init_game () =
  Canvas.imageSmoothingEnabled ctx false;

  let ships_tiles = "./imgs/pixel-shmup/tiles-n-ships_packed-all3.png" in
  (*
    for details, license, and sources about this .png file, see:
    ./imgs/pixel-shmup/README.txt
    ./imgs/pixel-shmup/LICENSE.txt
    ./imgs/pixel-shmup/tiles-n-ships_packed-all3.xcf.gz
  *)

  (* Load the sprite sheets from image files *)

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

  let (_, _, p_w, p_h) as p_sprite = rand_take p_ships_sprites in  (* player sprite *)

  let tiles, background = make_background () in

  let (_, _, sw1, sh1) as p_bullet_sprite1 = (480, 272, 16, 16) in  (* parallel green *)
  let (_, _, sw2, sh2) as p_bullet_sprite2 = (468, 276, 8, 8) in  (* small green *)
  (*
  let (_, _, sw1, sh1) as p_bullet_sprite1 = (80, 160, 16, 16) in  (* parallel yellow *)
  let (_, _, sw2, sh2) as p_bullet_sprite2 = (451, 275, 10, 10) in  (* medium green *)
  *)

  let p_bullet_size1 = (sw1 * 2, sh1 * 2) in
  let p_bullet_size2 = (sw2 * 2, sh2 * 2) in

  let timer = PTimer.create () in

  let player = {
    p_pos = (width / 2 - 16, height - 80);
    p_last_shot = 0;
    p_shoot_freq = 280;
    p_shooting = false;
    p_shoot_kind = Front;
    p_game_over = false;
    p_size = (p_w * 2, p_h * 2);
    p_sprite;
    p_dir =
      { left = false;
        right = false;
        up = false;
        down = false;
      };
  } in
  let game_state = {
    player;
    foes = [];
    p_bullets = [];
    f_bullets = [];

    p_bullet_sprite1;
    p_bullet_sprite2;

    p_bullet_size1;
    p_bullet_size2;

    background;
    tiles;
    scroll = 0;
    timer;
  } in
  let game_data = {
    texture;
    texture_loaded = false;
  } in

  (* Report when the sprite sheets are loaded *)

  Canvas.imgOnload texture (fun () ->
    game_data.texture_loaded <- true;
  );

  (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;

  (*
  Canvas.addMouseEventListener Canvas.window "mousedown" (ev_mousechange true) true;
  Canvas.addMouseEventListener Canvas.window "mouseup" (ev_mousechange false) true;
  *)

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