{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Geometry.HyperPlane where
import Control.DeepSeq
import Control.Lens
import Data.Geometry.Line
import Data.Geometry.Point
import Data.Geometry.Properties
import Data.Geometry.Transformation
import Data.Geometry.Vector
import GHC.Generics (Generic)
import GHC.TypeLits
data HyperPlane (d :: Nat) (r :: *) = HyperPlane { _inPlane :: !(Point d r)
, _normalVec :: !(Vector d r)
} deriving Generic
makeLenses ''HyperPlane
type instance Dimension (HyperPlane d r) = d
type instance NumType (HyperPlane d r) = r
deriving instance (Arity d, Show r) => Show (HyperPlane d r)
deriving instance (Arity d, Eq r) => Eq (HyperPlane d r)
deriving instance (NFData r, Arity d) => NFData (HyperPlane d r)
deriving instance Arity d => Functor (HyperPlane d)
deriving instance Arity d => Foldable (HyperPlane d)
deriving instance Arity d => Traversable (HyperPlane d)
instance (Arity d, Arity (d + 1), Fractional r) => IsTransformable (HyperPlane d r) where
transformBy t (HyperPlane p v) = HyperPlane (transformBy t p) (transformBy t v)
onHyperPlane :: (Num r, Eq r, Arity d)
=> Point d r -> HyperPlane d r -> Bool
q `onHyperPlane` (HyperPlane p n) = n `dot` (q .-. p) == 0
type Plane = HyperPlane 3
pattern Plane :: Point 3 r -> Vector 3 r -> Plane r
pattern Plane p n = HyperPlane p n
from3Points :: Num r => Point 3 r -> Point 3 r -> Point 3 r -> HyperPlane 3 r
from3Points p q r = let u = q .-. p
v = r .-. p
in HyperPlane p (u `cross` v)
type instance IntersectionOf (Line 3 r) (Plane r) = [NoIntersection, Point 3 r, Line 3 r]
instance (Eq r, Fractional r) => (Line 3 r) `IsIntersectableWith` (Plane r) where
nonEmptyIntersection = defaultNonEmptyIntersection
l@(Line p v) `intersect` (HyperPlane q n)
| denum == 0 = if num == 0 then coRec l else coRec NoIntersection
| otherwise = coRec $ p .+^ (num / denum) *^ v
where
num = (q .-. p) `dot` n
denum = v `dot` n
class HasSupportingPlane t where
supportingPlane :: t -> HyperPlane (Dimension t) (NumType t)
instance HasSupportingPlane (HyperPlane d r) where
supportingPlane = id