Skip to content

Instantly share code, notes, and snippets.

@fccm

fccm/shmup_av6.ml

Last active June 1, 2019 07:24
Show Gist options
  • Save fccm/ade9aee7b4594dc9c130b40098ad92ab to your computer and use it in GitHub Desktop.
Save fccm/ade9aee7b4594dc9c130b40098ad92ab to your computer and use it in GitHub Desktop.
Download ZIP
A Simple Abstract Shmup Game
Raw
shmup_av6.ml
(* A Simple Abstract Shmup Game
Copyright (C) 2019 Florent Monnier
This software is provided "AS-IS", without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software and associated elements
for any purpose, including commercial applications, and to alter it and
redistribute it freely.
*)
open Sdl
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 finished t = function
| `From _ :: [] -> true
| `Evol(_, t2, _, _) :: [] -> t > t2
| _ -> false
end
module QBCurve = QuadraticBezierCurves
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: Texture.t;
}
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_last_shot: int;
p_shoot_freq: int;
p_shooting: bool;
p_dir: player_dir;
p_texture: Texture.t;
}
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
let letters = [
'0', [|
[| 0; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 1; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
|];
'1', [|
[| 0; 0; 1; 0; 0 |];
[| 0; 1; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 1; 1; 1; 0 |];
|];
'2', [|
[| 1; 1; 1; 0; 0 |];
[| 0; 0; 0; 1; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 1; 0; 0; 0 |];
[| 1; 1; 1; 1; 0 |];
|];
'3', [|
[| 1; 1; 1; 0; 0 |];
[| 0; 0; 0; 1; 0 |];
[| 0; 1; 1; 0; 0 |];
[| 0; 0; 0; 1; 0 |];
[| 1; 1; 1; 0; 0 |];
|];
'4', [|
[| 0; 0; 0; 1; 0 |];
[| 0; 0; 1; 1; 0 |];
[| 0; 1; 0; 1; 0 |];
[| 1; 1; 1; 1; 1 |];
[| 0; 0; 0; 1; 0 |];
|];
'5', [|
[| 1; 1; 1; 1; 1 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 1; 1; 1; 0 |];
[| 0; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 0 |];
|];
'6', [|
[| 0; 0; 1; 1; 0 |];
[| 0; 1; 0; 0; 0 |];
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
|];
'7', [|
[| 1; 1; 1; 1; 1 |];
[| 0; 0; 0; 1; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 1; 0; 0; 0 |];
[| 1; 0; 0; 0; 0 |];
|];
'8', [|
[| 0; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
|];
'9', [|
[| 0; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 1 |];
[| 0; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
|];
' ', [|
[| 0; 0; 0; 0; 0 |];
[| 0; 0; 0; 0; 0 |];
[| 0; 0; 0; 0; 0 |];
[| 0; 0; 0; 0; 0 |];
[| 0; 0; 0; 0; 0 |];
|];
':', [|
[| 0; 0; 0; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 0; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 0; 0; 0 |];
|];
'-', [|
[| 0; 0; 0; 0; 0 |];
[| 0; 0; 0; 0; 0 |];
[| 0; 1; 1; 1; 0 |];
[| 0; 0; 0; 0; 0 |];
[| 0; 0; 0; 0; 0 |];
|];
'a', [|
[| 0; 0; 1; 0; 0 |];
[| 0; 1; 0; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 1 |];
[| 1; 0; 0; 0; 1 |];
|];
'b', [|
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 0 |];
|];
'c', [|
[| 0; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
|];
'd', [|
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 0 |];
|];
'e', [|
[| 1; 1; 1; 1; 1 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 1; 1; 1; 1 |];
|];
'f', [|
[| 1; 1; 1; 1; 1 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 0; 0; 0; 0 |];
|];
'g', [|
[| 0; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 0; 0; 1; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
|];
'h', [|
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
|];
'i', [|
[| 0; 1; 1; 1; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 1; 1; 1; 0 |];
|];
'j', [|
[| 0; 0; 1; 1; 1 |];
[| 0; 0; 0; 1; 0 |];
[| 0; 0; 0; 1; 0 |];
[| 1; 0; 0; 1; 0 |];
[| 0; 1; 1; 0; 0 |];
|];
'k', [|
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 1; 0 |];
[| 1; 1; 1; 0; 0 |];
[| 1; 0; 0; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
|];
'l', [|
[| 1; 0; 0; 0; 0 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 1; 1; 1; 0 |];
|];
'm', [|
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 0; 1; 1 |];
[| 1; 0; 1; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
|];
'n', [|
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 0; 0; 1 |];
[| 1; 0; 1; 0; 1 |];
[| 1; 0; 0; 1; 1 |];
[| 1; 0; 0; 0; 1 |];
|];
'o', [|
[| 0; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
|];
'p', [|
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 0 |];
[| 1; 0; 0; 0; 0 |];
|];
'q', [|
[| 0; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 1; 0 |];
[| 0; 1; 1; 0; 1 |];
|];
'r', [|
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 0 |];
[| 1; 0; 1; 0; 0 |];
[| 1; 0; 0; 1; 0 |];
|];
's', [|
[| 0; 1; 1; 1; 1 |];
[| 1; 0; 0; 0; 0 |];
[| 0; 1; 1; 1; 0 |];
[| 0; 0; 0; 0; 1 |];
[| 1; 1; 1; 1; 0 |];
|];
't', [|
[| 1; 1; 1; 1; 1 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
|];
'u', [|
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 1; 1; 0 |];
|];
'v', [|
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 0; 1; 0 |];
[| 0; 0; 1; 0; 0 |];
|];
'w', [|
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 1; 0; 1; 0; 1 |];
[| 1; 0; 1; 0; 1 |];
[| 0; 1; 0; 1; 0 |];
|];
'x', [|
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 0; 1; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 1; 0; 1; 0 |];
[| 1; 0; 0; 0; 1 |];
|];
'y', [|
[| 1; 0; 0; 0; 1 |];
[| 0; 1; 0; 1; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 0; 1; 0; 0 |];
|];
'z', [|
[| 1; 1; 1; 1; 1 |];
[| 0; 0; 0; 1; 0 |];
[| 0; 0; 1; 0; 0 |];
[| 0; 1; 0; 0; 0 |];
[| 1; 1; 1; 1; 1 |];
|];
]
let fill_rect40 renderer color x y =
let rect = Rect.make4 x y 40 40 in
Render.set_draw_color renderer color alpha;
Render.fill_rect renderer rect;
;;
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 = make_background ()
let display_background renderer playing =
for y = 0 to pred 12 do
for x = 0 to pred 16 do
let _x = x * 40
and _y = y * 40 in
let rgb = background.(y).(x) in
if playing
then fill_rect40 renderer rgb _x _y
else
let r, g, b = rgb in
fill_rect40 renderer (r + 40, g / 2, b / 3) _x _y
done
done
let src_rect = Rect.make4 0 0 5 5
let display renderer playing player f_bullets p_bullets foes
f_bullet_tex p_bullet_tex letters_tex =
display_background renderer playing;
let draw_letter texture x y size =
let dst_rect = Rect.make4 x y size size in
Render.copy renderer ~texture ~src_rect ~dst_rect ();
in
let s = Printf.sprintf "shot: %d" !shot in
String.iteri (fun i c ->
let tex = List.assoc c letters_tex in
let x = i * 20 + 10 in
let y = 10 in
draw_letter tex x y 15;
) s;
let s = Printf.sprintf "missed: %d" !missed in
String.iteri (fun i c ->
let tex = List.assoc c letters_tex in
let x = i * 15 + width - 170 in
let y = 10 in
draw_letter tex x y 10;
) s;
let s = Printf.sprintf "score: %d" (!shot - !missed) in
String.iteri (fun i c ->
let tex = List.assoc c letters_tex in
let x = i * 15 + 10 in
let y = height - 25 in
draw_letter tex x y 10;
) s;
List.iter (fun bullet ->
let x, y = bullet.bullet_pos in
let dst_rect = Rect.make4 x y 20 20 in
Render.copy renderer ~texture:f_bullet_tex ~src_rect ~dst_rect ();
) f_bullets;
List.iter (fun foe ->
let x, y = foe.foe_pos in
let dst_rect = Rect.make4 x y 20 20 in
Render.copy renderer ~texture:foe.foe_texture ~src_rect ~dst_rect ();
) foes;
List.iter (fun pos ->
let x, y = pos in
let dst_rect = Rect.make4 x y 20 20 in
Render.copy renderer ~texture:p_bullet_tex ~src_rect ~dst_rect ();
) p_bullets;
begin
let x, y = player.p_pos in
let dst_rect = Rect.make4 x y 20 20 in
Render.copy renderer ~texture:player.p_texture ~src_rect ~dst_rect ();
end;
Render.render_present renderer;
;;
let proc_events player = function
| Event.KeyDown { Event.keycode = Keycode.Left } ->
{ player with p_dir = { player.p_dir with left = true } }
| Event.KeyDown { Event.keycode = Keycode.Right } ->
{ player with p_dir = { player.p_dir with right = true } }
| Event.KeyDown { Event.keycode = Keycode.Up } ->
{ player with p_dir = { player.p_dir with up = true } }
| Event.KeyDown { Event.keycode = Keycode.Down } ->
{ player with p_dir = { player.p_dir with down = true } }
| Event.KeyUp { Event.keycode = Keycode.Left } ->
{ player with p_dir = { player.p_dir with left = false } }
| Event.KeyUp { Event.keycode = Keycode.Right } ->
{ player with p_dir = { player.p_dir with right = false } }
| Event.KeyUp { Event.keycode = Keycode.Up } ->
{ player with p_dir = { player.p_dir with up = false } }
| Event.KeyUp { Event.keycode = Keycode.Down } ->
{ player with p_dir = { player.p_dir with down = false } }
| Event.KeyDown { Event.keycode = Keycode.Z } ->
{ player with p_shooting = true }
| Event.KeyUp { Event.keycode = Keycode.Z } ->
{ player with p_shooting = false }
| Event.KeyDown { Event.keycode = Keycode.F } ->
Gc.full_major (); player
| Event.KeyDown { Event.keycode = Keycode.Q }
| Event.KeyDown { Event.keycode = Keycode.Escape }
| Event.Quit _ -> Sdl.quit (); exit 0
| Event.Joy_Button_Down { Event.jb_which = 0; Event.jb_button = 0 } ->
{ player with p_shooting = true }
| Event.Joy_Button_Up { Event.jb_which = 0; Event.jb_button = 0 } ->
{ player with p_shooting = false }
| Event.Joy_Axis_Motion e -> player
| Event.Joy_Hat_Motion e ->
begin match e.Event.jh_dir with
| Hat.Up ->
{ player with p_dir =
{ left = false; right = false; up = true; down = false } }
| Hat.Down ->
{ player with p_dir =
{ left = false; right = false; up = false; down = true } }
| Hat.Left ->
{ player with p_dir =
{ left = true; right = false; up = false; down = false } }
| Hat.Right ->
{ player with p_dir =
{ left = false; right = true; up = false; down = false } }
| Hat.Right_Up ->
{ player with p_dir =
{ left = false; right = true; up = true; down = false } }
| Hat.Right_Down ->
{ player with p_dir =
{ left = false; right = true; up = false; down = true } }
| Hat.Left_Up ->
{ player with p_dir =
{ left = true; right = false; up = true; down = false } }
| Hat.Left_Down ->
{ player with p_dir =
{ left = true; right = false; up = false; down = true } }
| Hat.Centered ->
{ player with p_dir =
{ left = false; right = false; up = false; down = false } }
end
| _ -> player
let rec event_loop player =
match Event.poll_event () with
| None -> player
| Some ev ->
let player = proc_events player ev in
event_loop player
let pixel_for_surface ~surface ~rgb =
let fmt = Surface.get_pixelformat_t surface in
let pixel_format = Pixel.alloc_format fmt in
let pixel = Pixel.map_RGB pixel_format rgb in
Pixel.free_format pixel_format;
(pixel)
let make_avatar renderer ?color () =
let surface = Surface.create_rgb ~width:5 ~height:5 ~depth:32 in
let rgb = (255, 255, 255) in
let key = pixel_for_surface ~surface ~rgb in
Surface.set_color_key surface ~enable:true ~key;
let rgb =
match color with
| Some rgb -> rgb
| None ->
(155 + Random.int 100,
155 + Random.int 100,
155 + Random.int 100)
in
let color = pixel_for_surface ~surface ~rgb 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
Surface.fill_rect surface (Rect.make4 x1 y 1 1) color;
Surface.fill_rect surface (Rect.make4 x2 y 1 1) color;
end else begin
Surface.fill_rect surface (Rect.make4 x1 y 1 1) 0xFFFFFFl;
Surface.fill_rect surface (Rect.make4 x2 y 1 1) 0xFFFFFFl;
end
done
done;
let texture = Texture.create_from_surface renderer surface in
Surface.free surface;
(texture)
let texture_of_pattern renderer pattern ~color =
let surface = Surface.create_rgb ~width:5 ~height:5 ~depth:32 in
let rgb = (255, 255, 255) in
let key = pixel_for_surface ~surface ~rgb in
Surface.set_color_key surface ~enable:true ~key;
let color = pixel_for_surface ~surface ~rgb:color in
Array.iteri (fun y row ->
Array.iteri (fun x v ->
if v = 1
then Surface.fill_rect surface (Rect.make4 x y 1 1) color
else Surface.fill_rect surface (Rect.make4 x y 1 1) 0xFFFFFFl
) row
) pattern;
let texture = Texture.create_from_surface renderer surface in
Surface.free surface;
(texture)
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 f_bullets 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 f_bullets in
let f_bullets = List.filter f_bullet_inside f_bullets in
(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
let p1, p2, p3 =
match Random.int 5 with
| 0 -> (* left to right *)
(-20, Random.int (height - 20)),
(Random.int width, Random.int (height - 20)),
(width, Random.int (height - 20))
| 1 -> (* right to left *)
(width, Random.int (height - 20)),
(Random.int width, Random.int (height - 20)),
(-20, Random.int (height - 20))
| 2 | 3 | 4 -> (* top to bottom *)
(Random.int (width - 20), -20),
(Random.int (width - 20), Random.int (height - 20)),
(Random.int (width - 20), height)
| _ -> assert false
in
let ps = (p1, p2, p3) in
[ `Evol (t1, t2, fe, ps) ]
let new_foe renderer t =
let foe_texture = make_avatar renderer () 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 = 1600 + Random.int 1800 in
{ foe_texture; foe_pos; foe_anim; foe_last_shot; foe_shoot_freq }
let new_foes_opt foes renderer t =
if Random.int 100 > 2
then foes
else
let new_foe = new_foe renderer t in
new_foe :: foes
let gun_new_f_bullets f_bullets foes player 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, 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 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 renderer foes player f_bullets p_bullets 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 foes renderer t in
let f_bullets, foes = gun_new_f_bullets f_bullets foes player 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; Texture.destroy foe.foe_texture; false)
) foes
in
let foes =
List.filter (fun foe ->
if foe_touched p_bullets foe
then (incr shot; Texture.destroy foe.foe_texture; false)
else true
) foes
in
(foes, f_bullets)
let player_touched player f_bullets =
let x, y = player.p_pos in
let player_rect = Rect.make4 x y 20 20 in
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
) 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 p_bullets =
p_bullets |>
List.map (fun (x, y) -> (x, y - 8)) |>
List.filter (fun (x, y) -> y > -20)
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 player p_bullets t =
let player = player_moving player in
let player, p_bullets = player_shooting player p_bullets t in
(player, p_bullets)
let rec game_over renderer player f_bullets p_bullets foes
f_bullet_tex p_bullet_tex letters_tex =
let _ = event_loop player in
display renderer false player f_bullets p_bullets foes
f_bullet_tex p_bullet_tex letters_tex;
Timer.delay 200;
game_over renderer player f_bullets p_bullets foes
f_bullet_tex p_bullet_tex letters_tex
let () =
Random.self_init ();
Sdl.init [`VIDEO; `JOYSTICK];
let window, renderer =
Render.create_window_and_renderer ~width ~height ~flags:[]
in
Render.set_logical_size2 renderer width height;
let joy_num = Joystick.num_joysticks () in
if joy_num >= 1
then ignore(Joystick.j_open 0);
let player_texture = make_avatar renderer ~color:blue () in
let player = {
p_pos = (width / 2, height - 60);
p_last_shot = Timer.get_ticks ();
p_shoot_freq = 300;
p_shooting = false;
p_dir =
{ left = false;
right = false;
up = false;
down = false;
};
p_texture = player_texture;
} in
let foes = [] in
let p_bullets = [] in
let f_bullets = [] 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 renderer fb_pattern ~color:yellow in
let p_bullet_tex = texture_of_pattern renderer pb_pattern ~color:green in
let letters_tex =
List.map (fun (c, pat) ->
let tex = texture_of_pattern renderer pat ~color:green in
(c, tex)
) letters
in
let rec main_loop ~player ~f_bullets ~p_bullets ~foes =
let player = event_loop player in
let t = Timer.get_ticks () in
let foes, f_bullets = step_foes renderer foes player f_bullets p_bullets t in
let f_bullets = step_foes_bullets f_bullets t in
let p_bullets = step_player_bullets p_bullets in
let player, p_bullets = step_player player p_bullets t in
display renderer true player f_bullets p_bullets foes
f_bullet_tex p_bullet_tex letters_tex;
let t2 = Timer.get_ticks () in
let dt = t2 - t in
Timer.delay (max 0 (40 - dt));
if player_touched player f_bullets
then begin
Printf.printf "# shot: %d\n" !shot;
Printf.printf "# missed: %d\n" !missed;
Printf.printf "# score: %d\n%!" (!shot - !missed);
game_over renderer player f_bullets p_bullets foes
f_bullet_tex p_bullet_tex letters_tex
end
else main_loop ~player ~f_bullets ~p_bullets ~foes
in
main_loop ~player ~f_bullets ~p_bullets ~foes
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment