   [OCaml] Collision detection
  This might be useful to someone - and if it isn't, it might still end up being fun to look at and toy with. Below is the complete (one-file) source code to a collsion detection system and tech demo in Objective Caml. It is as documented as possible - from the code point of view, at least, because it does assume some prior knowledge of the mathematics behind it.Don't forget to link with graphics.cma. The circle follows the mouse, 'q' to quit, 'l' and 's' to make the window larger/smaller.(** Collision detection, Part I    Circle-circle, circle-line and circle-box collisions.    @author Victor Nicollet    @version 1.0 *)  open Graphics;;(** Raised when no collision will ever take place between two    objects. *)exception NoCollision;;(** Raised in subfunctions when a collision cannot take    place; *)exception NoSubCollision;;let vdot (ax,ay) (bx,by) = (ax*.bx+.ay*.by);;let vmin (ax,ay) (bx,by) = (ax-.bx),(ay-.by);;let vadd (ax,ay) (bx,by) = (ax+.bx),(ay+.by);;let vsca (k) (ax,ay) = (k*.ax),(k*.ay);;let vort (ax,ay) = (-.ay,ax);;let vnorm (a) =  let r = vdot a a in  if r <= 0. then a else vsca (1. /. (sqrt r)) a;;(** Compute the parameter of the collision between a circle    and a ray.    @param  p Circle center.    @param  r Circle radius.    @param  a Ray origin.    @param  v Ray direction (not normalized)    @return The time of first contact.    @raise  NoCollision if there is no contact in the future. *)let rayCircleContact (p) (r) (a) (v) =    let p = vmin a p in  let sq x = x *. x in    (* a = vx² + vy² *)  (* b = px.vx + py.vy --- b_h = b/2 *)  (* c = px² + py² - r² *)    let a = vdot v v in  let b_h = vdot p v in  let c = vdot p p -. (sq r) in    (* det = b² - 4ac --- det_f = det/4 *)    let det_f = (sq b_h) -. a *. c in    if det_f < 0. then raise NoCollision;    (* d = sqrt( det ) --- d_ha = d/2a *)  (* m = - b/2a *)    let d_ha = (sqrt det_f) /. a in    let m = -. b_h /. a in  (* t = - (b + d) / 2a *)    let t = (m -. d_ha) in  if t > 0. then t else raise NoCollision;;    (** Compute the first tangential contact time for a circle-segment    system.    @param  p The initial (x,y) position of the circle.    @param  vC The velocity of the circle.    @param  r The radius of the circle.    @param  a An end of the segment.    @param  b Another end of the segment.    @param  vS The velocity of the segment.    @param  n The normal vector of the segment.@return The first time in the future when collision occurs.    @raise  NoCollision if there is no contact in the future. *)let circleSegmentContact (p) (vC) (r) (a) (b) (vS) (n) =    let d = vdot (vmin p a) n in    let v = vmin vS vC in (* Situation where the line touches the circle *)  trylet (ad,n) = if d > 0. then (d,n) else (-. d),(vsca (-1.) n) in    let v_n = vdot v n in   (* line is not moving towards circle : no collision can  occur. *)    if v_n < 0. then raise NoSubCollision;    (* line already intersects circle: consider edges *)    if v_n = 0. || ad < r then raise NoSubCollision;let c = vadd p (vsca (-.r) n) in    let vo = vort v in    let det = (vdot vo (vmin c a)) *. (vdot vo (vmin c b)) in   (* the segment does not touch: only the edges might. *)    if det > 0. then raise NoSubCollision;   (ad -. r) /. v_n (* situation where the ends touch the circle *)    with NoSubCollision ->  try  let m1 = rayCircleContact (p) (r) (a) (v) in    try  let m2 = rayCircleContact (p) (r) (b) (v) in if m1 > m2 then m2 else m1with NoCollision -> m1  with NoCollision ->    rayCircleContact (p) (r) (b) (v);;(** Compute the first tangential contact time for a two-circle    system.@param  pA The initial (x,y) position of the first circle.    @param  vA The velocity of the first circle.    @param  rA The radius of the first circle.    @param  pB The position of the second circle.    @param  vB The velocity of the second circle.    @param  rB The radius of the second circle.    @return The first time in the future when collision occurs.    @raise  NoCollision If there is no contact in the future. *)let circleCircleContact (pA) (vA) (rA) (pB) (vB) (rB) =  let p = vmin pA pB in  let v = vmin vA vB in  let r = rA +. rB in    rayCircleContact (0.0,0.0) (r) (p) (v);;  (** Raised when the interactive demonstration should exit. *)exception Quit;;(** Creates a random circle on the screen *)let makeCircle ( ) =  let x = Random.float 1.0   and y = Random.float 1.0  and r = 0.001 +. (Random.float 0.099)  in    (x,y,r)  (** Creates a random segment on the screen *)let makeSegment ( ) =  let a = (Random.float 0.8),(Random.float 0.8)  in  let b = vmin a ((Random.float 0.2),(Random.float 0.2)) in (a,b,vnorm(vort(vmin b a)))  (** Scaling function, transforms device-independent coordinates    into screen coordinates. *)let scale (x) =   int_of_float (x *. (float_of_int (Graphics.size_x( ))))  (** Unscaling function, reverses the scaling function. *)let unscale (x) =  (float_of_int x) /. (float_of_int (Graphics.size_x( )))  (** Demonstration applet, manipulates the world state and renders    collision detection results. *)class applet = object (self)    (** The list of circles that can be collided with *)  val mutable circles = []    (** The list of lines that can be collided with *)  val mutable lines = []    (** The width of the screen *)  val mutable width = 400    (** The center of the circle *)  val mutable center = (0.5,0.5)    (** Compute the results of collisions using the marked  velocity vector. *)  method use (x:int) (y:int) =  let radius = 0.04 in set_color (black);    moveto (scale (fst center)) (scale (snd center));    lineto (x) (y); (* render circle obstacles *)    set_color (rgb 64 64 128);    List.iter  (fun ((xa,ya),(xb,yb),(xn,yn)) ->    moveto (scale xa) (scale ya);   lineto (scale xb) (scale yb);   set_color (rgb 0 255 0);   set_line_width 1;   rlineto (scale (xn/.10.)) (scale (yn/.10.));   set_line_width 2;   set_color (rgb 64 64 128)) (lines);    List.iter (fun (x,y,r) -> fill_circle (scale x) (scale y) (scale r)) (circles);    set_color (rgb 128 96 64);    List.iter (fun (x,y,r) -> draw_circle (scale x) (scale y) (scale r)) (circles);(* prepare for obstacle finding *) let x = (unscale x) -. (fst center) and y = (unscale y) -. (snd center) in    let x = x /. 100. and y = y /. 100. inlet at (time) = draw_circle (scale ((fst center) +. time *. x)) (scale ((snd center) +. time *. y)) (1+(scale radius))    in  (* render obstacle hits *)    set_color (black);    at (0.);    set_line_width 1;    set_color (rgb 255 128 128);   let collide = ref false in    List.iter (fun (xb,yb,rb) ->   try let first = (circleCircleContact  ((fst center),(snd center)) (x,y) (radius)  (xb,yb) (0.0,0.0) (rb)) in at(first); if first < 1.0 then collide := true;   with NoCollision -> ( )) (circles);List.iter (fun (a,b,n) ->   try let first = (circleSegmentContact  (center) (x,y) (radius)  (a) (b) (0.0,0.0) (n)) in at(first); if first < 1.0 then collide := true;   with NoCollision -> ( )) (lines);if not !collide then center <- ((fst center)+.x),((snd center)+.y);synchronize ( );    clear_graph ( )    (** Initialization: creates a graph window and sets up at random the colliding objects. *)  method initialize =    close_graph ( );    open_graph ((string_of_int width)^"x"^(string_of_int width));    auto_synchronize false;    set_line_width 2;    self # randomize    (** Randomizes circles available on the field *)  method randomize =    let rec c n = if n < 1 then [] else (makeCircle( ))::(c (n-1)) in    circles <- c 10;    let rec c n = if n < 1 then [] else (makeSegment( ))::(c (n-1)) in    lines <-((1.0,1.0),(0.0,1.0),(0.0,1.0))    ::((1.0,1.0),(1.0,0.0),(1.0,0.0))    ::((0.0,0.0),(0.0,1.0),(1.0,0.0))    ::((0.0,0.0),(1.0,0.0),(0.0,1.0))    ::(c 10)(** Initialize, then start the interactive interface *)  method run =    self # initialize;    self # use (0) (0);    try self # loop with Quit -> ( )    (** Interactive interface: follows the mouse and expects a key press.   'r' : randomize the circles on the screen. 'l' : enlarge screen 's' : reduce screen 'q' : quits the program. *)    method loop =    if key_pressed ( ) then begin let key = read_key ( ) in if key = 'q' then    raise Quitelse if key = 'r' then    self # randomize else if key = 'l' then   (width <- width + 100; self # initialize) else if key = 's' && width > 100 then   (width <- width - 100; self # initialize) else ( )    end   else begin let (x,y) = mouse_pos ( ) in self # use x y;    end;   self # loopend (* Run the interactive system *)let _ =  try (new applet) # run with _ -> ( )
  Extremely cool! Perfect timing! Did you get my PM?   