Shapes.hs

-- | A very simple physics subsytem. It currently detects shape
-- overlaps only, the actual physics movement is carried out
-- in Yampa itself, as it is very simple using integrals and
-- derivatives.
module Physics.TwoDimensions.Shapes where

import FRP.Yampa.VectorSpace
import Physics.TwoDimensions.Dimensions

import Constants
import Collisions

-- | Side of a rectangle
data Side = TopSide | BottomSide | LeftSide | RightSide
  deriving (Eq,Show)

-- | Opposite side
--
-- If A collides with B, the collision sides on
-- A and B are always opposite.
oppositeSide :: Side -> Side
oppositeSide TopSide    = BottomSide
oppositeSide BottomSide = TopSide
oppositeSide LeftSide   = RightSide
oppositeSide RightSide  = LeftSide

data Shape = Rectangle  Pos2D Size2D -- A corner and the whole size
           | Circle     Pos2D Double -- Position and radius
           | SemiPlane  Pos2D Side   --

-- | Detects if two shapes overlap.
--
-- Rectangles: overlap if projections on both axis overlap,
-- which happens if x distance between centers is less than the sum
-- of half the widths, and the analogous for y and the heights.

overlapShape :: Shape -> Shape -> Bool
overlapShape (Circle p1 s1) (Circle p2 s2) = (dist - (s1 + s2)) < sigma
  where (dx, dy) = p2 ^-^ p1
        dist     = sqrt (dx**2 + dy**2)
        sigma    = 1
overlapShape (Circle (p1x,p1y) s1) (SemiPlane (px,py) side) = case side of
  LeftSide   -> p1x - s1 <= px
  RightSide  -> p1x + s1 >= px
  TopSide    -> p1y - s1 <= py
  BottomSide -> p1y + s1 >= py
overlapShape s@(SemiPlane _ _) c@(Circle _ _) = overlapShape c s
overlapShape r@(Rectangle _ _) c@(Circle _ _) = overlapShape c r
overlapShape (Circle p1 s1)    (Rectangle p2 s2) =
  circleAABBOverlap (p1,s1) (rectangleToCentre (p2,s2))
overlapShape (Rectangle p1 s1) (Rectangle p2 s2) =
  overlapsAABB2 (rectangleToCentre (p1, s1)) (rectangleToCentre (p2, s2))
overlapShape (Rectangle p1 s1) (SemiPlane p2 side2) =
  let (p2', s2') = semiplaneRectangle p2 side2
  in overlapsAABB2 (rectangleToCentre (p1, s1)) (rectangleToCentre (p2', s2'))
overlapShape p@(SemiPlane _ _) r@(Rectangle _ _) = overlapShape r p
overlapShape _                 _                 = False -- Not really, it's just that we don't care

semiplaneRectangle :: Pos2D -> Side -> (Pos2D, (Double, Double))
semiplaneRectangle p2 s2 =  case s2 of
  LeftSide   -> (p2 ^-^ (100, 100), (100,   height + 200))
  RightSide  -> (p2 ^-^ (0,   100), (100,   height + 200))
  TopSide    -> (p2 ^-^ (100, 100), (width + 200, 100))
  BottomSide -> (p2 ^-^ (100,   0), (width + 200, 100))

rectangleToCentre ((px, py), (sw, sh)) = ((px + (sw / 2), py + (sh / 2)), (sw / 2, sh / 2))