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

added functionnal flipper bars + redesigned level

This commit is contained in:
Alexandre 2024-10-24 17:18:37 +02:00
parent 1016274d6f
commit 7847ab0e17
5 changed files with 274 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
main.cmi
View File

Binary file not shown.

BIN
main.cmx
View File

Binary file not shown.

267
main.ml
View File

@ -47,6 +47,19 @@ type sphere = {
score : int ; score : int ;
} ;; } ;;
type flipper_side = Left | Right ;;
type flipper = {
side : flipper_side ;
xy : pt_2d ;
radius : float ;
length : float ;
mutable theta : float (* in degrees *) ;
mutable dtheta : float ;
agmin : float ;
agmax : float ;
vtxs : polygon
} ;;
type ball = { type ball = {
mutable active : bool ; mutable active : bool ;
radius : float ; radius : float ;
@ -83,8 +96,21 @@ let default_sphere = {
score = 0 ; score = 0 ;
} ;; } ;;
let default_flipper = {
side = Left ;
xy = {x = 0. ; y = 0.} ;
radius = 0. ;
length = 0. ;
theta = 0. (* in degrees *) ;
dtheta = 0. ;
agmin = 0. ;
agmax = 0. ;
vtxs = default_polygon ;
} ;;
let univ_g = 750.0 ;; let univ_g = 750.0 ;;
let pi = 3.14159265358979343 ;; let pi = 3.14159265358979343 ;;
let epsilon = (1. /. 131072.) ;;
let winBL = { let winBL = {
x = 0. ; x = 0. ;
@ -103,8 +129,8 @@ let winball = {
let gforce = {x = 0. ; y = -. univ_g} ;; let gforce = {x = 0. ; y = -. univ_g} ;;
let remaining = ref 8 ;;
let score = ref 0 ;; let score = ref 0 ;;
let epsilon = (1. /. 131072.) ;;
(* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *)
@ -335,7 +361,6 @@ let distance_infinite_segment (m : pt_2d) (spt : pt_2d) (ept : pt_2d) =
vect_dist_2D (vect_convexf spt ept theta) m ;; 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 *)
if not (is_in_bounding_box_p b poly) then if not (is_in_bounding_box_p b poly) then
([||], 0) ([||], 0)
else begin else begin
@ -373,7 +398,7 @@ let is_collision_s (b : ball) (s : sphere) (dt : float) =
else else
vect_dist_2D (step_one_ball b dt) (s.center) <= (s.radius +. b.radius) ;; 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) (dt : float) = let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array) (flips : flipper dynamic) (dt : float) =
b.fres.x <- 0. ; b.fres.x <- 0. ;
b.fres.y <- 0. ; b.fres.y <- 0. ;
@ -382,13 +407,14 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
if hitlen > 0 then begin if hitlen > 0 then begin
for h = 0 to hitlen -1 do for h = 0 to hitlen -1 do
let hit = hitarr.(h) in let hit = hitarr.(h) in
if hit <> -1 then begin
score := !score + polys.(p).score ; score := !score + polys.(p).score ;
if h = 0 && 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 begin
b.active <- false ; b.active <- false ;
decr remaining ;
end;
(* apply normal reaction force *) (* apply normal reaction force *)
let hit2 = (hit +1) mod (Array.length polys.(p).vertexes) in let hit2 = (hit +1) mod (Array.length polys.(p).vertexes) in
@ -415,7 +441,6 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
b.v.x <- newv.x ; b.v.x <- newv.x ;
b.v.y <- newv.y ; b.v.y <- newv.y ;
end end
end
done done
end end
done ; done ;
@ -426,8 +451,10 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
if spheres.(s).score > 0 then if spheres.(s).score > 0 then
playbeep () ; playbeep () ;
if spheres.(s).restitution = 0. then if spheres.(s).restitution = 0. then begin
b.active <- false ; b.active <- false ;
decr remaining ;
end;
(* apply normal reaction force *) (* 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.(s).center) in
@ -449,6 +476,47 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
end end
done ; done ;
for f = 0 to flips.len -1 do
let (hitarr, hitlen) = (is_collision_p b flips.tab.(f).vtxs dt) in
if hitlen > 0 then begin
for h = 0 to hitlen -1 do
let hit = hitarr.(h) in
(* apply normal reaction force *)
let hit2 = (hit +1) mod (Array.length flips.tab.(f).vtxs.vertexes) in
let proj = return_proj_of_point b.xy flips.tab.(f).vtxs.vertexes.(hit) flips.tab.(f).vtxs.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 *. flips.tab.(f).vtxs.restitution /. float_of_int hitlen ;
b.fres.y <- b.fres.y +. reaction_force_2.y *. flips.tab.(f).vtxs.restitution /. float_of_int hitlen ;
end;
(* change velocity according to angle *)
if hitlen = 1 then begin
let director = vect_diff_2D flips.tab.(f).vtxs.vertexes.(hit2) flips.tab.(f).vtxs.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;
(* 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.));
end
done
end
done;
(* P = mg *) (* P = mg *)
b.fres.y <- b.fres.y -. univ_g *. b.mass ; b.fres.y <- b.fres.y -. univ_g *. b.mass ;
@ -462,10 +530,67 @@ let update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array)
b.xy.x <- b.xy.x +. b.v.x *. 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) (dt : float) = let update_balls (bl : ball array) (polys : polygon array) (spheres : sphere array) (flips : flipper dynamic) (dt : float) =
for b = 0 to Array.length bl -1 do for b = 0 to Array.length bl -1 do
if bl.(b).active then if bl.(b).active then
update_ball_data bl.(b) polys spheres dt update_ball_data bl.(b) polys spheres flips dt
done ;;
let update_flippers (flips : flipper dynamic) (dt : float) =
for fl = 0 to flips.len -1 do
if flips.tab.(fl).dtheta <> 0. then begin
let x0 = flips.tab.(fl).xy.x
and y0 = flips.tab.(fl).xy.y
and rd = flips.tab.(fl).radius
and len = flips.tab.(fl).length
and theta0 = flips.tab.(fl).theta in
match flips.tab.(fl).side with
| Left ->
let theta_dt = flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt in
if theta_dt > flips.tab.(fl).agmax then
flips.tab.(fl).dtheta <- -.(flips.tab.(fl).dtheta) ;
if theta_dt < flips.tab.(fl).agmin then
flips.tab.(fl).dtheta <- 0. ;
flips.tab.(fl).theta <- theta_dt ;
flips.tab.(fl).vtxs.vertexes.(0) <- {
x = x0 +. len *. (cos (theta0 *. 3.14159 /. 180.));
y = y0 +. len *. (sin (theta0 *. 3.14159 /. 180.))
};
flips.tab.(fl).vtxs.vertexes.(1) <- {
x = x0 +. rd *. (cos ((theta0 +. 90.) *. 3.14159 /. 180.));
y = y0 +. rd *. (sin ((theta0 +. 90.) *. 3.14159 /. 180.))
};
flips.tab.(fl).vtxs.vertexes.(2) <- {
x = x0 +. rd *. (cos ((theta0 -. 90.) *. 3.14159 /. 180.));
y = y0 +. rd *. (sin ((theta0 -. 90.) *. 3.14159 /. 180.))
};
| Right ->
let theta_dt = flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt in
if theta_dt > flips.tab.(fl).agmax then
flips.tab.(fl).dtheta <- 0. ;
if theta_dt < flips.tab.(fl).agmin then
flips.tab.(fl).dtheta <- -.(flips.tab.(fl).dtheta) ;
flips.tab.(fl).theta <- theta_dt ;
flips.tab.(fl).vtxs.vertexes.(0) <- {
x = x0 +. len *. (cos (theta0 *. 3.14159 /. 180.));
y = y0 +. len *. (sin (theta0 *. 3.14159 /. 180.))
};
flips.tab.(fl).vtxs.vertexes.(1) <- {
x = x0 +. rd *. (cos ((theta0 +. 90.) *. 3.14159 /. 180.));
y = y0 +. rd *. (sin ((theta0 +. 90.) *. 3.14159 /. 180.))
};
flips.tab.(fl).vtxs.vertexes.(2) <- {
x = x0 +. rd *. (cos ((theta0 -. 90.) *. 3.14159 /. 180.));
y = y0 +. rd *. (sin ((theta0 -. 90.) *. 3.14159 /. 180.))
};
end
done ;; done ;;
(* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *)
@ -561,6 +686,11 @@ let draw_sphere (s : sphere) =
set_color (rgb (s.rgb mod 256) ((s.rgb / 256) mod 256) ((s.rgb / (256*256)) mod 256)) ; set_color (rgb (s.rgb mod 256) ((s.rgb / 256) mod 256) ((s.rgb / (256*256)) mod 256)) ;
fill_circle (int_of_float s.center.x) (int_of_float s.center.y) (int_of_float s.radius) ;; fill_circle (int_of_float s.center.x) (int_of_float s.center.y) (int_of_float s.radius) ;;
let draw_flipper (f : flipper) =
set_color (rgb 64 64 64) ;
fill_circle (int_of_float f.xy.x) (int_of_float f.xy.y) (int_of_float f.radius) ;
draw_polygon f.vtxs ;;
let draw_ball (b : ball) = let draw_ball (b : ball) =
set_color (rgb (b.rgb mod 256) ((b.rgb / 256) mod 256) ((b.rgb / (256*256)) mod 256)) ; set_color (rgb (b.rgb mod 256) ((b.rgb / 256) mod 256) ((b.rgb / (256*256)) mod 256)) ;
fill_circle (int_of_float b.xy.x) (int_of_float b.xy.y) (int_of_float b.radius) ; fill_circle (int_of_float b.xy.x) (int_of_float b.xy.y) (int_of_float b.radius) ;
@ -583,6 +713,20 @@ let get1char_plus () =
else else
'@' ;; '@' ;;
let control_flippers (flips : flipper dynamic) =
match get1char_plus () with
| '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. ;
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. ;
done
| _ -> () ;;
let create_ball (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green : int) (blue : int) = let create_ball (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green : int) (blue : int) =
{ {
active = true ; active = true ;
@ -621,6 +765,23 @@ let create_sphere (x00 : int) (y00 : int) (rd : float) (rest : float) (pts : int
score = pts ; score = pts ;
} ;; } ;;
let create_flipper (side : flipper_side) (x0 : int) (y0 : int) (rd : float) (len : float) (theta0 : float) (thmin : float) (thmax : float) =
{
side = side ;
xy = {x = float_of_int x0 ; y = float_of_int y0} ;
radius = rd ;
length = len ;
theta = theta0 (* in degrees *) ;
dtheta = 0. ;
agmin = thmin ;
agmax = thmax ;
vtxs = create_polygon [|
(x0 + int_of_float (len *. (cos (theta0 *. 3.14159 /. 180.))) , y0 + int_of_float (len *. (sin (theta0 *. 3.14159 /. 180.))));
(x0 + int_of_float (rd *. (cos ((theta0 -. 90.) *. 3.14159 /. 180.))), y0 + int_of_float (rd *. (sin ((theta0 -. 90.) *. 3.14159 /. 180.))));
(x0 + int_of_float (rd *. (cos ((theta0 +. 90.) *. 3.14159 /. 180.))), y0 + int_of_float (rd *. (sin ((theta0 +. 90.) *. 3.14159 /. 180.))))
|] 1. 0 128 128 128
} ;;
let generate_pinballs (count : int) (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green : int) (blue : int) = let generate_pinballs (count : int) (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green : int) (blue : int) =
Array.init count (fun k -> create_ball r x0 y0 m red green blue) ;; Array.init count (fun k -> create_ball r x0 y0 m red green blue) ;;
@ -687,11 +848,11 @@ let customize lvl_name =
(* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *)
(* WALUIGI_TIME Main *) (* WALUIGI_TIME Main *)
let simulate (data : polygon dynamic) (dats : sphere dynamic) = let simulate (data : polygon dynamic) (dats : sphere dynamic) (flips : flipper dynamic) =
open_graph __istr__ ; open_graph __istr__ ;
set_window_title "WAH" ; set_window_title "WAH" ;
let pinballs = generate_pinballs 100 10.0 600 800 0.15 255 255 0 in let pinballs = generate_pinballs 8 10.0 600 800 0.15 255 255 0 in
let stime = Unix.gettimeofday () in let stime = Unix.gettimeofday () in
let ctime = ref (Unix.gettimeofday ()) in let ctime = ref (Unix.gettimeofday ()) in
@ -700,12 +861,18 @@ let simulate (data : polygon dynamic) (dats : sphere dynamic) =
auto_synchronize false ; auto_synchronize false ;
clear_graph () ; clear_graph () ;
set_line_width 4 ;
draw_integer 600 100 !remaining 40 ;
set_line_width 1 ; set_line_width 1 ;
for d = 0 to dats.len -1 do
draw_sphere dats.tab.(d)
done;
for d = 0 to data.len -1 do for d = 0 to data.len -1 do
draw_polygon data.tab.(d) draw_polygon data.tab.(d)
done; done;
for d = 0 to dats.len -1 do for d = 0 to flips.len -1 do
draw_sphere dats.tab.(d) draw_flipper flips.tab.(d)
done; done;
draw_all_balls pinballs ; draw_all_balls pinballs ;
@ -717,18 +884,24 @@ let simulate (data : polygon dynamic) (dats : sphere dynamic) =
draw_integer 600 770 !score 50 ; draw_integer 600 770 !score 50 ;
auto_synchronize true ; auto_synchronize true ;
control_flippers flips ;
Unix.sleepf univ_dt ; Unix.sleepf univ_dt ;
let __end = Unix.gettimeofday () in let __end = Unix.gettimeofday () in
ctime := !ctime +. (__end -. __start) ; ctime := !ctime +. (__end -. __start) ;
update_balls pinballs data.tab dats.tab (__end -. __start) ; update_balls pinballs data.tab dats.tab flips (__end -. __start) ;
update_flippers flips (__end -. __start) ;
done; done;
close_graph () ;; close_graph () ;;
let polygons = dyn_create default_polygon ;; let polygons = dyn_create default_polygon ;;
let spheres = dyn_create default_sphere ;; let spheres = dyn_create default_sphere ;;
let flippers = dyn_create default_flipper ;;
(* |-------------------------------------------------------------------------------------------------------| *)
(* kill platform *) (* kill platform *)
dyn_add polygons (create_polygon [|(700, -20); (500, -20); (500, 1); (700, 1)|] 0. 0 255 32 32) ;; dyn_add polygons (create_polygon [|(700, -20); (500, -20); (500, 1); (700, 1)|] 0. 0 255 32 32) ;;
@ -741,17 +914,75 @@ dyn_add polygons (create_polygon [|(1180, 0); (1200, 0); (1200, 800); (1180, 800
dyn_add polygons (create_polygon [|(0, 0); (20, 0); (20, 800); (0, 800)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(0, 0); (20, 0); (20, 800); (0, 800)|] 1. 0 32 32 32) ;;
(* side ramps *) (* side ramps *)
dyn_add polygons (create_polygon [|(20, 20); (20, 300); (500, 150); (500, 20)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(20, 20); (20, 300); (420, 150); (420, 20)|] 1. 0 32 32 32) ;;
dyn_add polygons (create_polygon [|(1200, 20); (1200, 300); (700, 150); (700, 20)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(1200, 20); (1200, 300); (780, 150); (780, 20)|] 1. 0 32 32 32) ;;
(* starting platform *) (* starting platform *)
dyn_add polygons (create_polygon [|(600, 700); (400, 550); (800, 550)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(600, 700); (400, 550); (800, 550)|] 1. 0 32 32 32) ;;
(* |-------------------------------------------------------------------------------------------------------| *)
(* corner scoring spots *)
dyn_add spheres (create_sphere 20 780 30. 1. 50 128 128 32) ;;
dyn_add spheres (create_sphere 1180 780 30. 1. 50 128 128 32) ;;
simulate polygons spheres ;; (* under the starting platform *)
dyn_add spheres (create_sphere 440 550 20. 1. 5 32 128 32) ;;
dyn_add spheres (create_sphere 520 550 20. 1. 5 32 192 32) ;;
dyn_add spheres (create_sphere 600 550 20. 1. 5 32 255 32) ;;
dyn_add spheres (create_sphere 680 550 20. 1. 5 32 192 32) ;;
dyn_add spheres (create_sphere 760 550 20. 1. 5 32 128 32) ;;
dyn_add spheres (create_sphere 480 450 20. 1. 3 32 156 32) ;;
dyn_add spheres (create_sphere 560 450 20. 1. 3 32 220 32) ;;
dyn_add spheres (create_sphere 640 450 20. 1. 3 32 220 32) ;;
dyn_add spheres (create_sphere 720 450 20. 1. 3 32 156 32) ;;
dyn_add spheres (create_sphere 520 350 20. 1. 1 32 192 32) ;;
dyn_add spheres (create_sphere 600 350 20. 1. 1 32 255 32) ;;
dyn_add spheres (create_sphere 680 350 20. 1. 1 32 192 32) ;;
(* left side *)
dyn_add spheres (create_sphere 20 480 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 95 555 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 170 630 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 245 705 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 320 780 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 20 630 15. 1. 5 32 32 255) ;;
dyn_add spheres (create_sphere 95 705 15. 1. 5 32 32 255) ;;
dyn_add spheres (create_sphere 170 780 15. 1. 5 32 32 255) ;;
dyn_add spheres (create_sphere 300 300 15. 1. 5 128 128 128) ;;
(* right side *)
dyn_add spheres (create_sphere 1180 480 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 1105 555 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 1030 630 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 965 705 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 890 780 10. 1. 3 32 32 192) ;;
dyn_add spheres (create_sphere 1180 630 15. 1. 5 32 32 255) ;;
dyn_add spheres (create_sphere 1105 705 15. 1. 5 32 32 255) ;;
dyn_add spheres (create_sphere 1030 780 15. 1. 5 32 32 255) ;;
dyn_add spheres (create_sphere 900 300 15. 1. 5 128 128 128) ;;
(* on the ramps *)
dyn_add spheres (create_sphere 20 300 20. 1. 7 128 128 128) ;;
dyn_add spheres (create_sphere 1180 300 20. 1. 7 128 128 128) ;;
(* |-------------------------------------------------------------------------------------------------------| *)
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 ;;
(* (*
let create_polygon (arr : (int * int) array) (rest : float) (pts : int) (red : int) (green : int) (blue : int) let create_polygon (arr : (int * int) array) (rest : float) (pts : int) (red : int) (green : int) (blue : int)
let create_sphere (x00 : int) (y00 : int) (radius : float) (rest : float) (pts : 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)
*) *)
(* ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics -thread -package threads -linkpkg main.ml *) (* ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics -thread -package threads -linkpkg main.ml *)

BIN
main.o
View File

Binary file not shown.

BIN
pinball
View File

Binary file not shown.