{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.LineSegment
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Line segment data type and some basic functions on line segments
--
--------------------------------------------------------------------------------
module Data.Geometry.LineSegment
  ( LineSegment(LineSegment, LineSegment', ClosedLineSegment, OpenLineSegment)
  , endPoints

  , _SubLine
  , module Data.Geometry.Interval

  , toLineSegment
  , orderedEndPoints
  , segmentLength
  , sqSegmentLength
  , sqDistanceToSeg, sqDistanceToSegArg
  , flipSegment

  , interpolate, sampleLineSegment
  , ordAtX, ordAtY, xCoordAt, yCoordAt
  ) where

-- import           Control.Lens
import           Data.Ext
-- import qualified Data.Foldable as F
import           Data.Geometry.Boundary
import           Data.Geometry.Box.Internal
import           Data.Geometry.Box.Sides
import           Data.Geometry.Interval hiding (width, midPoint)
import           Data.Geometry.LineSegment.Internal
import           Data.Geometry.Point
import           Data.Geometry.Properties
-- import           Data.Geometry.SubLine
import           Data.Util
-- import           Data.Vinyl.CoRec
-- import           Data.Bifunctor
-- import           Data.Either
-- import           Data.Maybe (mapMaybe)



--------------------------------------------------------------------------------


type instance IntersectionOf (LineSegment 2 p r) (Boundary (Rectangle q r)) =
  [ NoIntersection, Point 2 r, Two (Point 2 r) , LineSegment 2 () r ]


type instance IntersectionOf (LineSegment 2 p r) (Rectangle q r) =
  [ NoIntersection, Point 2 r, LineSegment 2 (Maybe p) r ]

instance (Fractional r, Ord r)
         => LineSegment 2 p r `HasIntersectionWith` Boundary (Rectangle q r) where
  LineSegment 2 p r
seg intersects :: LineSegment 2 p r -> Boundary (Rectangle q r) -> Bool
`intersects` (Boundary Rectangle q r
rect) = (LineSegment 2 q r -> Bool) -> Sides (LineSegment 2 q r) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LineSegment 2 p r
seg LineSegment 2 p r -> LineSegment 2 q r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects`) (Sides (LineSegment 2 q r) -> Bool)
-> Sides (LineSegment 2 q r) -> Bool
forall a b. (a -> b) -> a -> b
$ Rectangle q r -> Sides (LineSegment 2 q r)
forall r p. Num r => Rectangle p r -> Sides (LineSegment 2 p r)
sides Rectangle q r
rect

instance (Fractional r, Ord r) => LineSegment 2 p r `HasIntersectionWith` Rectangle q r where
  seg :: LineSegment 2 p r
seg@(LineSegment EndPoint (Point 2 r :+ p)
p EndPoint (Point 2 r :+ p)
q) intersects :: LineSegment 2 p r -> Rectangle q r -> Bool
`intersects` Rectangle q r
rect =
      EndPoint (Point 2 r :+ p) -> Bool
inRect EndPoint (Point 2 r :+ p)
p Bool -> Bool -> Bool
|| EndPoint (Point 2 r :+ p) -> Bool
inRect EndPoint (Point 2 r :+ p)
q Bool -> Bool -> Bool
|| (LineSegment 2 q r -> Bool) -> Sides (LineSegment 2 q r) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LineSegment 2 p r
seg LineSegment 2 p r -> LineSegment 2 q r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects`) (Rectangle q r -> Sides (LineSegment 2 q r)
forall r p. Num r => Rectangle p r -> Sides (LineSegment 2 p r)
sides Rectangle q r
rect) Bool -> Bool -> Bool
|| LineSegment 2 p r -> Bool
bothOpenAndOnBoundary LineSegment 2 p r
seg
    where
      inRect :: EndPoint (Point 2 r :+ p) -> Bool
inRect = \case
        Open   (Point 2 r
a :+ p
_) -> Point 2 r
a Point 2 r -> Rectangle q r -> Bool
forall (d :: Nat) r p.
(Arity d, Ord r) =>
Point d r -> Box d p r -> Bool
`insideBox`  Rectangle q r
rect -- if strictly inside the seg intersects.
        Closed (Point 2 r
a :+ p
_) -> Point 2 r
a Point 2 r -> Rectangle q r -> Bool
forall (d :: Nat) r p.
(Arity d, Ord r) =>
Point d r -> Box d p r -> Bool
`inBox`      Rectangle q r
rect -- in or on the boundary is fine

      -- if somehow the segment is open, and both endpoints lie on
      -- different sides of the boundary, (so the segment crosses the
      -- interior) it also intersects. Handle that case.
      bothOpenAndOnBoundary :: LineSegment 2 p r -> Bool
bothOpenAndOnBoundary (LineSegment (Open Point 2 r :+ p
_) (Open Point 2 r :+ p
_)) =
        r -> LineSegment 2 p r -> Point 2 r
forall r (d :: Nat) p.
(Fractional r, Arity d) =>
r -> LineSegment d p r -> Point d r
interpolate (r
1r -> r -> r
forall a. Fractional a => a -> a -> a
/r
2) LineSegment 2 p r
seg Point 2 r -> Rectangle q r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Rectangle q r
rect
      bothOpenAndOnBoundary LineSegment 2 p r
_                               = Bool
False

-- instance (Num r, Ord r)
--          => (LineSegment 2 p r) `IsIntersectableWith` (Boundary (Rectangle q r)) where
--   seg `intersect` (Boundary rect) = case partitionEithers res of
--     (s : _, _)    -> coRec s -- if we find a segment that should be the
--                              -- answer; we shouldn't fine more than one
--                              -- by the way.
--     ([], [])      -> coRec  NoIntersection
--     ([], [p])     -> coRec p
--     ([], (p:q:_)) -> coRec $ Two p q
--                      -- more than two points is impossible anwyay
--     where
--       res = mapMaybe (\side -> match (seg `intersect` side) $
--                        (H $ \NoIntersection            -> Nothing)
--                     :& (H $ \(p :: Point 2 r)          -> Just $ Right p)
--                     :& (H $ \(s :: LineSegment 2 () r) -> Just $ Left s)
--                     :& RNil
--              ) . F.toList $ sides rect



-- -- instance (Num r, Ord r) => (LineSegment 2 p r) `IsIntersectableWith` (Rectangle q r) where
-- --   seg@(LineSegment' (p :+ _) (q :+ _)) `intersect` rect =
-- --       case (p `intersects` rect, q `intersects` rect) of
-- --         (True,True)   -> coRec seg'
-- --         (False,False) -> match boundaryIntersection $ -- both endpoints outside
-- --              (H $ \NoIntersection   -> coRec NoIntersection)
-- --           :& (H $ \(a :: Point 2 r) -> coRec a)
-- --           :& (H $ \(Two a b)        -> coRec $ ClosedLineSegment (ext a) (ext b))
-- --           :& (H $ \s                -> coRec s)
-- --           :& RNil
-- --         (True,False)  -> withInside p (\other -> LineSegment p' (closed other))
-- --         (False,True)  -> withInside q (\other -> LineSegment (closed other) q')
-- --     where
-- --       seg'@(LineSegment p' q') = first (const ()) seg

-- --       boundaryIntersection = seg `intersect` (Boundary rect)
-- --       closed :: Point 2 r -> EndPoint (Point 2 r :+ ())
-- --       closed = Closed . ext

-- --       -- the given endpoint endPt is inside the box [*], while the
-- --       -- other endpoint is not. The second arg is a function that
-- --       -- rebuilds the segment given the replacement endpoint, compute
-- --       -- the right segment that is inside the rectangle.
-- --       --
-- --       -- [*] We require that the *point* lies in or on the box. If the
-- --       -- endpoint was open, it may still be the case that we do not
-- --       -- actually intersect the rectangle (i.e. if the open endPoint
-- --       -- was on a corner of the rect).
-- --       -- withInside                      :: Point 2 r
-- --       --                                 -> (Point 2 r -> LineSegment 2 () r)
-- --       --                                 -> IntersectionOf ....
-- --       withInside endPt mkSeg = match boundaryIntersection $
-- --            (H $ \NoIntersection   -> coRec NoIntersection)
-- --            -- seems this should happen only if the endpoint that was
-- --            -- suposedly in/on the rect was open.
-- --         :& (H $ \(a :: Point 2 r) -> coRec . mkSeg $ a)
-- --         :& (H $ \(Two a b)        -> coRec . mkSeg $ if a == endPt then b else a)
-- --         :& (H $ \s                -> coRec s)
-- --         :& RNil