diff --git a/execution.sh b/execution.sh new file mode 100644 index 0000000..e188745 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/main.cmi b/main.cmi index 7027dde..77c23a9 100644 Binary files a/main.cmi and b/main.cmi differ diff --git a/main.cmx b/main.cmx index bf6be06..e533716 100644 Binary files a/main.cmx and b/main.cmx differ diff --git a/main.ml b/main.ml index 4b17b4c..b904d4e 100644 --- a/main.ml +++ b/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 (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) *) diff --git a/main.o b/main.o index 9e76cae..6a205ef 100644 Binary files a/main.o and b/main.o differ diff --git a/pinball b/pinball index 4930d4d..c0ccf10 100755 Binary files a/pinball and b/pinball differ