{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PatternSynonyms #-}
module Geography.VectorTile.Geometry
(
Point(..)
, LineString(..)
, Polygon(..)
, area
, surveyor
) where
import Control.DeepSeq (NFData)
import Data.Foldable (foldl')
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import Foreign.Storable
import GHC.Generics (Generic)
data Point = Point { x :: !Int, y :: !Int } deriving (Eq, Show, Generic)
instance Semigroup Point where
Point x0 y0 <> Point x1 y1 = Point (x0 + x1) (y0 + y1)
{-# INLINE (<>) #-}
instance Monoid Point where
mempty = Point 0 0
mappend = (<>)
instance Storable Point where
sizeOf _ = 16
alignment _ = 8
peek p = Point <$> peekByteOff p 0 <*> peekByteOff p 8
poke p (Point a b) = pokeByteOff p 0 a *> pokeByteOff p 8 b
instance NFData Point
newtype LineString = LineString { lsPoints :: VS.Vector Point } deriving (Eq, Show, Generic)
instance NFData LineString
data Polygon = Polygon { polyPoints :: !(VS.Vector Point)
, inner :: !(V.Vector Polygon) } deriving (Eq, Show, Generic)
instance NFData Polygon
area :: Polygon -> Double
area p = surveyor (polyPoints p) + foldl' (\acc i -> acc + area i) 0 (inner p)
surveyor :: VS.Vector Point -> Double
surveyor v = (/ 2) . fromIntegral . VS.foldl' (+) 0 $ VS.zipWith3 (\xn yn yp -> xn * (yn - yp)) xs yns yps
where v' = VS.init v
xs = VS.map x v'
yns = VS.map y . VS.tail $ VS.snoc v' (VS.head v')
yps = VS.map y . VS.init $ VS.cons (VS.last v') v'