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

main.ml

@@ -10,7 +10,7 @@ Random.self_init () ;;
 
 exception ReturnBool of bool ;;
 exception ReturnInt of int ;;
-exception ReturnIntArr of int array ;;
+exception ReturnIntArr of int array * int ;;
 
 let __width__ = 1200
 and __height__ = 800 ;;
@@ -104,7 +104,7 @@ let winball = {
 let gforce = {x = 0. ; y = -. univ_g} ;;
 
 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 -> 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) =
   (* returns the 1st point of the closest line that the ball collides with *)
   if not (is_in_bounding_box_p b poly) then
-    (-1)
+    ([||], 0)
   else begin
     try
       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
         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 ;
-          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
       done;
-      raise (ReturnInt (!minidx))
+      raise (ReturnIntArr (minidx, !minarrid))
     with
-      | ReturnInt b -> b 
+      | ReturnIntArr (a, b) -> (a, b) 
+      | Invalid_argument _ -> failwith "ok then"
   end ;;
 
 let playbeep () = 
@@ -365,32 +378,45 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
   b.fres.y <- 0. ;
 
   for p = 0 to (Array.length polys -1) do
-    let hit = (is_collision_p b polys.(p) dt) in
-    if hit <> -1 then begin
-      score := !score + polys.(p).score ;
+    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
+          score := !score + polys.(p).score ;
 
-      if polys.(p).score > 0 then
-        playbeep () ;
-      if polys.(p).restitution = 0. then
-        b.active <- false ;
+          if h = 0 && polys.(p).score > 0 then
+            playbeep () ;
+          if polys.(p).restitution = 0. then
+            b.active <- false ;
 
-      (* 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 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 ;
-        b.fres.y <- b.fres.y +. reaction_force_2.y *. polys.(p).restitution ;
-      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 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 ;
+          end;
 
-      (* change velocity according to angle *)
-      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
+          (* 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 symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in
 
-      b.v.x <- symmetric.x ;
-      b.v.y <- symmetric.y ;
+            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
+        end
+      done
     end
   done ;
 
@@ -563,7 +589,7 @@ let create_ball (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green
     radius = r ;
     rgb = red + 256 * green + 256 * 256 * blue ;
     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.} ;
     a = {x = 0. ; y = 0.} ;
     fres = {x = 0. ; y = 0.} ;