added level edition (primitive)

main.ml

@@ -2,14 +2,16 @@ open Graphics ;;
 
 Random.self_init () ;;
 
-(* use Ctrl+F with 'XXXXXX' to look for sections *)
+(* use Ctrl+F with 'WALUIGI_TIME' to look for sections *)
 
 (* ------------------------------------------------------------------------------------- *)
 (* ------------------------------------------------------------------------------------- *)
-(* XXXXXX Types + Constants *)
+(* WALUIGI_TIME Types + Constants *)
 
 exception ReturnBool of bool ;;
 exception ReturnInt of int ;;
+exception HasEnded ;;
+exception Break ;;
 
 type pt_2d = {
   mutable x : float ;
@@ -27,6 +29,17 @@ type polygon = {
   score : int ;
 } ;;
 
+let default_polygon = {
+  vertexes = [||] ;
+  rgb = 0 ;
+  xmin = 1. ;
+  xmax = -. 1. ;
+  ymin = 1. ;
+  ymax = -. 1. ;
+  restitution = 0. ;
+  score = 0 ;
+} ;;
+
 type ball = {
   radius : float ;
   mass : float ;
@@ -48,7 +61,7 @@ let score = ref 0 ;;
 
 (* ------------------------------------------------------------------------------------- *)
 (* ------------------------------------------------------------------------------------- *)
-(* XXXXXX Arithmetical operations *)
+(* WALUIGI_TIME Arithmetical operations *)
 
 let rec ln10 n = match n with
     | k when k < 0 -> failwith "Are you sure about that ?"
@@ -60,7 +73,66 @@ let convexf x y theta =
 
 (* ------------------------------------------------------------------------------------- *)
 (* ------------------------------------------------------------------------------------- *)
-(* XXXXXX Vectorial operations *)
+(* WALUIGI_TIME Dynamic Arrays *)
+
+type 'a dynamic = {
+  mutable len : int ;
+  mutable memlen : int ;
+  mutable tab : 'a array
+} ;;
+
+let dyn_create (elt : 'a) =
+  {
+    len = 0 ;
+    memlen = 16 ;
+    tab = Array.make 16 elt
+  } ;;
+
+let dyn_add (dyn : 'a dynamic) (elt : 'a) =
+  if dyn.len = dyn.memlen then begin
+    let _new = Array.make (2 * dyn.memlen) dyn.tab.(0) in
+    for i = 0 to dyn.memlen -1 do
+      _new.(i) <- dyn.tab.(i)
+    done;
+    dyn.tab <- _new ;
+    dyn.memlen <- dyn.memlen * 2 ;
+  end;
+  dyn.tab.(dyn.len) <- elt ;
+  dyn.len <- dyn.len +1 ;;
+
+let dyn_remove (dyn : 'a dynamic) (elt : 'a) =
+  try
+    for i = 0 to dyn.len -1 do
+      if dyn.tab.(i) = elt then
+        raise (ReturnInt i)
+    done;
+    raise (ReturnInt (-1))
+  with
+    | ReturnInt (-1) -> ()
+    | ReturnInt k ->
+      for i = k to dyn.len -2 do
+        dyn.tab.(i) <- dyn.tab.(i+1)
+      done;
+      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
+    acc := f !acc dyn.tab.(i)
+  done;
+  !acc ;;
+
+(* ------------------------------------------------------------------------------------- *)
+(* ------------------------------------------------------------------------------------- *)
+(* WALUIGI_TIME Arithmetical operations *)
 
 let vect_convexf (px : pt_2d) (py : pt_2d) theta =
   {
@@ -131,7 +203,7 @@ let vect_symmetry (m : pt_2d) (p1 : pt_2d) (p2 : pt_2d) =
 
 (* ------------------------------------------------------------------------------------- *)
 (* ------------------------------------------------------------------------------------- *)
-(* XXXXXX Physics functions *)
+(* WALUIGI_TIME Physics functions *)
 
 let step_one_ball (b : ball) (dt : float) =
   {
@@ -165,15 +237,12 @@ let is_collision (b : ball) (poly : polygon) (dt : float) =
   end ;;
 
 let update_ball_data (b : ball) (polys : polygon array) (dt : float) =
-  let add = ref true in
-
   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
-    if !add && hit <> -1 then begin
-      add := false;
+    if hit <> -1 then begin
       score := !score + polys.(p).score ;
 
       (* apply normal reaction force *)
@@ -209,7 +278,7 @@ let update_ball_data (b : ball) (polys : polygon array) (dt : float) =
 
 (* ------------------------------------------------------------------------------------- *)
 (* ------------------------------------------------------------------------------------- *)
-(* XXXXXX Graphics fcts *)
+(* WALUIGI_TIME Graphics fcts *)
 
 let draw_integer x0 y n0 r =
   (* 7-seg display *)
@@ -255,7 +324,7 @@ let draw_ball (b : ball) =
 
 (* ------------------------------------------------------------------------------------- *)
 (* ------------------------------------------------------------------------------------- *)
-(* XXXXXX Misc fcts *)
+(* WALUIGI_TIME Misc fcts *)
 
 let get1char_plus () =
   if key_pressed () then
@@ -288,15 +357,72 @@ let create_polygon (arr : (int * int) array) (rest : float) (pts : int) (red : i
 
 (* ------------------------------------------------------------------------------------- *)
 (* ------------------------------------------------------------------------------------- *)
-(* XXXXXX Main *)
+(* WALUIGI_TIME Edition functions *)
 
-let simulate () =
+let customize lvl_name =
   open_graph " 1200x800" ;
   set_window_title "WAH" ;
 
-  let pinball = create_ball 25.0 150 730 0.15 169 169 169 in
-  let triangle = create_polygon [|(100, 100); (100, 700); (1100, 300); (1100, 100)|] 0.15 0 128 255 128 in
-  let triangle2 = create_polygon [|(1100, 100); (1200, 100); (1200, 750); (1100, 750)|] 1.0 0 255 128 128 in
+  let (res : polygon dynamic) = dyn_create default_polygon in
+  let stopped = ref false in
+  let refresh = ref true in
+
+  let (cpoly : pt_2d dynamic) = dyn_create {x = 0. ; y = 0.} in
+
+  while not !stopped do
+    Unix.sleepf 0.005 ;
+
+    if !refresh then begin
+      auto_synchronize false ;
+      clear_graph () ;
+      refresh := false ;
+      for p = 0 to res.len -1 do
+        draw_polygon res.tab.(p)
+      done;
+      auto_synchronize true ;
+    end;
+
+    match (get1char_plus ()) with
+      | 'a' -> (* add current polygon *)
+        (*Printf.printf "+polygon\n" ;*)
+        if cpoly.len >= 2 then begin
+          refresh := true ;
+          let newVTX = Array.init cpoly.len (fun k -> cpoly.tab.(k)) in 
+          dyn_add res {
+            vertexes = newVTX ;
+            rgb = 128 + 255*128 + 255*255*128 ;
+            xmin = Array.fold_left (fun acc k -> min acc k.x) (999999.) newVTX ;
+            xmax = Array.fold_left (fun acc k -> max acc k.x) (-.999999.) newVTX ;
+            ymin = Array.fold_left (fun acc k -> min acc k.y) (999999.) newVTX ;
+            ymax = Array.fold_left (fun acc k -> max acc k.y) (-.999999.) newVTX ;
+            restitution = 1. ;
+            score = 0 ;
+          } ;
+          cpoly.len <- 0 ;
+        end
+      | 'v' -> (* add a vertex *)
+        (*Printf.printf "+vertex\n" ;*)
+        let (mx, my) = mouse_pos () in
+        dyn_add cpoly {x = float_of_int mx ; y = float_of_int my} ;
+      | 'c' -> (* clear current polygon *)
+        (*Printf.printf "cleared\n" ;*)
+        cpoly.len <- 0 ;
+      | 'h' ->
+        stopped := true ;
+      | _ -> ()
+  done;
+  close_graph ();
+  res ;;
+
+(* ------------------------------------------------------------------------------------- *)
+(* ------------------------------------------------------------------------------------- *)
+(* WALUIGI_TIME Main *)
+
+let simulate (data : polygon dynamic) =
+  open_graph " 1200x800" ;
+  set_window_title "WAH" ;
+
+  let pinball = create_ball 25.0 600 800 0.15 169 169 169 in
 
   while true do
     let __start = Unix.gettimeofday() in
@@ -308,19 +434,21 @@ let simulate () =
     draw_integer 600 770 !score 50 ;
 
     set_line_width 1 ;
-    draw_polygon triangle ;
-    draw_polygon triangle2 ;
+    for d = 0 to data.len -1 do
+      draw_polygon data.tab.(d)
+    done;
     draw_ball pinball ;
 
     auto_synchronize true ;
     Unix.sleepf 0.005 ;
 
     let __end = Unix.gettimeofday() in
-    update_ball_data pinball [|triangle; triangle2|] (__end -. __start) ;
+    update_ball_data pinball data.tab (__end -. __start) ;
   done;
 
   close_graph () ;;
 
-simulate () ;;
+let polygons = customize () ;;
+simulate polygons ;;
 
 (* ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics -thread -package threads -linkpkg main.ml *)