diff --git a/a.out b/a.out index 17db560..0a9d772 100755 Binary files a/a.out and b/a.out differ diff --git a/main.cmi b/main.cmi index 89cf921..8c810a3 100644 Binary files a/main.cmi and b/main.cmi differ diff --git a/main.cmx b/main.cmx index 7960629..a47e173 100644 Binary files a/main.cmx and b/main.cmx differ diff --git a/main.ml b/main.ml index 254b0f2..23c0b9f 100644 --- a/main.ml +++ b/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,14 +86,41 @@ 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 - | k -> 1 + ln10 (k/10) ;; + | 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 ;; +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 *) \ No newline at end of file diff --git a/main.o b/main.o index 58f4bd3..59e6c58 100644 Binary files a/main.o and b/main.o differ