{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Geometry.Triangle where
import Data.Bifunctor
import Control.Lens
import Data.Ext
import Data.Geometry.Point
import Data.Geometry.Vector
import Data.Geometry.Ball
import Data.Geometry.Properties
import Data.Geometry.Transformation
import GHC.TypeLits
data Triangle d p r = Triangle (Point d r :+ p)
(Point d r :+ p)
(Point d r :+ p)
deriving instance (Arity d, Show r, Show p) => Show (Triangle d p r)
instance Arity d => Functor (Triangle d p) where
fmap f (Triangle p q r) = let f' = first (fmap f) in Triangle (f' p) (f' q) (f' r)
type instance NumType (Triangle d p r) = r
type instance Dimension (Triangle d p r) = d
instance PointFunctor (Triangle d p) where
pmap f (Triangle p q r) = Triangle (p&core %~ f) (q&core %~ f) (r&core %~ f)
instance (Fractional r, Arity d, Arity (d + 1)) => IsTransformable (Triangle d p r) where
transformBy = transformPointFunctor
area :: Fractional r => Triangle 2 p r -> r
area t = doubleArea t / 2
doubleArea :: Num r => Triangle 2 p r -> r
doubleArea (Triangle a b c) = abs $ ax*by - ax*cy
+ bx*cy - bx*ay
+ cx*ay - cx*by
where
Point2 ax ay = a^.core
Point2 bx by = b^.core
Point2 cx cy = c^.core
inscribedDisk :: (Eq r, Fractional r)
=> Triangle 2 p r -> Maybe (Disk () r)
inscribedDisk (Triangle p q r) = disk (p^.core) (q^.core) (r^.core)