added destructible blocks and fixed flippers

execution.sh

@@ -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

main.ml

@@ -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 destr_remove = ref [] in
-    let (hitarr, hitlen) = (is_collision_p b polys.(p) dt) 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 hit2 = (hit +1) mod (Array.length polys.tab.(p).vertexes) in
-        let proj = return_proj_of_point b.xy polys.(p).vertexes.(hit) polys.(p).vertexes.(hit2) 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.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.(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
+  for p = 0 to destr.len -1 do
-    if is_collision_s b spheres.(s) dt then begin
+    if destr.tab.(p).hp > 0 then begin
-      score := !score + spheres.(s).score ;
+      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.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.(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 theta = b.radius /. (vect_norm_2D (vect_diff_2D b.xy spheres.tab.(s).center)) in
-      let intersection = (vect_convexf b.xy spheres.(s).center theta) 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] *)
+        (* add relative velocity *)
-        if false && ((flips.tab.(f).side = Left && flips.tab.(f).dtheta > 0.) || (flips.tab.(f).side = Right && flips.tab.(f).dtheta < 0.)) then begin
+        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.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.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.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.));
+          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
+    if bl.(b).active then begin
-      update_ball_data bl.(b) polys spheres flips dt
+      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)
 *)