中心点の座標を持つ二つの図形(点、正方形、長方形、円)が重なりを持つかどうか判定する

gistfile1.ml

type figure =
    Point
  | Circle of float
  | Rectangle of  float * float
  | Square of float;;

type 'a with_location = { loc_x: float; loc_y: float; body: 'a };;


let diff x y =  abs_float (x -. y)

let distance (x1, y1) (x2, y2) = sqrt ((x1 -. x2) ** 2. +. (y1 -. y2) ** 2.);;

let overlap_rect_rect (x1, y1) (x2, y2) w h =
  diff x1 x2 <= w /. 2. && diff y1 y2 <= h /. 2.;;

let overlap_circle_rect (x1, y1, r) (x2, y2, w, h) =
  let w' = w /. 2.
  and h' = h /. 2. in
    if      diff x1 x2 <= w' then diff y1 y2 <= h' +. r
    else if diff y1 y2 <= h' then diff x1 x2 <= w' +. r
    else List.exists
      (fun (dx, dy) -> distance (x1, y1) (x2 +. dx, y2 +. dy) <= r)
      [(w', h'); (-.w', h'); (w', -.h'); (-.w', -.h')]

let overlap { loc_x = x1; loc_y = y1; body = a }
            { loc_x = x2; loc_y = y2; body = b } =
  match (a, b) with
      (Point, Point) ->
        overlap_rect_rect (x1, y1) (x2, y2) 0. 0.
    | (Point, Square n) | (Square n, Point) ->
        overlap_rect_rect (x1, y1) (x2, y2) n n
    | (Point, Rectangle (w, h)) | (Rectangle (w, h), Point) ->
        overlap_rect_rect (x1, y1) (x2, y2) w h
    | (Square n1, Square n2) ->
        overlap_rect_rect (x1, y1) (x2, y2) (n1 +. n2) (n1 +. n2)
    | (Rectangle (w, h), Square n) | (Square n, Rectangle (w, h)) ->
        overlap_rect_rect (x1, y1) (x2, y2) (w +. n) (h +. n)
    | (Rectangle (w1, h1), Rectangle (w2, h2)) ->
        overlap_rect_rect (x1, y1) (x2, y2) (w1 +. w2) (h1 +. h2)

    | (Point, Circle r) | (Circle r, Point) -> distance (x1, y1) (x2, y2) <= r
    | (Circle r1, Circle r2)                -> distance (x1, y1) (x2, y2) <= r1 +. r2

    | (Circle r, Square n)         -> overlap_circle_rect (x1, y1, r) (x2, y2, n, n)
    | (Square n, Circle r)         -> overlap_circle_rect (x2, y2, r) (x1, y1, n, n)
    | (Circle r, Rectangle (w, h)) -> overlap_circle_rect (x1, y1, r) (x2, y2, w, h)
    | (Rectangle (w, h), Circle r) -> overlap_circle_rect (x2, y2, r) (x1, y1, w, h)