module Geometry.Intersect
    where
import Geometry.Data
import Control.Applicative

-- | If two lines intersect, return 'Just' that point.
intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectLineLine' #-}
intersectLineLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
    | den == 0 = Nothing
    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
    where 
        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)

-- | If two segments intersect, return 'Just' that point.
intersectSegSeg' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectSegSeg' #-}
intersectSegSeg' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
    | den == 0 = Nothing
    | den > 0 && (t' < 0 || u' < 0 || t' > den || u' > den)
        = Nothing
    | den < 0 && (t' > 0 || u' > 0 || t' < den || u' < den)
        = Nothing
    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
    where 
        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
        u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)

-- | Intended to intersect a segment with a half-line-segment, ie a segment
-- extending infinitely in one direction.
intersectSegLineFrom' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectSegLineFrom' #-}
intersectSegLineFrom' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
    | den == 0 = Nothing
    | den > 0 && ( t' < 0 || u' < 0 || t' > den )
        = Nothing
    | den < 0 && ( t' > 0 || u' > 0 || t' < den )
        = Nothing
    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
    where 
        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
        u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)

-- | Similar to 'intersectSegLineFrom'', but this version is probably not correct...
intersectSegLineext :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectSegLineext #-}
intersectSegLineext (x1,y1) (x2,y2) (x3,y3) (x4,y4)
    | den == 0 = Nothing
    | den > 0 && ( t' < 0 || u' < den || t' > den )
        = Nothing
    | den < 0 && ( t' > 0 || u' > - den || t' < den )
        = Nothing
    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
    where 
        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
        u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)

-- | Intersect a segment with a line.
intersectSegLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectSegLine' #-}
intersectSegLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
    | den == 0 = Nothing
    | den > 0 && (t' < 0 || t' > den)
        = Nothing
    | den < 0 && (t' > 0 || t' < den)
        = Nothing
    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
    where 
        den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
        t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
        u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)

-- | Due to floating point issues, 'intersectSegSeg'' is not always 
-- accurate---'myIntersectSegSeg'
-- fixes at least some of
-- the problem cases by transforming the points into rationals and then doing the
-- intersection.
-- This version is, probably, slower---both testing and benchmarking should be
-- done.
myIntersectSegSeg a@(ax,ay) b@(bx,by) c@(cx,cy) d@(dx,dy) = case ratIntersectLineLine a b c d of
        Nothing    -> Nothing
        Just (x,y) -> if inbetween x && inbetween' y 
                        then Just (x,y)
                        else Nothing
    where inbetween  x = ((ax <= x && x <= bx) || (bx <= x && x <= ax)) &&
                         ((cx <= x && x <= dx) || (dx <= x && x <= cx))
          inbetween' y = ((ay <= y && y <= by) || (by <= y && y <= ay)) &&
                         ((cy <= y && y <= dy) || (dy <= y && y <= cy))

-- | Polymorphic intersection of fractional line points.
myIntersectLineLine :: (Eq a,Fractional a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Maybe (a,a)
myIntersectLineLine a@(ax,ay) b c@(cx,cy) d
    | linGrad a b == Nothing = fmap ((,) ax) $ axisInt (c *-* (ax,0)) (d *-* (ax,0))
    | linGrad c d == Nothing = fmap ((,) cx) $ axisInt (a *-* (cx,0)) (b *-* (cx,0))
    | otherwise              
        = case linGrad a b ^-^ linGrad c d of
            Just 0 -> Nothing
            _      -> liftA2 (,) newx
                                 ((linGrad a b ^*^ newx) ^+^ axisInt a b)
    where (^-^) = liftA2 (-)
          (^+^) = liftA2 (+)
          (^/^) = liftA2 (/)
          (^*^) = liftA2 (*)
          newx  = (axisInt c d ^-^ axisInt a b) ^/^ (linGrad a b ^-^ linGrad c d)
          (*-*) (ax,ay) (bx,by) = (ax-bx,ay-by)

-- | Transforms floating points to rationals then performs line intersection.
ratIntersectLineLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
ratIntersectLineLine a b c d = fmap toNumPoint2 $ myIntersectLineLine (toRatPoint2 a) (toRatPoint2 b) (toRatPoint2 c) (toRatPoint2 d)
    where toRatPoint2 (x,y) = (toRational x, toRational y)
          toNumPoint2 (x,y) = (fromRational x, fromRational y)
          f = toRatPoint2 . roundPoint2

-- | Round the floats within a 'Point2' to the nearest integer.
-- Rounding jumps after intervals of .5:
--
-- >>> roundPoint (0.5,0.5001)
-- (0.0,1.0)
--
-- but is symmetric around 0:
--
-- >>> roundPoint2 (0.5,-0.5)
-- (0.0,0.0)
--
roundPoint2 :: Point2 -> Point2
roundPoint2 (x,y) = (fromIntegral $ round x,fromIntegral $ round y)

-- | Given two points, finds the linear gradient if it is non-infinite.
linGrad :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
linGrad (x,y) (a,b) | x-a == 0  = Nothing
                    | otherwise = Just $ (y-b)/(x-a)

-- | Given two points, finds the intersection with the y axis if it exists.
axisInt :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
axisInt p (a,b) =  pure b ^-^ (pure a ^*^ linGrad p (a,b))
    where (^-^) = liftA2 (-)
          (^*^) = liftA2 (*)

-- | Placeholder, undefined.
intersectSegsSeg :: [Point2] -> Point2 -> Point2 -> Maybe Point2
intersectSegsSeg = undefined

-- | Placeholder: should intersect a segment with a bezier curve.
intersectSegBezquad :: Point2 -> Point2 -> Point2 -> Point2 -> Point2 -> [Point2]
intersectSegBezquad = undefined