diff --git a/a.out b/a.out index 99326ed..17db560 100755 Binary files a/a.out and b/a.out differ diff --git a/main.cmi b/main.cmi index 2b08fee..89cf921 100644 Binary files a/main.cmi and b/main.cmi differ diff --git a/main.cmx b/main.cmx index 700a23e..7960629 100644 Binary files a/main.cmx and b/main.cmx differ diff --git a/main.ml b/main.ml index c569061..254b0f2 100644 --- a/main.ml +++ b/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 *) \ No newline at end of file diff --git a/main.o b/main.o index 9f2c464..58f4bd3 100644 Binary files a/main.o and b/main.o differ