open Graphics ;; Random.self_init () ;; (* use Ctrl+F with 'WALUIGI_TIME' to look for sections *) (* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *) (* WALUIGI_TIME Types + Constants *) exception ReturnBool of bool ;; exception ReturnInt of int ;; exception ReturnIntArr of int array * int ;; let __width__ = 1200 and __height__ = 800 ;; let __istr__ = " 1200x800" ;; let univ_dt = 0.003 ;; let _camx_ = ref 0 and _camy_ = ref 0 ;; 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 ; mutable max_hp : int ; mutable shScore : bool ; mutable hp : int ; } ;; type sphere = { center : pt_2d ; radius : float ; rgb : int ; xmin : float ; xmax : float ; ymin : float ; ymax : float ; mutable restitution : float ; mutable shScore : bool ; score : int ; } ;; type flipper_side = Left | Right ;; type flipper = { side : flipper_side ; xy : pt_2d ; radius : float ; length : float ; mutable theta : float (* in degrees *) ; mutable dtheta : float ; agmin : float ; agmax : float ; vtxs : polygon } ;; type ball = { mutable active : bool ; radius : float ; mass : float ; rgb : int ; xy : pt_2d ; v : pt_2d ; a : pt_2d ; fres : pt_2d ; } ;; (* --- *) let default_polygon = { vertexes = [||] ; rgb = 0 ; xmin = 1. ; xmax = -. 1. ; ymin = 1. ; ymax = -. 1. ; restitution = 0. ; score = 0 ; max_hp = 1; shScore = true ; hp = 1 ; } ;; let default_sphere = { center = {x = 0. ; y = 0.} ; rgb = 0 ; radius = -. 1. ; xmin = 1. ; xmax = -. 1. ; ymin = 1. ; ymax = -. 1. ; restitution = 0. ; shScore = true ; score = 0 ; } ;; let default_flipper = { side = Left ; xy = {x = 0. ; y = 0.} ; radius = 0. ; length = 0. ; theta = 0. (* in degrees *) ; dtheta = 0. ; agmin = 0. ; agmax = 0. ; vtxs = default_polygon ; } ;; let univ_g = 750.0 ;; let pi = 3.14159265358979343 ;; let epsilon = (1. /. 131072.) ;; let winBL = { x = 0. ; y = 0. ; } ;; let winTR = { x = 1200. ; y = 800. ; } let winball = { x = 750. ; y = 500. ; } let gforce = {x = 0. ; y = -. univ_g} ;; let remaining = ref 8 ;; let score = ref 0 ;; (* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *) (* WALUIGI_TIME Threads *) let n_threads = 8 ;; let beep_boop = Array.make n_threads false ;; let beep_id = ref 0 ;; let playbeep id = while false do if beep_boop.(id) then begin ignore (Unix.system "./sound wah/scored_hit.wav") ; beep_boop.(id) <- false ; end; Unix.sleepf univ_dt ; done;; let beep_list = Array.init n_threads (fun k -> Thread.create playbeep k) ;; (**) let play_music () = while false do ignore (Unix.system "./sound wah/wah_metal.wav") ; ignore (Unix.system "./sound wah/wah_eurobeat.wav") ; ignore (Unix.system "./sound wah/wah_hardcore.wav") ; done;; let theme_thr = Thread.create play_music () ;; (* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *) (* 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) ;; 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 *) 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_remove_id (dyn : 'a dynamic) (id : int) = assert (id >= 0 && id < dyn.len) ; let temp = dyn.tab.(dyn.len -1) in dyn.tab.(dyn.len -1) <- dyn.tab.(id) ; dyn.tab.(id) <- temp ; 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 = { 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 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 return_proj_of_point_D (m : pt_2d) (spt : pt_2d) (ept : pt_2d) = let theta = (-. ((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))) in (vect_convexf spt ept theta) ;; 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)) ;; let vect_symmetry (m : pt_2d) (p1 : pt_2d) (p2 : pt_2d) = let proj = return_proj_of_point_D m p1 p2 in let ortho = vect_diff_2D proj m in vect_sum_2D (vect_sum_2D ortho ortho) m ;; (* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *) (* WALUIGI_TIME 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_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 distance_infinite_segment (m : pt_2d) (spt : pt_2d) (ept : pt_2d) = let theta = (-. ((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))) in vect_dist_2D (vect_convexf spt ept theta) m ;; let is_collision_p (b : ball) (poly : polygon) (dt : float) = if not (is_in_bounding_box_p b poly) then ([||], 0) else begin try let mind = ref b.radius and minidx = Array.make 3 (-1) and minarrid = ref 0 in for i = 0 to Array.length poly.vertexes - 1 do 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 -. epsilon then begin mind := dst ; minidx.(0) <- i ; minidx.(1) <- (-1) ; minidx.(2) <- (-1) ; minarrid := 1; end else if dst <= !mind then begin minidx.(!minarrid) <- i ; incr minarrid ; end done; raise (ReturnIntArr (minidx, !minarrid)) with | ReturnIntArr (a, b) -> (a, b) | Invalid_argument _ -> failwith "ok then" end ;; let playbeep () = beep_boop.(!beep_id) <- true ; beep_id := (!beep_id+1) mod n_threads ;; 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 is_collision_bl (b : ball) (ob : ball) (dt : float) = vect_dist_2D (step_one_ball b dt) (ob.xy) <= (ob.radius +. b.radius) ;; let remove_dead_destr (destr : polygon dynamic) (cand : int list) = let rec aux = function | [] -> () | h::t -> dyn_remove_id destr h ; aux t in aux cand ;; let update_ball_data (b : ball) (id : int) (balls : ball array) (polys : polygon dynamic) (destr : polygon dynamic) (spheres : sphere dynamic) (flips : flipper dynamic) (dt : float) = b.fres.x <- 0. ; b.fres.y <- 0. ; let destr_remove = ref [] in for p = 0 to polys.len -1 do let (hitarr, hitlen) = (is_collision_p b polys.tab.(p) dt) in if hitlen > 0 then begin for h = 0 to hitlen -1 do let hit = hitarr.(h) in score := !score + polys.tab.(p).score ; if h = 0 && polys.tab.(p).score > 0 then playbeep () ; if polys.tab.(p).restitution = 0. then begin b.active <- false ; decr remaining ; end; (* apply normal reaction force *) let hit2 = (hit +1) mod (Array.length polys.tab.(p).vertexes) in let proj = return_proj_of_point b.xy polys.tab.(p).vertexes.(hit) polys.tab.(p).vertexes.(hit2) in let proj_n = vect_normalize_2D (vect_diff_2D b.xy proj) in let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in if scal > 0. then begin let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in b.fres.x <- b.fres.x +. reaction_force_2.x *. polys.tab.(p).restitution /. float_of_int hitlen ; b.fres.y <- b.fres.y +. reaction_force_2.y *. polys.tab.(p).restitution /. float_of_int hitlen ; end; (* change velocity according to angle *) if hitlen = 1 then begin let director = vect_diff_2D polys.tab.(p).vertexes.(hit2) polys.tab.(p).vertexes.(hit) in let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in b.v.x <- symmetric.x ; b.v.y <- symmetric.y ; end else begin let newv = vect_mult_2D (vect_normalize_2D (vect_diff_2D b.xy proj)) (vect_norm_2D b.v) in b.v.x <- newv.x ; b.v.y <- newv.y ; end done end done ; for p = 0 to destr.len -1 do if destr.tab.(p).hp > 0 then begin let (hitarr, hitlen) = (is_collision_p b destr.tab.(p) dt) in if hitlen > 0 then begin for h = 0 to hitlen -1 do let hit = hitarr.(h) in score := !score + destr.tab.(p).score ; destr.tab.(p).hp <- destr.tab.(p).hp -1 ; if h = 0 && destr.tab.(p).score > 0 then playbeep () ; if destr.tab.(p).restitution = 0. then begin b.active <- false ; decr remaining ; end; (* apply normal reaction force *) let hit2 = (hit +1) mod (Array.length destr.tab.(p).vertexes) in let proj = return_proj_of_point b.xy destr.tab.(p).vertexes.(hit) destr.tab.(p).vertexes.(hit2) in let proj_n = vect_normalize_2D (vect_diff_2D b.xy proj) in let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in if scal > 0. then begin let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in b.fres.x <- b.fres.x +. reaction_force_2.x *. destr.tab.(p).restitution /. float_of_int hitlen ; b.fres.y <- b.fres.y +. reaction_force_2.y *. destr.tab.(p).restitution /. float_of_int hitlen ; end; (* change velocity according to angle *) if hitlen = 1 then begin let director = vect_diff_2D destr.tab.(p).vertexes.(hit2) destr.tab.(p).vertexes.(hit) in let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in b.v.x <- symmetric.x ; b.v.y <- symmetric.y ; end else begin let newv = vect_mult_2D (vect_normalize_2D (vect_diff_2D b.xy proj)) (vect_norm_2D b.v) in b.v.x <- newv.x ; b.v.y <- newv.y ; end done end end else begin destr_remove := (p)::(!destr_remove) ; end done ; for s = 0 to spheres.len -1 do if is_collision_s b spheres.tab.(s) dt then begin score := !score + spheres.tab.(s).score ; if spheres.tab.(s).score > 0 then playbeep () ; if spheres.tab.(s).restitution = 0. then begin b.active <- false ; decr remaining ; end; (* apply normal reaction force *) let proj_n = vect_normalize_2D (vect_diff_2D b.xy spheres.tab.(s).center) in let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in if scal > 0. then begin let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in b.fres.x <- b.fres.x +. reaction_force_2.x *. spheres.tab.(s).restitution *. 1.1 ; b.fres.y <- b.fres.y +. reaction_force_2.y *. spheres.tab.(s).restitution *. 1.1 ; end; (* change velocity according to angle *) let theta = b.radius /. (vect_norm_2D (vect_diff_2D b.xy spheres.tab.(s).center)) in let intersection = (vect_convexf b.xy spheres.tab.(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 ; for s = 0 to Array.length balls -1 do if s <> id && is_collision_bl b balls.(s) dt then begin (* apply normal reaction force *) let proj_n = vect_normalize_2D (vect_diff_2D b.xy balls.(s).xy) in let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in if scal > 0. then begin let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in b.fres.x <- b.fres.x +. reaction_force_2.x *. 1.1 ; b.fres.y <- b.fres.y +. reaction_force_2.y *. 1.1 ; end; (* change velocity according to angle *) let theta = b.radius /. (vect_norm_2D (vect_diff_2D b.xy balls.(s).xy)) in let intersection = (vect_convexf b.xy balls.(s).xy 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 ; for f = 0 to flips.len -1 do let (hitarr, hitlen) = (is_collision_p b flips.tab.(f).vtxs dt) in if hitlen > 0 then begin for h = 0 to hitlen -1 do let hit = hitarr.(h) in (* apply normal reaction force *) let hit2 = (hit +1) mod (Array.length flips.tab.(f).vtxs.vertexes) in let proj = return_proj_of_point b.xy flips.tab.(f).vtxs.vertexes.(hit) flips.tab.(f).vtxs.vertexes.(hit2) in let proj_n = vect_normalize_2D (vect_diff_2D b.xy proj) in let scal = (vect_dot_product_2D (vect_normalize_2D gforce) proj_n) in if scal > 0. then begin let reaction_force_2 = vect_mult_2D proj_n (univ_g *. b.mass *. scal) in b.fres.x <- b.fres.x +. reaction_force_2.x *. flips.tab.(f).vtxs.restitution /. float_of_int hitlen ; b.fres.y <- b.fres.y +. reaction_force_2.y *. flips.tab.(f).vtxs.restitution /. float_of_int hitlen ; end; (* change velocity according to angle *) if hitlen = 1 then begin let director = vect_diff_2D flips.tab.(f).vtxs.vertexes.(hit2) flips.tab.(f).vtxs.vertexes.(hit) in let symmetric = vect_symmetry b.v {x = 0. ; y = 0.} director in b.v.x <- symmetric.x ; b.v.y <- symmetric.y ; end else begin let newv = vect_mult_2D (vect_normalize_2D (vect_diff_2D b.xy proj)) (vect_norm_2D b.v) in b.v.x <- newv.x ; b.v.y <- newv.y ; end; (* add relative velocity *) if ((flips.tab.(f).side = Left && flips.tab.(f).dtheta > 0.) || (flips.tab.(f).side = Right && flips.tab.(f).dtheta < 0.)) then begin b.v.x <- 0.7 *. b.v.x +. flips.tab.(f).dtheta *. 3.14159 /. 180. *. (vect_dist_2D flips.tab.(f).xy b.xy) *. (cos ((flips.tab.(f).theta +. 90.) *. 3.14159 /. 180.)); b.v.y <- 0.7 *. b.v.y +. flips.tab.(f).dtheta *. 3.14159 /. 180. *. (vect_dist_2D flips.tab.(f).xy b.xy) *. (sin ((flips.tab.(f).theta +. 90.) *. 3.14159 /. 180.)); end done end done; (* P = mg *) b.fres.y <- b.fres.y -. univ_g *. b.mass ; (* PFD : ma = sum(F) *) b.a.x <- b.fres.x /. b.mass ; b.a.y <- b.fres.y /. b.mass ; b.v.x <- b.v.x +. b.a.x *. dt ; b.v.y <- b.v.y +. b.a.y *. dt ; b.xy.x <- b.xy.x +. b.v.x *. dt ; b.xy.y <- b.xy.y +. b.v.y *. dt ; if !destr_remove <> [] then begin remove_dead_destr destr !destr_remove end ;; let update_balls (bl : ball array) (polys : polygon dynamic) (destr : polygon dynamic) (spheres : sphere dynamic) (flips : flipper dynamic) (dt : float) = for b = 0 to Array.length bl -1 do if bl.(b).active then begin update_ball_data bl.(b) b bl polys destr spheres flips dt ; end done ;; let update_flippers (flips : flipper dynamic) (dt : float) = for fl = 0 to flips.len -1 do if flips.tab.(fl).dtheta <> 0. then begin let x0 = flips.tab.(fl).xy.x and y0 = flips.tab.(fl).xy.y and rd = flips.tab.(fl).radius and len = flips.tab.(fl).length and theta0 = flips.tab.(fl).theta in match flips.tab.(fl).side with | Left -> let theta_dt = ref (flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt) in if !theta_dt > flips.tab.(fl).agmax then begin flips.tab.(fl).dtheta <- -.(flips.tab.(fl).dtheta) ; theta_dt := flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt end ; if !theta_dt < flips.tab.(fl).agmin then begin flips.tab.(fl).dtheta <- 0. ; theta_dt := flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt end ; flips.tab.(fl).theta <- !theta_dt ; flips.tab.(fl).vtxs.vertexes.(0) <- { x = x0 +. len *. (cos (theta0 *. 3.14159 /. 180.)); y = y0 +. len *. (sin (theta0 *. 3.14159 /. 180.)) }; flips.tab.(fl).vtxs.vertexes.(1) <- { x = x0 +. rd *. (cos ((theta0 +. 90.) *. 3.14159 /. 180.)); y = y0 +. rd *. (sin ((theta0 +. 90.) *. 3.14159 /. 180.)) }; flips.tab.(fl).vtxs.vertexes.(2) <- { x = x0 +. rd *. (cos ((theta0 -. 90.) *. 3.14159 /. 180.)); y = y0 +. rd *. (sin ((theta0 -. 90.) *. 3.14159 /. 180.)) }; | Right -> let theta_dt = ref (flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt) in if !theta_dt > flips.tab.(fl).agmax then begin flips.tab.(fl).dtheta <- 0. ; theta_dt := flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt end ; if !theta_dt < flips.tab.(fl).agmin then begin flips.tab.(fl).dtheta <- -.(flips.tab.(fl).dtheta) ; theta_dt := flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt end ; flips.tab.(fl).theta <- !theta_dt ; flips.tab.(fl).vtxs.vertexes.(0) <- { x = x0 +. len *. (cos (theta0 *. 3.14159 /. 180.)); y = y0 +. len *. (sin (theta0 *. 3.14159 /. 180.)) }; flips.tab.(fl).vtxs.vertexes.(1) <- { x = x0 +. rd *. (cos ((theta0 +. 90.) *. 3.14159 /. 180.)); y = y0 +. rd *. (sin ((theta0 +. 90.) *. 3.14159 /. 180.)) }; flips.tab.(fl).vtxs.vertexes.(2) <- { x = x0 +. rd *. (cos ((theta0 -. 90.) *. 3.14159 /. 180.)); y = y0 +. rd *. (sin ((theta0 -. 90.) *. 3.14159 /. 180.)) }; end done ;; (* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *) (* WALUIGI_TIME 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 + !_camx_, y+len + !_camy_); (x-len/2 + !_camx_, y + !_camy_)|]; if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then draw_poly_line [|(x-len/2 + !_camx_, y+len + !_camy_); (x+len/2 + !_camx_, y+len + !_camy_)|]; if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then draw_poly_line [|(x+len/2 + !_camx_, y+len + !_camy_); (x+len/2 + !_camx_, y + !_camy_)|]; if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then draw_poly_line [|(x-len/2 + !_camx_, y + !_camy_); (x+len/2 + !_camx_, y + !_camy_)|]; if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then draw_poly_line [|(x+len/2 + !_camx_, y-len + !_camy_); (x+len/2 + !_camx_, y + !_camy_)|]; if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then draw_poly_line [|(x-len/2 + !_camx_, y-len + !_camy_); (x+len/2 + !_camx_, y-len + !_camy_)|]; if Array.mem (!n mod 10) [|0; 2; 6; 8|] then draw_poly_line [|(x-len/2 + !_camx_, y-len + !_camy_); (x-len/2 + !_camx_, y + !_camy_)|]; 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 + !_camx_, y+len + !_camy_); (x + !_camx_, y + !_camy_)|]; if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then draw_poly_line [|(x + !_camx_, y+len + !_camy_); (x+len + !_camx_, y+len + !_camy_)|]; if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then draw_poly_line [|(x+len + !_camx_, y+len + !_camy_); (x+len + !_camx_, y + !_camy_)|]; if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then draw_poly_line [|(x + !_camx_, y + !_camy_); (x+len + !_camx_, y + !_camy_)|]; if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then draw_poly_line [|(x+len + !_camx_, y-len + !_camy_); (x+len + !_camx_, y + !_camy_)|]; if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then draw_poly_line [|(x + !_camx_, y-len + !_camy_); (x+len + !_camx_, y-len + !_camy_)|]; if Array.mem (!n mod 10) [|0; 2; 6; 8|] then draw_poly_line [|(x + !_camx_, y-len + !_camy_); (x + !_camx_, y + !_camy_)|]; 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 + !_camx_) (y - r + !_camy_) 3 ; draw_integer_alignedleft (x + 3*r/5 + (ln10 ent + 1)*r*11/7) y ((100 * frac) / (pw 10 (1+ ln10 frac))) r ;; let average (arr : pt_2d array) = let n = Array.length arr in let (avx, avy) = (Array.fold_left (fun (accx, accy) (elt : pt_2d) -> (accx +. elt.x, accy +. elt.y)) (0., 0.) arr) in (avx /. float_of_int n, avy /. float_of_int n) ;; 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) + !_camx_, (int_of_float poly.vertexes.(i).y) + !_camy_))) ; if poly.score <> 0 && poly.shScore then begin set_line_width 4 ; let (cx, cy) = average poly.vertexes in set_color (rgb (255 - (poly.rgb mod 256)) (255 - ((poly.rgb / 256) mod 256)) (255 - ((poly.rgb / (256*256)) mod 256))) ; draw_integer (int_of_float cx) (int_of_float cy) poly.score 40 ; end ;; 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) + !_camx_) ((int_of_float s.center.y) + !_camy_) (int_of_float s.radius) ; if s.score <> 0 && s.shScore then begin set_line_width 4 ; set_color (rgb (255 - (s.rgb mod 256)) (255 - ((s.rgb / 256) mod 256)) (255 - ((s.rgb / (256*256)) mod 256))) ; draw_integer (int_of_float s.center.x) (int_of_float s.center.y) s.score (int_of_float (1.8 *. s.radius)) ; end ;; let draw_flipper (f : flipper) = set_color (rgb 64 64 64) ; fill_circle ((int_of_float f.xy.x) + !_camx_) ((int_of_float f.xy.y) + !_camy_) (int_of_float f.radius) ; draw_polygon f.vtxs ;; 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) + !_camx_) ((int_of_float b.xy.y) + !_camy_) (int_of_float b.radius) ; set_line_width 4 ; draw_circle ((int_of_float b.xy.x) + !_camx_) ((int_of_float b.xy.y) + !_camy_) (int_of_float b.radius) ;; let draw_all_balls (bs : ball array) = for k = 0 to Array.length bs -1 do if bs.(k).active then draw_ball bs.(k) done ;; (* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *) (* WALUIGI_TIME Misc fcts *) let get1char_plus () = if key_pressed () then read_key () else '@' ;; let control_camera = function | 'z' -> _camy_ := !_camy_ - 55 | 'q' -> _camx_ := !_camx_ + 55 | 's' -> _camy_ := !_camy_ + 55 | 'd' -> _camx_ := !_camx_ - 55 | 'n' -> failwith "Aborted.\n" | _ -> () ;; let control_flippers (flips : flipper dynamic) = match get1char_plus () with | 'w' -> for fl = 0 to flips.len -1 do if flips.tab.(fl).side = Left && flips.tab.(fl).dtheta = 0. then flips.tab.(fl).dtheta <- 300. ; done | 'c' -> for fl = 0 to flips.len -1 do if flips.tab.(fl).side = Right && flips.tab.(fl).dtheta = 0. then flips.tab.(fl).dtheta <- -. 300. ; done | ch -> control_camera ch ;; let create_ball (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green : int) (blue : int) = { active = true ; radius = r ; rgb = red + 256 * green + 256 * 256 * blue ; mass = m; xy = {x = float_of_int x0 +. (Random.float 30.0 -. 15.0); y = float_of_int y0 +. (Random.float 30.0 -. 15.0)} ; v = {x = 0. ; y = 0.} ; a = {x = 0. ; y = 0.} ; fres = {x = 0. ; y = 0.} ; } ;; let create_polygon ?showScore:(shsc=true) (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 ; max_hp = 1; shScore = shsc ; hp = 1 } ;; let create_destructible ?showScore:(shsc=true) (arr : (int * int) array) (rest : float) (pts : int) (hitp : 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 ; max_hp = hitp; shScore = shsc ; hp = hitp } ;; let create_sphere ?showScore:(shsc=true) (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 ; shScore = shsc ; score = pts ; } ;; let create_flipper (side : flipper_side) (x0 : int) (y0 : int) (rd : float) (len : float) (theta0 : float) (thmin : float) (thmax : float) = { side = side ; xy = {x = float_of_int x0 ; y = float_of_int y0} ; radius = rd ; length = len ; theta = theta0 (* in degrees *) ; dtheta = 0. ; agmin = thmin ; agmax = thmax ; vtxs = create_polygon [| (x0 + int_of_float (len *. (cos (theta0 *. 3.14159 /. 180.))) , y0 + int_of_float (len *. (sin (theta0 *. 3.14159 /. 180.)))); (x0 + int_of_float (rd *. (cos ((theta0 -. 90.) *. 3.14159 /. 180.))), y0 + int_of_float (rd *. (sin ((theta0 -. 90.) *. 3.14159 /. 180.)))); (x0 + int_of_float (rd *. (cos ((theta0 +. 90.) *. 3.14159 /. 180.))), y0 + int_of_float (rd *. (sin ((theta0 +. 90.) *. 3.14159 /. 180.)))) |] 1. 0 128 128 128 } ;; let generate_pinballs (count : int) (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green : int) (blue : int) = Array.init count (fun k -> create_ball r x0 y0 m red green blue) ;; (* ------------------------------------------------------------------------------------- *) (* ------------------------------------------------------------------------------------- *) (* WALUIGI_TIME Edition functions *) let customize lvl_name = open_graph __istr__ ; set_window_title "WAH" ; 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 univ_dt ; 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 ; max_hp = 1; shScore = false ; hp = 1; } ; 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) (destructible : polygon dynamic) (dats : sphere dynamic) (flips : flipper dynamic) = open_graph __istr__ ; set_window_title "WAH" ; let pinballs = generate_pinballs 8 10.0 600 800 0.15 255 255 0 in let stime = Unix.gettimeofday () in let ctime = ref (Unix.gettimeofday ()) in while true do let __start = Unix.gettimeofday () in auto_synchronize false ; clear_graph () ; set_line_width 4 ; draw_integer 600 100 !remaining 40 ; set_line_width 1 ; for d = 0 to dats.len -1 do draw_sphere dats.tab.(d) done; for d = 0 to data.len -1 do draw_polygon data.tab.(d) done; for d = 0 to destructible.len -1 do draw_polygon destructible.tab.(d) done; for d = 0 to flips.len -1 do draw_flipper flips.tab.(d) done; draw_all_balls pinballs ; set_color (rgb 128 128 32) ; draw_float 25 770 (round (!ctime -. stime) 3) 25 ; set_color black ; set_line_width 4 ; draw_integer 600 770 !score 50 ; auto_synchronize true ; control_flippers flips ; Unix.sleepf univ_dt ; let __end = Unix.gettimeofday () in ctime := !ctime +. (__end -. __start) ; update_balls pinballs data destructible dats flips (__end -. __start) ; update_flippers flips (__end -. __start) ; done; close_graph () ;; let polygons = dyn_create default_polygon ;; let destructible = dyn_create default_polygon ;; let spheres = dyn_create default_sphere ;; let flippers = dyn_create default_flipper ;; (* |-------------------------------------------------------------------------------------------------------| *) (* kill platform *) dyn_add polygons (create_polygon [|(700, -20); (500, -20); (500, 1); (700, 1)|] 0. 0 255 32 32) ;; (* upper part *) dyn_add polygons (create_polygon [|(500, -200); (700, -200); (700, -250); (500, -250)|] 0. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(500, 800); (500, 1100); (450, 1100); (450, 800)|] 0. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(700, 800); (700, 1100); (750, 1100); (750, 800)|] 0. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(450, 1100); (750, 1100); (750, 1150); (450, 1150)|] 0. 0 32 32 32) ;; (* outer walls *) dyn_add polygons (create_polygon [|(0, -250); (500, -250); (500, 20); (0, 20)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(700, -250); (1200, -250); (1200, 20); (700, 20)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(0, 800); (500, 800); (500, 780); (0, 780)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(700, 800); (1200, 800); (1200, 780); (700, 780)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(1180, 0); (1200, 0); (1200, 800); (1180, 800)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(0, 0); (20, 0); (20, 800); (0, 800)|] 1. 0 32 32 32) ;; (* side ramps *) dyn_add polygons (create_polygon [|(20, 20); (20, 300); (420, 150); (420, 20)|] 1. 0 32 32 32) ;; dyn_add polygons (create_polygon [|(1200, 20); (1200, 300); (780, 150); (780, 20)|] 1. 0 32 32 32) ;; (* starting platform *) dyn_add polygons (create_polygon [|(600, 700); (400, 550); (800, 550)|] 1. 0 32 32 32) ;; (* |-------------------------------------------------------------------------------------------------------| *) (* corner scoring spots *) dyn_add spheres (create_sphere 20 780 30. 1. 50 128 128 32) ;; dyn_add spheres (create_sphere 1180 780 30. 1. 50 128 128 32) ;; (* under the starting platform *) dyn_add spheres (create_sphere 440 550 20. 1. 5 32 128 32) ;; dyn_add spheres (create_sphere 520 550 20. 1. 5 32 192 32) ;; dyn_add spheres (create_sphere 600 550 20. 1. 5 32 255 32) ;; dyn_add spheres (create_sphere 680 550 20. 1. 5 32 192 32) ;; dyn_add spheres (create_sphere 760 550 20. 1. 5 32 128 32) ;; dyn_add spheres (create_sphere 480 450 20. 1. 3 32 156 32) ;; dyn_add spheres (create_sphere 560 450 20. 1. 3 32 220 32) ;; dyn_add spheres (create_sphere 640 450 20. 1. 3 32 220 32) ;; dyn_add spheres (create_sphere 720 450 20. 1. 3 32 156 32) ;; dyn_add spheres (create_sphere 520 350 20. 1. 1 32 192 32) ;; dyn_add spheres (create_sphere 600 350 20. 1. 1 32 255 32) ;; dyn_add spheres (create_sphere 680 350 20. 1. 1 32 192 32) ;; (* left side *) dyn_add spheres (create_sphere 20 480 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 95 555 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 170 630 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 245 705 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 320 780 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 20 630 15. 1. 5 32 32 255) ;; dyn_add spheres (create_sphere 95 705 15. 1. 5 32 32 255) ;; dyn_add spheres (create_sphere 170 780 15. 1. 5 32 32 255) ;; dyn_add spheres (create_sphere 300 300 15. 1. 5 128 128 128) ;; (* right side *) dyn_add spheres (create_sphere 1180 480 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 1105 555 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 1030 630 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 965 705 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 890 780 10. 1. 3 32 32 192) ;; dyn_add spheres (create_sphere 1180 630 15. 1. 5 32 32 255) ;; dyn_add spheres (create_sphere 1105 705 15. 1. 5 32 32 255) ;; dyn_add spheres (create_sphere 1030 780 15. 1. 5 32 32 255) ;; dyn_add spheres (create_sphere 900 300 15. 1. 5 128 128 128) ;; (* on the ramps *) dyn_add spheres (create_sphere 20 300 20. 1. 7 128 128 128) ;; dyn_add spheres (create_sphere 1180 300 20. 1. 7 128 128 128) ;; (* |-------------------------------------------------------------------------------------------------------| *) dyn_add destructible (create_destructible [|(500, 200); (700, 200); (700, 400); (500, 400)|] 1. 10 5 255 255 32) ;; (* |-------------------------------------------------------------------------------------------------------| *) dyn_add flippers (create_flipper Left 420 125 20. 160. (-. 20.) (-. 20.) 20.) ;; dyn_add flippers (create_flipper Right 780 125 20. 160. 200. 160. 200.) ;; (* |-------------------------------------------------------------------------------------------------------| *) simulate polygons destructible spheres flippers ;; (* let create_polygon (arr : (int * int) array) (rest : float) (pts : int) (red : int) (green : int) (blue : int) let create_destructible (arr : (int * int) array) (rest : float) (pts : int) (hitp : int) (red : int) (green : int) (blue : int) let create_sphere (x00 : int) (y00 : int) (radius : float) (rest : float) (pts : int) red green blue let create_flipper (x0 : int) (y0 : int) (rd : float) (len : float) (theta0 : float) (thmin : float) (thmax : float) *) (* ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics -thread -package threads -linkpkg main.ml *)