scrambler/main_test.ml

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 ;;

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 sphere = {
  center : pt_2d ;
  radius : float ;
  rgb : int ;
  xmin : float ;
  xmax : float ;
  ymin : float ;
  ymax : float ;
  mutable restitution : float ;
  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 ;
} ;;

let default_sphere = {
  center = {x = 0. ; y = 0.} ;
  rgb = 0 ;
  radius = -. 1. ;
  xmin = 1. ;
  xmax = -. 1. ;
  ymin = 1. ;
  ymax = -. 1. ;
  restitution = 0. ;
  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_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 update_ball_data (b : ball) (polys : polygon array) (spheres : sphere array) (flips : flipper dynamic) (dt : float) =
  b.fres.x <- 0. ;
  b.fres.y <- 0. ;

  for p = 0 to (Array.length polys -1) do
    let (hitarr, hitlen) = (is_collision_p b polys.(p) dt) in
    if hitlen > 0 then begin
      for h = 0 to hitlen -1 do
        let hit = hitarr.(h) in
        score := !score + polys.(p).score ;

        if h = 0 && polys.(p).score > 0 then
          playbeep () ;
        if polys.(p).restitution = 0. then begin
          b.active <- false ;
          decr remaining ;
        end;

        (* apply normal reaction force *)
        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 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.(p).restitution /. float_of_int hitlen ;
          b.fres.y <- b.fres.y +. reaction_force_2.y *. polys.(p).restitution /. float_of_int hitlen ;
        end;

        (* change velocity according to angle *)
        if hitlen = 1 then begin
          let director = vect_diff_2D polys.(p).vertexes.(hit2) polys.(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 s = 0 to (Array.length spheres -1) do
    if is_collision_s b spheres.(s) dt then begin
      score := !score + spheres.(s).score ;

      if spheres.(s).score > 0 then
        playbeep () ;
      if spheres.(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.(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.(s).restitution *. 1.1 ;
        b.fres.y <- b.fres.y +. reaction_force_2.y *. spheres.(s).restitution *. 1.1 ;
      end;

      (* 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 ;

  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 [disabled for physical reasons] *)
        if false && ((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.5 *. b.v.x +. flips.tab.(f).dtheta *. 3.14159 /. 180. *. (vect_dist_2D flips.tab.(f).xy b.xy) *. (cos (flips.tab.(f).theta *. 3.14159 /. 180.));
          b.v.y <- 0.5 *. b.v.y +. flips.tab.(f).dtheta *. 3.14159 /. 180. *. (vect_dist_2D flips.tab.(f).xy b.xy) *. (sin (flips.tab.(f).theta *. 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 ;;

let update_balls (bl : ball array) (polys : polygon array) (spheres : sphere array) (flips : flipper dynamic) (dt : float) =
  for b = 0 to Array.length bl -1 do
    if bl.(b).active then
      update_ball_data bl.(b) polys spheres flips dt
  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 = flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt in
        if theta_dt > flips.tab.(fl).agmax then
          flips.tab.(fl).dtheta <- -.(flips.tab.(fl).dtheta) ;

        if theta_dt < flips.tab.(fl).agmin then
          flips.tab.(fl).dtheta <- 0. ;

        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 = flips.tab.(fl).theta +. flips.tab.(fl).dtheta *. dt in
        if theta_dt > flips.tab.(fl).agmax then
          flips.tab.(fl).dtheta <- 0. ;

        if theta_dt < flips.tab.(fl).agmin then
          flips.tab.(fl).dtheta <- -.(flips.tab.(fl).dtheta) ;

        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, 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_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_flipper (f : flipper) =
  set_color (rgb 64 64 64) ;
  fill_circle (int_of_float f.xy.x) (int_of_float f.xy.y) (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) (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) ;;

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_flippers (flips : flipper dynamic) =
  match get1char_plus () with
    | 'q' -> 
      for fl = 0 to flips.len -1 do
        if flips.tab.(fl).side = Left && flips.tab.(fl).dtheta = 0. then
          flips.tab.(fl).dtheta <- 600. ;
      done
    | 'd' -> 
      for fl = 0 to flips.len -1 do
        if flips.tab.(fl).side = Right && flips.tab.(fl).dtheta = 0. then
          flips.tab.(fl).dtheta <- -. 600. ;
      done
    | _ -> () ;;

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 (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 ;
  } ;;

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 ;
  } ;;

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 ;
          } ;
          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) (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 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.tab dats.tab flips (__end -. __start) ;
    update_flippers flips (__end -. __start) ;
  done;

  close_graph () ;;

let polygons = 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) ;;

(* outer walls *)
dyn_add polygons (create_polygon [|(0, 0); (500, 0); (500, 20); (0, 20)|] 1. 0 32 32 32) ;;
dyn_add polygons (create_polygon [|(700, 0); (1200, 0); (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 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 spheres flippers ;;
(* 
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) 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 *)