mp2i-vms.fr
added circle polygons, time display and default arcade
This commit is contained in:
parent
83dc683ba5
commit
659ca44dcf
222
main.ml
222
main.ml
|
|
@ -11,7 +11,6 @@ Random.self_init () ;;
|
|||
exception ReturnBool of bool ;;
|
||||
exception ReturnInt of int ;;
|
||||
exception HasEnded ;;
|
||||
exception Break ;;
|
||||
|
||||
type pt_2d = {
|
||||
mutable x : float ;
|
||||
|
|
@ -29,6 +28,18 @@ type polygon = {
|
|||
score : int ;
|
||||
} ;;
|
||||
|
||||
type sphere = {
|
||||
center : pt_2d ;
|
||||
radius : float ;
|
||||
rgb : int ;
|
||||
xmin : float ;
|
||||
xmax : float ;
|
||||
ymin : float ;
|
||||
ymax : float ;
|
||||
mutable restitution : float ;
|
||||
score : int ;
|
||||
} ;;
|
||||
|
||||
let default_polygon = {
|
||||
vertexes = [||] ;
|
||||
rgb = 0 ;
|
||||
|
|
@ -40,6 +51,18 @@ let default_polygon = {
|
|||
score = 0 ;
|
||||
} ;;
|
||||
|
||||
let default_sphere = {
|
||||
center = {x = 0. ; y = 0.} ;
|
||||
rgb = 0 ;
|
||||
radius = -. 1. ;
|
||||
xmin = 1. ;
|
||||
xmax = -. 1. ;
|
||||
ymin = 1. ;
|
||||
ymax = -. 1. ;
|
||||
restitution = 0. ;
|
||||
score = 0 ;
|
||||
} ;;
|
||||
|
||||
type ball = {
|
||||
radius : float ;
|
||||
mass : float ;
|
||||
|
|
@ -52,7 +75,7 @@ type ball = {
|
|||
|
||||
let univ_dt = 0.05 ;;
|
||||
let univ_friction = 0.8 ;;
|
||||
let univ_g = 300.0 ;;
|
||||
let univ_g = 800.0 ;;
|
||||
let pi = 3.14159265358979343 ;;
|
||||
|
||||
let gforce = {x = 0. ; y = -. univ_g} ;;
|
||||
|
|
@ -63,6 +86,18 @@ let score = ref 0 ;;
|
|||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* WALUIGI_TIME Arithmetical operations *)
|
||||
|
||||
let rec pw x n = match n with
|
||||
| 0 -> 1
|
||||
| 1 -> x
|
||||
| k when k mod 2 = 0 -> pw (x*x) (n/2)
|
||||
| k -> x * (pw (x*x) (n/2)) ;;
|
||||
|
||||
let rec pwf x n = match n with
|
||||
| 0 -> 1.
|
||||
| 1 -> x
|
||||
| k when k mod 2 = 0 -> pwf (x *. x) (n/2)
|
||||
| k -> x *. (pwf (x *. x) (n/2)) ;;
|
||||
|
||||
let rec ln10 n = match n with
|
||||
| k when k < 0 -> failwith "Are you sure about that ?"
|
||||
| k when k < 10 -> 0
|
||||
|
|
@ -71,6 +106,21 @@ let rec ln10 n = match n with
|
|||
let convexf x y theta =
|
||||
(1.0 -. theta) *. x +. theta *. y ;;
|
||||
|
||||
let absf = function
|
||||
| x when x < 0.0 -> -. x
|
||||
| x -> x ;;
|
||||
|
||||
let rec expand_fl = function
|
||||
| k when float_of_int (int_of_float k) = k -> int_of_float k
|
||||
| k -> expand_fl (10.0 *. k) ;;
|
||||
|
||||
let incree = function
|
||||
| k when k < 10 -> 0
|
||||
| _ -> 1 ;;
|
||||
|
||||
let round x n =
|
||||
float_of_int (int_of_float (x *. pwf 10. n)) /. (pwf 10. n);;
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* WALUIGI_TIME Dynamic Arrays *)
|
||||
|
|
@ -211,37 +261,52 @@ let step_one_ball (b : ball) (dt : float) =
|
|||
y = b.xy.y +. b.v.y *. dt ;
|
||||
} ;;
|
||||
|
||||
let is_in_bounding_box (b : ball) (poly : polygon) =
|
||||
let is_in_bounding_box_p (b : ball) (poly : polygon) =
|
||||
(b.xy.x +. b.radius >= poly.xmin) && (b.xy.x -. b.radius <= poly.xmax) &&
|
||||
(b.xy.y +. b.radius >= poly.ymin) && (b.xy.y -. b.radius <= poly.ymax) ;;
|
||||
|
||||
let is_in_bounding_box_s (b : ball) (s : sphere) =
|
||||
(b.xy.x +. b.radius >= s.xmin) && (b.xy.x -. b.radius <= s.xmax) &&
|
||||
(b.xy.y +. b.radius >= s.ymin) && (b.xy.y -. b.radius <= s.ymax) ;;
|
||||
|
||||
let distance_line_segment (m : pt_2d) (spt : pt_2d) (ept : pt_2d) =
|
||||
match (-. ((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))) with
|
||||
| k when k >= 0. && k <= 1. -> vect_dist_2D (vect_convexf spt ept k) m
|
||||
| k when k < 0. -> vect_dist_2D spt m
|
||||
| k -> vect_dist_2D ept m ;;
|
||||
|
||||
let is_collision (b : ball) (poly : polygon) (dt : float) =
|
||||
(* returns the 1st point of the line that the ball collides with *)
|
||||
if not (is_in_bounding_box b poly) then
|
||||
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)
|
||||
else begin
|
||||
try
|
||||
let mind = ref b.radius
|
||||
and minidx = ref (-1) in
|
||||
for i = 0 to Array.length poly.vertexes - 1 do
|
||||
if (distance_line_segment (step_one_ball b dt) poly.vertexes.(i) poly.vertexes.((i+1) mod Array.length poly.vertexes)) <= b.radius then
|
||||
raise (ReturnInt i)
|
||||
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
|
||||
mind := dst ;
|
||||
minidx := i ;
|
||||
end
|
||||
done;
|
||||
(-1)
|
||||
raise (ReturnInt (!minidx))
|
||||
with
|
||||
| ReturnInt b -> b
|
||||
end ;;
|
||||
|
||||
let update_ball_data (b : ball) (polys : polygon array) (dt : float) =
|
||||
let is_collision_s (b : ball) (s : sphere) (dt : float) =
|
||||
if not (is_in_bounding_box_s b s) then
|
||||
false
|
||||
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) (dt : float) =
|
||||
b.fres.x <- 0. ;
|
||||
b.fres.y <- 0. ;
|
||||
|
||||
for p = 0 to (Array.length polys -1) do
|
||||
let hit = (is_collision b polys.(p) dt) in
|
||||
let hit = (is_collision_p b polys.(p) dt) in
|
||||
if hit <> -1 then begin
|
||||
score := !score + polys.(p).score ;
|
||||
|
||||
|
|
@ -263,6 +328,28 @@ let update_ball_data (b : ball) (polys : polygon array) (dt : float) =
|
|||
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 ;
|
||||
|
||||
(* apply normal reaction force *)
|
||||
let proj_n = vect_normalize_2D (vect_diff_2D b.xy spheres.(s).center) in
|
||||
let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. (vect_dot_product_2D (vect_normalize_2D gforce) proj_n)) in
|
||||
|
||||
b.fres.x <- b.fres.x +. reaction_force_2.x *. spheres.(s).restitution ;
|
||||
b.fres.y <- b.fres.y +. reaction_force_2.y *. spheres.(s).restitution ;
|
||||
|
||||
(* 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 director = vect_normal_2D intersection (vect_sum_2D intersection proj_n) in
|
||||
let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in
|
||||
|
||||
b.v.x <- symmetric.x ;
|
||||
b.v.y <- symmetric.y ;
|
||||
end
|
||||
done ;
|
||||
|
||||
(* P = mg *)
|
||||
b.fres.y <- b.fres.y -. univ_g *. b.mass ;
|
||||
|
||||
|
|
@ -312,10 +399,63 @@ let draw_integer x0 y n0 r =
|
|||
n := !n/10;
|
||||
done ;;
|
||||
|
||||
let draw_integer_alignedleft x0 y n0 len =
|
||||
(* 7-seg display 2 *)
|
||||
set_line_width (max 1 (len/4));
|
||||
let n = ref n0 in
|
||||
let size = ln10 (abs n0) in
|
||||
|
||||
let cur_x = ref (x0 + size*(len*11/7)) in
|
||||
|
||||
if !n < 0 then begin
|
||||
n := !n * (-1);
|
||||
draw_poly_line [|(x0, y); (x0+len, y)|];
|
||||
cur_x := !cur_x + (len*11/7)
|
||||
end;
|
||||
|
||||
for i = 0 to size do
|
||||
let x = !cur_x in
|
||||
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
|
||||
draw_poly_line [|(x, y+len); (x, y)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
|
||||
draw_poly_line [|(x, y+len); (x+len, y+len)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
|
||||
draw_poly_line [|(x+len, y+len); (x+len, y)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
|
||||
draw_poly_line [|(x, y); (x+len, y)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
|
||||
draw_poly_line [|(x+len, y-len); (x+len, y)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
|
||||
draw_poly_line [|(x, y-len); (x+len, y-len)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
|
||||
draw_poly_line [|(x, y-len); (x, y)|];
|
||||
|
||||
n := !n/10;
|
||||
cur_x := !cur_x - (len*11/7);
|
||||
done ;;
|
||||
|
||||
let draw_float x y n0 r =
|
||||
let n = absf n0 in
|
||||
let ent = int_of_float n in
|
||||
let frac = expand_fl (n -. float_of_int ent) in
|
||||
draw_integer_alignedleft x y ent r ;
|
||||
fill_circle (x + (ln10 ent) * r * 11/7 + 3*r/2) (y - r) 3 ;
|
||||
draw_integer_alignedleft (x + 3*r/5 + (ln10 ent + 1)*r*11/7) y ((100 * frac) / (pw 10 (1+ ln10 frac))) r ;;
|
||||
|
||||
let draw_polygon (poly : polygon) =
|
||||
set_color (rgb (poly.rgb mod 256) ((poly.rgb / 256) mod 256) ((poly.rgb / (256*256)) mod 256)) ;
|
||||
fill_poly (Array.init (Array.length poly.vertexes) (fun i -> (int_of_float poly.vertexes.(i).x, int_of_float poly.vertexes.(i).y))) ;;
|
||||
|
||||
let draw_sphere (s : sphere) =
|
||||
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) ;;
|
||||
|
||||
let draw_ball (b : ball) =
|
||||
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) ;
|
||||
|
|
@ -337,7 +477,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; y = float_of_int y0} ;
|
||||
xy = {x = float_of_int x0 +. (Random.float 10.0 -. 5.0); y = float_of_int y0 +. (Random.float 10.0 -. 5.0)} ;
|
||||
v = {x = 0. ; y = 0.} ;
|
||||
a = {x = 0. ; y = 0.} ;
|
||||
fres = {x = 0. ; y = 0.} ;
|
||||
|
|
@ -355,6 +495,20 @@ let create_polygon (arr : (int * int) array) (rest : float) (pts : int) (red : i
|
|||
score = pts ;
|
||||
} ;;
|
||||
|
||||
let create_sphere (x00 : int) (y00 : int) (rd : float) (rest : float) (pts : int) (red : int) (green : int) (blue : int) =
|
||||
let x0 = float_of_int x00 and y0 = float_of_int y00 in
|
||||
{
|
||||
center = {x = x0 ; y = y0};
|
||||
rgb = red + 256 * green + 256 * 256 * blue ;
|
||||
radius = rd ;
|
||||
xmin = x0 -. rd ;
|
||||
xmax = x0 +. rd ;
|
||||
ymin = y0 -. rd ;
|
||||
ymax = y0 +. rd ;
|
||||
restitution = rest ;
|
||||
score = pts ;
|
||||
} ;;
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* WALUIGI_TIME Edition functions *)
|
||||
|
|
@ -418,14 +572,16 @@ let customize lvl_name =
|
|||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* WALUIGI_TIME Main *)
|
||||
|
||||
let simulate (data : polygon dynamic) =
|
||||
let simulate (data : polygon dynamic) (dats : sphere dynamic) =
|
||||
open_graph " 1200x800" ;
|
||||
set_window_title "WAH" ;
|
||||
|
||||
let pinball = create_ball 25.0 600 800 0.15 169 169 169 in
|
||||
let stime = Unix.gettimeofday () in
|
||||
let ctime = ref (Unix.gettimeofday ()) in
|
||||
|
||||
while true do
|
||||
let __start = Unix.gettimeofday() in
|
||||
let __start = Unix.gettimeofday () in
|
||||
auto_synchronize false ;
|
||||
clear_graph () ;
|
||||
|
||||
|
|
@ -437,18 +593,48 @@ let simulate (data : polygon dynamic) =
|
|||
for d = 0 to data.len -1 do
|
||||
draw_polygon data.tab.(d)
|
||||
done;
|
||||
for d = 0 to dats.len -1 do
|
||||
draw_sphere dats.tab.(d)
|
||||
done;
|
||||
draw_ball pinball ;
|
||||
|
||||
set_color (rgb 128 128 32) ;
|
||||
draw_float 25 770 (round (!ctime -. stime) 3) 25 ;
|
||||
|
||||
auto_synchronize true ;
|
||||
Unix.sleepf 0.005 ;
|
||||
|
||||
let __end = Unix.gettimeofday() in
|
||||
update_ball_data pinball data.tab (__end -. __start) ;
|
||||
let __end = Unix.gettimeofday () in
|
||||
ctime := !ctime +. (__end -. __start) ;
|
||||
update_ball_data pinball data.tab dats.tab (__end -. __start) ;
|
||||
done;
|
||||
|
||||
close_graph () ;;
|
||||
|
||||
let polygons = customize () ;;
|
||||
simulate polygons ;;
|
||||
(*let polygons = customize () ;;*)
|
||||
let polygons = dyn_create default_polygon ;;
|
||||
dyn_add polygons (create_polygon [|(0, 0); (50, 0); (50, 775); (0, 775)|] 1.0 0 32 32 255) ;;
|
||||
dyn_add polygons (create_polygon [|(1150, 0); (1200, 0); (1200, 775); (1150, 775)|] 1.0 0 32 32 255) ;;
|
||||
dyn_add polygons (create_polygon [|(50, 0); (50, 200); (500, 25); (500, 0)|] 1.0 0 32 32 255) ;;
|
||||
dyn_add polygons (create_polygon [|(1150, 0); (1150, 200); (700, 25); (700, 0)|] 1.0 0 32 32 255) ;;
|
||||
dyn_add polygons (create_polygon [|(500, 0); (700, 0); (700, 25); (500, 25)|] 1.0 (-10) 192 64 64) ;;
|
||||
|
||||
let spheres = dyn_create default_sphere ;;
|
||||
dyn_add spheres (create_sphere 200 400 20. 1. 5 220 32 220) ;;
|
||||
dyn_add spheres (create_sphere 300 200 20. 1. 3 192 0 192) ;;
|
||||
dyn_add spheres (create_sphere 400 450 20. 1. 3 192 0 192) ;;
|
||||
dyn_add spheres (create_sphere 600 350 20. 1. 10 255 64 255) ;;
|
||||
dyn_add spheres (create_sphere 800 450 20. 1. 3 192 0 192) ;;
|
||||
dyn_add spheres (create_sphere 900 200 20. 1. 3 192 0 192) ;;
|
||||
dyn_add spheres (create_sphere 1000 400 20. 1. 5 220 32 220) ;;
|
||||
dyn_add spheres (create_sphere 50 200 15. 1. 20 255 255 32) ;;
|
||||
dyn_add spheres (create_sphere 1150 200 15. 1. 20 255 255 32) ;;
|
||||
|
||||
|
||||
simulate polygons spheres ;;
|
||||
(*
|
||||
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)
|
||||
*)
|
||||
|
||||
(* ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics -thread -package threads -linkpkg main.ml *)
|
||||
Loading…
Reference in New Issue