mp2i-vms.fr
Initial commit
This commit is contained in:
commit
1bef01087a
|
|
@ -0,0 +1 @@
|
|||
ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics main.ml
|
||||
|
|
@ -0,0 +1,305 @@
|
|||
open Graphics ;;
|
||||
|
||||
Random.self_init () ;;
|
||||
|
||||
(* use Ctrl+F with 'XXXXXX' to look for sections *)
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* XXXXXX Types + Constants *)
|
||||
|
||||
exception ReturnBool of bool ;;
|
||||
exception ReturnInt of int ;;
|
||||
|
||||
type pt_2d = {
|
||||
mutable x : float ;
|
||||
mutable y : float ;
|
||||
} ;;
|
||||
|
||||
type polygon = {
|
||||
vertexes : pt_2d array ;
|
||||
rgb : int ;
|
||||
xmin : float ;
|
||||
xmax : float ;
|
||||
ymin : float ;
|
||||
ymax : float ;
|
||||
mutable restitution : float ;
|
||||
score : int ;
|
||||
} ;;
|
||||
|
||||
type ball = {
|
||||
radius : float ;
|
||||
mass : float ;
|
||||
rgb : int ;
|
||||
xy : pt_2d ;
|
||||
v : pt_2d ;
|
||||
a : pt_2d ;
|
||||
angv : pt_2d ;
|
||||
} ;;
|
||||
|
||||
let univ_dt = 0.05 ;;
|
||||
let univ_friction = 0.8 ;;
|
||||
let univ_g = 300.0 ;;
|
||||
let pi = 3.14159265358979343 ;;
|
||||
|
||||
let score = ref 0 ;;
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* XXXXXX Arithmetical operations *)
|
||||
|
||||
let rec ln10 n = match n with
|
||||
| k when k < 0 -> failwith "Are you sure about that ?"
|
||||
| k when k < 10 -> 0
|
||||
| k -> 1 + ln10 (k/10) ;;
|
||||
|
||||
let convexf x y theta =
|
||||
(1.0 -. theta) *. x +. theta *. y ;;
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* XXXXXX Vectorial operations *)
|
||||
|
||||
let vect_convexf (px : pt_2d) (py : pt_2d) theta =
|
||||
{
|
||||
x = convexf px.x py.x theta ;
|
||||
y = convexf px.y py.y theta ;
|
||||
} ;;
|
||||
|
||||
|
||||
let vect_sum_2D (p1 : pt_2d) (p2 : pt_2d) =
|
||||
{
|
||||
x = p1.x +. p2.x ;
|
||||
y = p1.y +. p2.y ;
|
||||
} ;;
|
||||
|
||||
let vect_diff_2D (p1 : pt_2d) (p2 : pt_2d) =
|
||||
{
|
||||
x = p1.x -. p2.x ;
|
||||
y = p1.y -. p2.y ;
|
||||
} ;;
|
||||
|
||||
let vect_mult_2D (p1 : pt_2d) (lambda : float) =
|
||||
{
|
||||
x = p1.x *. lambda ;
|
||||
y = p1.y *. lambda ;
|
||||
} ;;
|
||||
|
||||
let vect_midpoint_2D (p1 : pt_2d) (p2 : pt_2d) =
|
||||
{
|
||||
x = (p1.x +. p2.x) /. 2.0 ;
|
||||
y = (p1.y +. p2.y) /. 2.0 ;
|
||||
} ;;
|
||||
|
||||
let vect_normal_2D (p1 : pt_2d) (p2 : pt_2d) =
|
||||
{
|
||||
x = -. (p2.y -. p1.y) ;
|
||||
y = (p2.x -. p1.x) ;
|
||||
} ;;
|
||||
|
||||
let vect_dot_product_2D (p1 : pt_2d) (p2 : pt_2d) =
|
||||
p1.x *. p2.x +. p1.y *. p2.y ;;
|
||||
|
||||
let vect_norm_2D (p1 : pt_2d) =
|
||||
Float.sqrt (vect_dot_product_2D p1 p1) ;;
|
||||
|
||||
let vect_dist_2D (p1 : pt_2d) (p2 : pt_2d) =
|
||||
vect_norm_2D (vect_diff_2D p1 p2) ;;
|
||||
|
||||
let vect_scale_2D (v1 : pt_2d) (v2 : pt_2d) =
|
||||
vect_mult_2D v1 ((vect_norm_2D v2) /. (vect_norm_2D v1)) ;;
|
||||
|
||||
let vect_normalize_2D (v1 : pt_2d) =
|
||||
vect_mult_2D v1 (1.0 /. (vect_norm_2D v1)) ;;
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* XXXXXX Physics functions *)
|
||||
|
||||
let step_one_ball (b : ball) (dt : float) =
|
||||
{
|
||||
x = b.xy.x +. b.v.x *. dt ;
|
||||
y = b.xy.y +. b.v.y *. dt ;
|
||||
} ;;
|
||||
|
||||
let is_in_bounding_box (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 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 return_proj_of_point (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_convexf spt ept k)
|
||||
| k when k < 0. -> spt
|
||||
| k -> ept;;
|
||||
|
||||
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
|
||||
(-1)
|
||||
else begin
|
||||
try
|
||||
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)
|
||||
done;
|
||||
(-1)
|
||||
with
|
||||
| ReturnInt b -> b
|
||||
end ;;
|
||||
|
||||
let update_ball_data (b : ball) (polys : polygon array) (dt : float) =
|
||||
let add = ref true in
|
||||
|
||||
for p = 0 to (Array.length polys -1) do
|
||||
let hit = (is_collision b polys.(p) dt) in
|
||||
if !add && hit <> -1 then begin
|
||||
add := false;
|
||||
score := !score + polys.(p).score ;
|
||||
|
||||
(* apply normal reaction force *)
|
||||
b.v.x <- b.v.x -. b.a.x *. dt ;
|
||||
b.v.y <- b.v.y -. b.a.y *. dt ;
|
||||
|
||||
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 nv = vect_norm_2D b.v in
|
||||
|
||||
let reaction_force = vect_mult_2D (vect_normalize_2D (vect_diff_2D b.xy proj)) nv in
|
||||
|
||||
b.v.x <- ((reaction_force.x *. polys.(p).restitution)) ;
|
||||
b.v.y <- ((reaction_force.y *. polys.(p).restitution)) ;
|
||||
|
||||
(* apply friction/rotational force *)
|
||||
end
|
||||
done ;
|
||||
|
||||
b.xy.x <- b.xy.x +. b.v.x *. dt ;
|
||||
b.xy.y <- b.xy.y +. b.v.y *. dt ;
|
||||
|
||||
b.v.x <- b.v.x +. b.a.x *. dt ;
|
||||
b.v.y <- b.v.y +. b.a.y *. dt ;
|
||||
|
||||
b.a.y <- -. univ_g ;;
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* XXXXXX Graphics fcts *)
|
||||
|
||||
let draw_integer x0 y n0 r =
|
||||
(* 7-seg display *)
|
||||
let n = ref n0 in
|
||||
let size = ln10 n0 in
|
||||
let len = r/3 in
|
||||
let offset = size*(len*11/7)/2 in
|
||||
for i = 0 to size do
|
||||
let x = x0 + offset - i*(len*11/7) in
|
||||
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
|
||||
draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
|
||||
draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
|
||||
draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
|
||||
draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
|
||||
draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
|
||||
draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|];
|
||||
|
||||
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
|
||||
draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|];
|
||||
|
||||
n := !n/10;
|
||||
done ;;
|
||||
|
||||
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_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) ;
|
||||
set_line_width 4 ;
|
||||
draw_circle (int_of_float b.xy.x) (int_of_float b.xy.y) (int_of_float b.radius) ;;
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* XXXXXX Misc fcts *)
|
||||
|
||||
let get1char_plus () =
|
||||
if key_pressed () then
|
||||
read_key ()
|
||||
else
|
||||
'@' ;;
|
||||
|
||||
let create_ball (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green : int) (blue : int) =
|
||||
{
|
||||
radius = r ;
|
||||
rgb = red + 256 * green + 256 * 256 * blue ;
|
||||
mass = m;
|
||||
xy = {x = float_of_int x0; y = float_of_int y0} ;
|
||||
v = {x = 0. ; y = 0.} ;
|
||||
a = {x = 0. ; y = 0.} ;
|
||||
angv = {x = 0. ; y = 0.} ;
|
||||
} ;;
|
||||
|
||||
let create_polygon (arr : (int * int) array) (rest : float) (pts : 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 ;
|
||||
} ;;
|
||||
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* ------------------------------------------------------------------------------------- *)
|
||||
(* XXXXXX Main *)
|
||||
|
||||
let simulate () =
|
||||
open_graph " 1200x800" ;
|
||||
set_window_title "WAH" ;
|
||||
|
||||
let pinball = create_ball 25.0 600 700 0.15 169 169 169 in
|
||||
let triangle = create_polygon [|(100, 100); (1100, 800); (1100, 100)|] 0.75 0 128 255 128 in
|
||||
|
||||
while true do
|
||||
let __start = Unix.gettimeofday() in
|
||||
auto_synchronize false ;
|
||||
clear_graph () ;
|
||||
|
||||
set_color black ;
|
||||
set_line_width 4 ;
|
||||
draw_integer 600 770 !score 50 ;
|
||||
|
||||
set_line_width 1 ;
|
||||
draw_polygon triangle ;
|
||||
draw_ball pinball ;
|
||||
|
||||
auto_synchronize true ;
|
||||
Unix.sleepf 0.005 ;
|
||||
|
||||
let __end = Unix.gettimeofday() in
|
||||
update_ball_data pinball [|triangle|] (__end -. __start) ;
|
||||
done;
|
||||
|
||||
close_graph () ;;
|
||||
|
||||
simulate () ;;
|
||||
|
||||
(* ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics -thread -package threads -linkpkg main.ml *)
|
||||
Loading…
Reference in New Issue