Initial commit

compilation.sh

@@ -0,0 +1 @@
+ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics main.ml

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 *)