fixed collisions on edges of polygons (hopefully) causing balls to noclip

This commit is contained in:
Alexandre 2024-10-24 15:17:32 +02:00
parent 5184822369
commit 1016274d6f
5 changed files with 57 additions and 31 deletions

BIN
main.cmi

Binary file not shown.

BIN
main.cmx

Binary file not shown.

52
main.ml
View File

@ -10,7 +10,7 @@ Random.self_init () ;;
exception ReturnBool of bool ;; exception ReturnBool of bool ;;
exception ReturnInt of int ;; exception ReturnInt of int ;;
exception ReturnIntArr of int array ;; exception ReturnIntArr of int array * int ;;
let __width__ = 1200 let __width__ = 1200
and __height__ = 800 ;; and __height__ = 800 ;;
@ -104,7 +104,7 @@ let winball = {
let gforce = {x = 0. ; y = -. univ_g} ;; let gforce = {x = 0. ; y = -. univ_g} ;;
let score = ref 0 ;; let score = ref 0 ;;
let epsilon = ref (1. /. 131072.) ;; let epsilon = (1. /. 131072.) ;;
(* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *)
@ -330,24 +330,37 @@ let distance_line_segment (m : pt_2d) (spt : pt_2d) (ept : pt_2d) =
| k when k < 0. -> vect_dist_2D spt m | k when k < 0. -> vect_dist_2D spt m
| k -> vect_dist_2D ept m ;; | k -> vect_dist_2D ept m ;;
let distance_infinite_segment (m : pt_2d) (spt : pt_2d) (ept : pt_2d) =
let theta = (-. ((ept.x -. spt.x) *. (spt.x -. m.x) +. (ept.y -. spt.y) *. (spt.y -. m.y)) /. ((ept.x -. spt.x) *. (ept.x -. spt.x) +. (ept.y -. spt.y) *. (ept.y -. spt.y))) in
vect_dist_2D (vect_convexf spt ept theta) m ;;
let is_collision_p (b : ball) (poly : polygon) (dt : float) = let is_collision_p (b : ball) (poly : polygon) (dt : float) =
(* returns the 1st point of the closest line that the ball collides with *) (* returns the 1st point of the closest line that the ball collides with *)
if not (is_in_bounding_box_p b poly) then if not (is_in_bounding_box_p b poly) then
(-1) ([||], 0)
else begin else begin
try try
let mind = ref b.radius let mind = ref b.radius
and minidx = ref (-1) in and minidx = Array.make 3 (-1)
and minarrid = ref 0 in
for i = 0 to Array.length poly.vertexes - 1 do for i = 0 to Array.length poly.vertexes - 1 do
let dst = (distance_line_segment (step_one_ball b dt) poly.vertexes.(i) poly.vertexes.((i+1) mod Array.length poly.vertexes)) in let dst = (distance_line_segment (step_one_ball b dt) poly.vertexes.(i) poly.vertexes.((i+1) mod Array.length poly.vertexes)) in
if dst <= !mind then begin if dst <= !mind -. epsilon then begin
mind := dst ; mind := dst ;
minidx := i ; minidx.(0) <- i ;
minidx.(1) <- (-1) ;
minidx.(2) <- (-1) ;
minarrid := 1;
end
else if dst <= !mind then begin
minidx.(!minarrid) <- i ;
incr minarrid ;
end end
done; done;
raise (ReturnInt (!minidx)) raise (ReturnIntArr (minidx, !minarrid))
with with
| ReturnInt b -> b | ReturnIntArr (a, b) -> (a, b)
| Invalid_argument _ -> failwith "ok then"
end ;; end ;;
let playbeep () = let playbeep () =
@ -365,11 +378,14 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
b.fres.y <- 0. ; b.fres.y <- 0. ;
for p = 0 to (Array.length polys -1) do for p = 0 to (Array.length polys -1) do
let hit = (is_collision_p b polys.(p) dt) in let (hitarr, hitlen) = (is_collision_p b polys.(p) dt) in
if hitlen > 0 then begin
for h = 0 to hitlen -1 do
let hit = hitarr.(h) in
if hit <> -1 then begin if hit <> -1 then begin
score := !score + polys.(p).score ; score := !score + polys.(p).score ;
if polys.(p).score > 0 then if h = 0 && polys.(p).score > 0 then
playbeep () ; playbeep () ;
if polys.(p).restitution = 0. then if polys.(p).restitution = 0. then
b.active <- false ; b.active <- false ;
@ -381,17 +397,27 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in
if scal > 0. then begin if scal > 0. then begin
let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in 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 ; 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 ; b.fres.y <- b.fres.y +. reaction_force_2.y *. polys.(p).restitution /. float_of_int hitlen ;
end; end;
(* change velocity according to angle *) (* 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.(p).vertexes.(hit2) polys.(p).vertexes.(hit) in
let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in
b.v.x <- symmetric.x ; b.v.x <- symmetric.x ;
b.v.y <- symmetric.y ; b.v.y <- symmetric.y ;
end 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
end
done
end
done ; done ;
for s = 0 to (Array.length spheres -1) do for s = 0 to (Array.length spheres -1) do
@ -563,7 +589,7 @@ let create_ball (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green
radius = r ; radius = r ;
rgb = red + 256 * green + 256 * 256 * blue ; rgb = red + 256 * green + 256 * 256 * blue ;
mass = m; mass = m;
xy = {x = float_of_int x0 +. (Random.float 10.0 -. 5.0); y = float_of_int y0 +. (Random.float 10.0 -. 5.0)} ; xy = {x = float_of_int x0 +. (Random.float 30.0 -. 15.0); y = float_of_int y0 +. (Random.float 30.0 -. 15.0)} ;
v = {x = 0. ; y = 0.} ; v = {x = 0. ; y = 0.} ;
a = {x = 0. ; y = 0.} ; a = {x = 0. ; y = 0.} ;
fres = {x = 0. ; y = 0.} ; fres = {x = 0. ; y = 0.} ;

BIN
main.o

Binary file not shown.

BIN
pinball

Binary file not shown.