(* A Simple Shmup Game Copyright (C) 2019, 2022, 2023 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. *) 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 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 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 (* (x, y, width, height) *) type tile = int * int * int * int type sprite = int * int * int * int type foe = { foe_pos: int * int; foe_timeline: (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; f_bullet_sprite: sprite; f_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_dir: player_dir; p_game_over: bool; } and game_state = { player: player; foes: foe list; f_bullets: foe_bullet list; (* foes bullets *) p_bullets: (int * int) list; (* player bullets *) background: ((int * int) * tile) list; p_bullet_sprite: sprite; p_bullet_size: int * int; timer: PTimer.t; } type game_data = { tiles_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 = (470, 350) 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 deaths = 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 game_state = let game_over = game_state.player.p_game_over in if game_over then begin let color = "rgba(20, 20, 20, 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 ships_sprites = [| (3, 3, 14, 13); (20, 2, 18, 11); (40, 3, 8, 9); (38, 20, 12, 11); (51, 4, 13, 9); (* (50, 45, 18, 21); (29, 45, 18, 21); *) (9, 45, 18, 21); (161, 52, 12, 13); |] let letter_tiles = [| 'a', (161, 79, 7, 7); 'b', (174, 79, 7, 7); 'c', (187, 79, 7, 7); 'd', (200, 79, 7, 7); 'e', (213, 79, 7, 7); 'f', (161, 88, 7, 7); 'g', (174, 88, 7, 7); 'h', (187, 88, 7, 7); 'i', (200, 88, 7, 7); 'j', (213, 88, 7, 7); 'k', (161, 97, 7, 7); 'l', (174, 97, 7, 7); 'm', (187, 97, 7, 7); 'n', (200, 97, 7, 7); 'o', (213, 97, 7, 7); 'p', (161, 106, 7, 7); 'q', (174, 106, 7, 7); 'r', (187, 106, 7, 7); 's', (200, 106, 7, 7); 't', (213, 106, 7, 7); 'u', (161, 115, 7, 7); 'v', (174, 115, 7, 7); 'w', (187, 115, 7, 7); 'x', (200, 115, 7, 7); 'y', (213, 115, 7, 7); 'z', (226, 115, 7, 7); '0', (81, 79, 5, 7); '1', (92, 79, 5, 7); '2', (103, 79, 5, 7); '3', (114, 79, 5, 7); '4', (125, 79, 5, 7); '5', (81, 88, 5, 7); '6', (92, 88, 5, 7); '7', (103, 88, 5, 7); '8', (114, 88, 5, 7); '9', (125, 88, 5, 7); '-', (73, 79, 5, 7); ':', (121, 70, 5, 7); |] let bg_tiles = [| (134, 41, 10, 67); (146, 9, 10, 115); (* (187, 35, 27, 27); *) (236, 3, 10, 83); (248, 3, 14, 92); (263, 3, 16, 139); (134, 41, 10, 67); (146, 9, 10, 115); (* (187, 35, 27, 27); *) (236, 3, 10, 83); (248, 3, 14, 92); (263, 3, 16, 139); (* (* (285, 5, 16, 138); (* fruits *) (285, 25, 16, 98); (* fruits *) *) (285, 25, 16, 77); (* fruits *) (285, 25, 16, 57); (* fruits *) (* (285, 45, 16, 57); (* fruits *) (285, 65, 16, 57); (* fruits *) (285, 86, 16, 57); (* fruits *) *) (285, 86, 16, 57); (* fruits *) (* (285, 86, 16, 36); (* fruits *) *) (285, 66, 16, 36); (* fruits *) (285, 106, 16, 36); (* fruits *) *) (* *) (318, 0, 20, 22); (* fruits w *) (318, 22, 20, 22); (* fruits w *) (318, 43, 20, 22); (* fruits w *) (318, 64, 20, 22); (* fruits w *) (318, 85, 20, 22); (* fruits w *) (318, 129, 20, 22); (* fruits w *) (* (304, 6, 12, 53); (304, 67, 12, 73); (304, 27, 12, 93); (304, 27, 12, 12); (304, 47, 12, 12); (304, 107, 12, 13); (304, 127, 12, 13); *) (341, 6, 12, 53); (341, 67, 12, 73); (341, 27, 12, 93); (341, 27, 12, 12); (341, 47, 12, 12); (341, 107, 12, 13); (341, 127, 12, 13); |] let new_bg_color () = let colors = [| "#d27428"; (* orange *) "#6e5b89"; (* purple *) "#64a158"; (* green *) "#028a9d"; (* blue *) "#a24148"; (* warm *) |] in let n = Array.length colors in colors.(Random.int n) let bg_color = ref (new_bg_color ()) let () = Canvas.set_bg_color !bg_color ;; let change_bg_color () = bg_color := new_bg_color (); Canvas.set_bg_color !bg_color; () ;; let display_background game_state game_data = Canvas.fillStyle ctx !bg_color; Canvas.fillRect ctx 0 0 width height; let tex = game_data.tiles_texture in List.iter (fun ((dx, dy), (sx, sy, sw, sh)) -> let dw, dh = (sw * 2, sh * 2) in Canvas.drawImage8 ctx tex sx sy sw sh dx dy dw dh; ) game_state.background; () let step_background game_state t = if Random.int 1000 > 10 then begin let background = game_state.background in let background = (* scroll background *) List.map (fun ((dx, dy), bg_tile) -> ((dx, dy+1), bg_tile) ) background in let background = (* remove elements that are out of screen *) List.filter (fun ((dx, dy), bg_tile) -> dy < height) background in { game_state with background } end else begin (* add a new background element *) let background = game_state.background in let bg_tile = rand_take bg_tiles in let _, _, w, h = bg_tile in let h2 = h * 2 in let w2 = w * 2 in let rec try_pos i = if i > 5 then None else let y = 0 - h2 in let x = Random.int (width - w2) in let r = Rect.make4 (x-2) y (w2+4) h2 in let collide = List.exists (fun ((x, y), (_, _, w, h)) -> let bg = Rect.make4 x y (w*2) (h*2) in Rect.has_intersection r bg ) background in if collide then try_pos (i+1) else Some (x, y) in match try_pos 0 with | None -> game_state | Some pos -> let bg_elem = (pos, bg_tile) in let background = bg_elem :: background in { game_state with background } end (* main-display *) let display game_state game_data = if game_data.texture_loaded then begin display_background game_state game_data; set_color_bg game_state; Canvas.font ctx "bold 13px Arial"; Canvas.textBaseline ctx "top"; set_color black; let s = Printf.sprintf "missing: %d" !shot in Canvas.fillText ctx s 10 8; let s = Printf.sprintf "passed through: %d" !missed in Canvas.fillText ctx s (width - 140) 8; let s = Printf.sprintf "score: %d" (!shot - !missed - (10 * !deaths)) in Canvas.fillText ctx s 10 (height - 20); let s = Printf.sprintf "bumps: %d" (!deaths) in Canvas.fillText ctx s (width - 80) (height - 20); let tex = game_data.tiles_texture in (* display foe bullets *) List.iter (fun bullet -> let x, y = bullet.bullet_pos in let sx, sy, sw, sh = bullet.f_bullet_sprite in let dx, dy, dw, dh = (x, y, sw * 2, sh * 2) 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 Canvas.drawImage8 ctx tex sx sy sw sh dx dy dw dh; ) game_state.foes; (* display player bullets *) List.iter (fun pos -> let x, y = pos in let sx, sy, sw, sh = game_state.p_bullet_sprite in let dx, dy, dw, dh = (x, y, sw * 2, sh * 2) 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 sx, sy, sw, sh = player.p_sprite in let dw, dh = (sw * 2, sh * 2) in Canvas.drawImage8 ctx tex sx sy sw sh dx dy dw dh; end; end else begin let s = "loading..." in Canvas.font ctx "bold 16px Arial"; Canvas.textBaseline ctx "top"; Canvas.fillText ctx s (width / 4) (height / 3); 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, _, "p" -> PTimer.toggle_pause game_state.timer; player | KeyDown, _, "c" -> change_bg_color (); 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_inside bullet = let x, y = bullet.bullet_pos in let bw, bh = bullet.f_bullet_size in (y < height) && (x < width) && (y > -bh) && (x > -bw) let f_bullet_expired t bullet = bullet.bullet_expiration_date > t 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 4000 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_timeline 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 [ `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 [ `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 [ `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 [ `Evol (t1, t2, fe, ps1); `From (t2, p3); `Evol (t3, t4, fe, ps2); ] | _ -> assert false (* 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 f_bullet_sprite = (6, 39, 6, 6) in let (bw, bh) as f_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; f_bullet_sprite; f_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 = 200.0 *. (cos angle) in let y = 200.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 f_bullet_sprite = (6, 39, 6, 6) in let (bw, bh) as f_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; f_bullet_sprite; f_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 let (_, _, sw, sh) as f_bullet_sprite = (18, 33, 4, 4) in let (bw, bh) as f_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 + 6000; f_bullet_sprite; f_bullet_size; } in (updated_foe, new_bullet :: game_state.f_bullets) end 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 (foes, f_bullets) let make_new_foe t = let foe_sprite, foe_size = let sx, sy, sw, sh = rand_take ships_sprites in let dw, dh = (sw * 2, sh * 2) in (sx, sy, sw, sh), (dw, dh) in let foe_timeline = make_foe_timeline foe_size t in let foe_pos = Timeline.val_at t foe_timeline in let foe_last_shot = t - 1200 in let foe_shoot_freq1 = 800 + Random.int 1000 in let foe_shoot_freq2 = 1200 + Random.int 1400 in let foe_shoot_freq3 = 300 + Random.int 300 in let foe_gun, foe_shoot_freq = match Random.int 8 with | 0 -> (foe_gun2, foe_shoot_freq2) | 1 -> (foe_gun3, foe_shoot_freq3) | _ -> (foe_gun1, foe_shoot_freq1) in { foe_sprite; foe_pos; foe_size; foe_timeline; foe_last_shot; foe_shoot_freq; foe_gun; } 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 foe_inside t foe = not (Timeline.finished t foe.foe_timeline) let foe_touched p_bullets p_bullet_size foe = let x, y = foe.foe_pos in let dw, dh = foe.foe_size in let dims = p_bullet_size in let foe_rect = Rect.make4 x y dw dh in List.exists (fun pos -> let bullet_rect = Rect.make2 ~pos ~dims 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_timeline in { foe with foe_pos = new_pos } in let foes = new_foes_opt game_state game_data t in let foes, f_bullets = 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.p_bullet_size 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.f_bullet_size in let bullet_rect = Rect.make4 x y w h in Rect.has_intersection player_rect bullet_rect ) game_state.f_bullets in let player = match player.p_game_over, List.length f_bullets_touched with | true, _ -> player | _, 0 -> player | _, n -> deaths += 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 = 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 b_size p_bullets t = if player.p_shooting && t - player.p_last_shot > player.p_shoot_freq then (* shoot *) 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 = (bx, by) 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_bullet_size game_state.p_bullets 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 in let game_state = step_player game_state t in (game_state) let init_game () = Canvas.imageSmoothingEnabled ctx false; let tiles_tex = "./imgs/CJJammies/ship-transp.png" in (* for details about this .png file, see: ./imgs/CJJammies/README.txt ./imgs/CJJammies/LICENSE.txt *) (* Load the sprite sheets from image files *) let tiles_texture = Canvas.newImage () in Canvas.setImgSrc tiles_texture tiles_tex; let (_, _, p_w, p_h) as p_sprite = (10, 104, 14, 18) in let (_, _, sw, sh) as p_bullet_sprite = (15, 95, 4, 6) in let p_bullet_size = (sw * 2, sh * 2) in let timer = PTimer.create () in let player = { p_pos = (width / 2 - 16, height - 80); p_last_shot = 0; p_shoot_freq = 220; p_shooting = false; 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_sprite; p_bullet_size; background = []; timer; } in let game_data = { tiles_texture; texture_loaded = false; } in (* Report when the sprite sheets are loaded *) Canvas.imgOnload tiles_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; display 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); () ;;