alexandre
/
PinballMachineMaker
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added destructible blocks and fixed flippers

This commit is contained in:
Alexandre 2024-12-21 16:21:28 +01:00
parent 7847ab0e17
commit e413fcdff2
6 changed files with 147 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
execution.sh Normal file
View File

@ -0,0 +1,3 @@
ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics -thread -package threads -linkpkg main.ml -o pinball
gcc playsound.c -lSDL2 -lSDL2_image -o sound
./pinball

BIN
main.cmi
View File

Binary file not shown.

BIN
main.cmx
View File

Binary file not shown.

178
main.ml
View File

@ -33,6 +33,8 @@ type polygon = {
ymax : float ;
mutable restitution : float ;
score : int ;
mutable max_hp : int ;
mutable hp : int ;
} ;;
type sphere = {
@ -82,6 +84,8 @@ let default_polygon = {
ymax = -. 1. ;
restitution = 0. ;
score = 0 ;
max_hp = 1;
hp = 1 ;
} ;;
let default_sphere = {
@ -254,6 +258,21 @@ let dyn_remove (dyn : 'a dynamic) (elt : 'a) =
dyn.memlen <- dyn.memlen/2 ;
end ;;
let dyn_remove_id (dyn : 'a dynamic) (id : int) =
assert (id >= 0 && id < dyn.len) ;
let temp = dyn.tab.(dyn.len -1) in
dyn.tab.(dyn.len -1) <- dyn.tab.(id) ;
dyn.tab.(id) <- temp ;
dyn.len <- dyn.len - 1;
if (dyn.memlen >= 32) && (dyn.len * 4 <= dyn.memlen) then begin
let _new = Array.make (dyn.memlen/2) dyn.tab.(0) in
for i = 0 to dyn.len -1 do
_new.(i) <- dyn.tab.(i)
done;
dyn.tab <- _new ;
dyn.memlen <- dyn.memlen/2 ;
end ;;
let dyn_fold_left (f : 'b -> 'a -> 'b) (acc0 : 'b) (dyn : 'a dynamic) =
let acc = ref acc0 in
for i = 0 to dyn.len -1 do
@ -398,38 +417,48 @@ let is_collision_s (b : ball) (s : sphere) (dt : float) =
else
vect_dist_2D (step_one_ball b dt) (s.center) <= (s.radius +. b.radius) ;;
let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array) (flips : flipper dynamic) (dt : float) =
let remove_dead_destr (destr : polygon dynamic) (cand : int list) =
let rec aux = function
| [] -> ()
| h::t ->
dyn_remove_id destr h ;
aux t
in aux cand ;;
let update_ball_data (b : ball) (polys : polygon dynamic) (destr : polygon dynamic) (spheres : sphere dynamic) (flips : flipper dynamic) (dt : float) =
b.fres.x <- 0. ;
b.fres.y <- 0. ;
for p = 0 to (Array.length polys -1) do
let (hitarr, hitlen) = (is_collision_p b polys.(p) dt) in
let destr_remove = ref [] in
for p = 0 to polys.len -1 do
let (hitarr, hitlen) = (is_collision_p b polys.tab.(p) dt) in
if hitlen > 0 then begin
for h = 0 to hitlen -1 do
let hit = hitarr.(h) in
score := !score + polys.(p).score ;
score := !score + polys.tab.(p).score ;
if h = 0 && polys.(p).score > 0 then
if h = 0 && polys.tab.(p).score > 0 then
playbeep () ;
if polys.(p).restitution = 0. then begin
if polys.tab.(p).restitution = 0. then begin
b.active <- false ;
decr remaining ;
end;
(* apply normal reaction force *)
let hit2 = (hit +1) mod (Array.length polys.(p).vertexes) in
let proj = return_proj_of_point b.xy polys.(p).vertexes.(hit) polys.(p).vertexes.(hit2) in
let hit2 = (hit +1) mod (Array.length polys.tab.(p).vertexes) in
let proj = return_proj_of_point b.xy polys.tab.(p).vertexes.(hit) polys.tab.(p).vertexes.(hit2) in
let proj_n = vect_normalize_2D (vect_diff_2D b.xy proj) in
let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in
if scal > 0. then begin
let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in
b.fres.x <- b.fres.x +. reaction_force_2.x *. polys.(p).restitution /. float_of_int hitlen ;
b.fres.y <- b.fres.y +. reaction_force_2.y *. polys.(p).restitution /. float_of_int hitlen ;
b.fres.x <- b.fres.x +. reaction_force_2.x *. polys.tab.(p).restitution /. float_of_int hitlen ;
b.fres.y <- b.fres.y +. reaction_force_2.y *. polys.tab.(p).restitution /. float_of_int hitlen ;
end;
(* change velocity according to angle *)
if hitlen = 1 then begin
let director = vect_diff_2D polys.(p).vertexes.(hit2) polys.(p).vertexes.(hit) in
let director = vect_diff_2D polys.tab.(p).vertexes.(hit2) polys.tab.(p).vertexes.(hit) in
let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in
b.v.x <- symmetric.x ;
@ -445,29 +474,78 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
end
done ;
for s = 0 to (Array.length spheres -1) do
if is_collision_s b spheres.(s) dt then begin
score := !score + spheres.(s).score ;
for p = 0 to destr.len -1 do
if destr.tab.(p).hp > 0 then begin
let (hitarr, hitlen) = (is_collision_p b destr.tab.(p) dt) in
if hitlen > 0 then begin
for h = 0 to hitlen -1 do
let hit = hitarr.(h) in
score := !score + destr.tab.(p).score ;
destr.tab.(p).hp <- destr.tab.(p).hp -1 ;
if spheres.(s).score > 0 then
if h = 0 && destr.tab.(p).score > 0 then
playbeep () ;
if destr.tab.(p).restitution = 0. then begin
b.active <- false ;
decr remaining ;
end;
(* apply normal reaction force *)
let hit2 = (hit +1) mod (Array.length destr.tab.(p).vertexes) in
let proj = return_proj_of_point b.xy destr.tab.(p).vertexes.(hit) destr.tab.(p).vertexes.(hit2) in
let proj_n = vect_normalize_2D (vect_diff_2D b.xy proj) in
let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in
if scal > 0. then begin
let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in
b.fres.x <- b.fres.x +. reaction_force_2.x *. destr.tab.(p).restitution /. float_of_int hitlen ;
b.fres.y <- b.fres.y +. reaction_force_2.y *. destr.tab.(p).restitution /. float_of_int hitlen ;
end;
(* change velocity according to angle *)
if hitlen = 1 then begin
let director = vect_diff_2D destr.tab.(p).vertexes.(hit2) destr.tab.(p).vertexes.(hit) in
let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in
b.v.x <- symmetric.x ;
b.v.y <- symmetric.y ;
end
else begin
let newv = vect_mult_2D (vect_normalize_2D (vect_diff_2D b.xy proj)) (vect_norm_2D b.v) in
b.v.x <- newv.x ;
b.v.y <- newv.y ;
end
done
end
end
else begin
destr_remove := (p)::(!destr_remove) ;
end
done ;
for s = 0 to spheres.len -1 do
if is_collision_s b spheres.tab.(s) dt then begin
score := !score + spheres.tab.(s).score ;
if spheres.tab.(s).score > 0 then
playbeep () ;
if spheres.(s).restitution = 0. then begin
if spheres.tab.(s).restitution = 0. then begin
b.active <- false ;
decr remaining ;
end;
(* apply normal reaction force *)
let proj_n = vect_normalize_2D (vect_diff_2D b.xy spheres.(s).center) in
let proj_n = vect_normalize_2D (vect_diff_2D b.xy spheres.tab.(s).center) in
let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in
if scal > 0. then begin
let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in
b.fres.x <- b.fres.x +. reaction_force_2.x *. spheres.(s).restitution *. 1.1 ;
b.fres.y <- b.fres.y +. reaction_force_2.y *. spheres.(s).restitution *. 1.1 ;
b.fres.x <- b.fres.x +. reaction_force_2.x *. spheres.tab.(s).restitution *. 1.1 ;
b.fres.y <- b.fres.y +. reaction_force_2.y *. spheres.tab.(s).restitution *. 1.1 ;
end;
(* change velocity according to angle *)
let theta = b.radius /. (vect_norm_2D (vect_diff_2D b.xy spheres.(s).center)) in
let intersection = (vect_convexf b.xy spheres.(s).center theta) in
let theta = b.radius /. (vect_norm_2D (vect_diff_2D b.xy spheres.tab.(s).center)) in
let intersection = (vect_convexf b.xy spheres.tab.(s).center theta) in
let director = vect_normal_2D intersection (vect_sum_2D intersection proj_n) in
let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in
@ -508,10 +586,10 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
b.v.y <- newv.y ;
end;
(* add relative velocity [disabled for physical reasons] *)
if false && ((flips.tab.(f).side = Left && flips.tab.(f).dtheta > 0.) || (flips.tab.(f).side = Right && flips.tab.(f).dtheta < 0.)) then begin
b.v.x <- 0.5 *. b.v.x +. flips.tab.(f).dtheta *. 3.14159 /. 180. *. (vect_dist_2D flips.tab.(f).xy b.xy) *. (cos (flips.tab.(f).theta *. 3.14159 /. 180.));
b.v.y <- 0.5 *. b.v.y +. flips.tab.(f).dtheta *. 3.14159 /. 180. *. (vect_dist_2D flips.tab.(f).xy b.xy) *. (sin (flips.tab.(f).theta *. 3.14159 /. 180.));
(* add relative velocity *)
if ((flips.tab.(f).side = Left && flips.tab.(f).dtheta > 0.) || (flips.tab.(f).side = Right && flips.tab.(f).dtheta < 0.)) then begin
b.v.x <- 0.7 *. b.v.x +. flips.tab.(f).dtheta *. 3.14159 /. 180. *. (vect_dist_2D flips.tab.(f).xy b.xy) *. (cos ((flips.tab.(f).theta +. 90.) *. 3.14159 /. 180.));
b.v.y <- 0.7 *. b.v.y +. flips.tab.(f).dtheta *. 3.14159 /. 180. *. (vect_dist_2D flips.tab.(f).xy b.xy) *. (sin ((flips.tab.(f).theta +. 90.) *. 3.14159 /. 180.));
end
done
end
@ -528,12 +606,17 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
b.v.y <- b.v.y +. b.a.y *. dt ;
b.xy.x <- b.xy.x +. b.v.x *. dt ;
b.xy.y <- b.xy.y +. b.v.y *. dt ;;
b.xy.y <- b.xy.y +. b.v.y *. dt ;
let update_balls (bl : ball array) (polys : polygon array) (spheres : sphere array) (flips : flipper dynamic) (dt : float) =
if !destr_remove <> [] then begin
remove_dead_destr destr !destr_remove
end ;;
let update_balls (bl : ball array) (polys : polygon dynamic) (destr : polygon dynamic) (spheres : sphere dynamic) (flips : flipper dynamic) (dt : float) =
for b = 0 to Array.length bl -1 do
if bl.(b).active then
update_ball_data bl.(b) polys spheres flips dt
if bl.(b).active then begin
update_ball_data bl.(b) polys destr spheres flips dt ;
end
done ;;
let update_flippers (flips : flipper dynamic) (dt : float) =
@ -718,12 +801,12 @@ let control_flippers (flips : flipper dynamic) =
| 'q' ->
for fl = 0 to flips.len -1 do
if flips.tab.(fl).side = Left && flips.tab.(fl).dtheta = 0. then
flips.tab.(fl).dtheta <- 600. ;
flips.tab.(fl).dtheta <- 300. ;
done
| 'd' ->
for fl = 0 to flips.len -1 do
if flips.tab.(fl).side = Right && flips.tab.(fl).dtheta = 0. then
flips.tab.(fl).dtheta <- -. 600. ;
flips.tab.(fl).dtheta <- -. 300. ;
done
| _ -> () ;;
@ -749,6 +832,22 @@ let create_polygon (arr : (int * int) array) (rest : float) (pts : int) (red : i
ymax = float_of_int (Array.fold_left (fun acc k -> max acc (snd k)) (-99999) arr) ;
restitution = rest ;
score = pts ;
max_hp = 1;
hp = 1
} ;;
let create_destructible (arr : (int * int) array) (rest : float) (pts : int) (hitp : int) (red : int) (green : int) (blue : int) =
{
vertexes = Array.init (Array.length arr) (fun k -> {x = float_of_int (fst arr.(k)); y = float_of_int (snd arr.(k))}) ;
rgb = red + 256 * green + 256 * 256 * blue ;
xmin = float_of_int (Array.fold_left (fun acc k -> min acc (fst k)) 99999 arr) ;
xmax = float_of_int (Array.fold_left (fun acc k -> max acc (fst k)) (-99999) arr) ;
ymin = float_of_int (Array.fold_left (fun acc k -> min acc (snd k)) 99999 arr) ;
ymax = float_of_int (Array.fold_left (fun acc k -> max acc (snd k)) (-99999) arr) ;
restitution = rest ;
score = pts ;
max_hp = hitp;
hp = hitp
} ;;
let create_sphere (x00 : int) (y00 : int) (rd : float) (rest : float) (pts : int) (red : int) (green : int) (blue : int) =
@ -827,6 +926,8 @@ let customize lvl_name =
ymax = Array.fold_left (fun acc k -> max acc k.y) (-.999999.) newVTX ;
restitution = 1. ;
score = 0 ;
max_hp = 1;
hp = 1;
} ;
cpoly.len <- 0 ;
end
@ -848,7 +949,7 @@ let customize lvl_name =
(* ------------------------------------------------------------------------------------- *)
(* WALUIGI_TIME Main *)
let simulate (data : polygon dynamic) (dats : sphere dynamic) (flips : flipper dynamic) =
let simulate (data : polygon dynamic) (destructible : polygon dynamic) (dats : sphere dynamic) (flips : flipper dynamic) =
open_graph __istr__ ;
set_window_title "WAH" ;
@ -871,6 +972,9 @@ let simulate (data : polygon dynamic) (dats : sphere dynamic) (flips : flipper d
for d = 0 to data.len -1 do
draw_polygon data.tab.(d)
done;
for d = 0 to destructible.len -1 do
draw_polygon destructible.tab.(d)
done;
for d = 0 to flips.len -1 do
draw_flipper flips.tab.(d)
done;
@ -891,13 +995,14 @@ let simulate (data : polygon dynamic) (dats : sphere dynamic) (flips : flipper d
let __end = Unix.gettimeofday () in
ctime := !ctime +. (__end -. __start) ;
update_balls pinballs data.tab dats.tab flips (__end -. __start) ;
update_balls pinballs data destructible dats flips (__end -. __start) ;
update_flippers flips (__end -. __start) ;
done;
close_graph () ;;
let polygons = dyn_create default_polygon ;;
let destructible = dyn_create default_polygon ;;
let spheres = dyn_create default_sphere ;;
let flippers = dyn_create default_flipper ;;
@ -973,14 +1078,19 @@ dyn_add spheres (create_sphere 1180 300 20. 1. 7 128 128 128) ;;
(* |-------------------------------------------------------------------------------------------------------| *)
dyn_add destructible (create_destructible [|(500, 200); (700, 200); (700, 400); (500, 400)|] 1. 10 5 255 255 32) ;;
(* |-------------------------------------------------------------------------------------------------------| *)
dyn_add flippers (create_flipper Left 420 125 20. 160. (-. 20.) (-. 20.) 20.) ;;
dyn_add flippers (create_flipper Right 780 125 20. 160. 200. 160. 200.) ;;
(* |-------------------------------------------------------------------------------------------------------| *)
simulate polygons spheres flippers ;;
simulate polygons destructible spheres flippers ;;
(*
let create_polygon (arr : (int * int) array) (rest : float) (pts : int) (red : int) (green : int) (blue : int)
let create_destructible (arr : (int * int) array) (rest : float) (pts : int) (hitp : int) (red : int) (green : int) (blue : int)
let create_sphere (x00 : int) (y00 : int) (radius : float) (rest : float) (pts : int) red green blue
let create_flipper (x0 : int) (y0 : int) (rd : float) (len : float) (theta0 : float) (thmin : float) (thmax : float)
*)

BIN
main.o
View File

Binary file not shown.

BIN
pinball
View File

Binary file not shown.