open Graphics

type vec = { x : float; y : float }
type obj = { pos : vec; vel : vec; col : color }

let gravity = 100.

let maxX = 300.
let minX = 0.

let eps    = 0.000001
let radius = 10.0

let margin = eps +. radius 

let one_step objs tm = 
  let f obj = 
    let tmp = { obj with 
		  pos = {  x = obj.pos.x +. tm *. obj.vel.x;
			   y = obj.pos.y +. tm *. obj.vel.y};
		  vel = { obj.vel with y = 0.9999 *. obj.vel.y -. tm *. gravity } } in 
    let vel = 
      if tmp.pos.x <= minX +. margin && tmp.vel.x <= eps then 
	{ tmp.vel with x = -. tmp.vel.x } 
      else if tmp.pos.x >= maxX -. margin && tmp.vel.x >= eps then 
	{ tmp.vel with x = -. tmp.vel.x } 
      else 
	tmp.vel 
    in 
    let vel =
      if tmp.pos.y <= margin && vel.y <= eps then 
	{ vel with y = -. vel.y} 
      else 
	vel in 
      { tmp with vel = vel } in 
    List.map f objs 

let draw_obj obj =
  let x = int_of_float obj.pos.x in 
  let y = int_of_float obj.pos.y in 
  let c = obj.col in 
    (set_color c;
     fill_circle x y (int_of_float radius))

let _ = Random.self_init ()

let rand_ball () = 
  { pos = {x = Random.float maxX; y = 150. +. Random.float 150.};
    vel = {x = -. 20. +. Random.float 40.; y = 0. };
    col = Random.int 0xffffff }

let rec upto n = 
  if n < 0 then []
  else n::upto (n-1)

let balls = List.map (fun _ -> rand_ball ()) (upto 20)

(* Unix.select [] [] [] b の代用 *)
let rec busy_wait b =
  let start = Sys.time () in 
  let rec f () = 
    if Sys.time () -. start > b then 
      ()
    else 
      f () in 
    f ()

let steps n balls diff =
  let fdiff = diff /. (float_of_int n) in
  let rec f n balls = 
    if n = 0 then balls
    else          f (n-1) (one_step balls fdiff) in
    f n balls 

let rec loop prevTime balls = 
  begin 
    let cur   = Sys.time () in 
    let diff  = cur -. prevTime in 
    let balls = steps 4 balls diff in 
      clear_graph ();
      List.map draw_obj balls;      
      synchronize ();
      (* Unix.system ("sleep 0.01"); *)
      busy_wait 0.032; 
      loop cur balls
  end 


let start () =
  clear_graph ();
  auto_synchronize false;
  loop (Sys.time()) balls