{-# LANGUAGE FlexibleInstances #-}
module Data.Geometry.Geos.Raw.CoordSeq (
CoordinateSequence (..)
, CoordSeqConst (CoordSeqConst)
, CoordSeq (CoordSeq)
, getCoordinateSequenceX
, getCoordinateSequenceY
, getCoordinateSequenceZ
, getCoordinateSequenceSize
, getCoordinateSequenceDimensions
, setCoordinateSequenceX
, setCoordinateSequenceY
, setCoordinateSequenceZ
, setCoordinateSequenceOrd
) where
import qualified Data.Geometry.Geos.Raw.Internal as I
import Data.Geometry.Geos.Raw.Base
import Foreign
import Foreign.C.Types
import Control.Monad
class CoordinateSequence a where
withCoordinateSequence :: a -> (Ptr I.GEOSCoordSequence -> IO b) -> IO b
createEmptyCoordinateSequence :: Int -> Int -> Geos a
createCoordinateSequence :: Ptr I.GEOSCoordSequence -> Geos a
newtype CoordSeq = CoordSeq {
_unCoordSeq :: ForeignPtr I.GEOSCoordSequence
}
newtype CoordSeqConst = CoordSeqConst {
_unCoordSeqConst :: Ptr I.GEOSCoordSequence
}
instance Eq CoordSeq where
(==) = coordSeqEq
instance Eq CoordSeqConst where
(==) = coordSeqEq
coordSeqEq :: CoordinateSequence a => a -> a -> Bool
coordSeqEq a b = runGeos $ do
sa <- getCoordinateSequenceSize a
sb <- getCoordinateSequenceSize b
da <- getCoordinateSequenceDimensions a
db <- getCoordinateSequenceDimensions b
if (sa == sb) && (da == db)
then foldM (comp (da == 3)) True [0..(sa-1)]
else return False
where
comp zdim acc i = do
xa <- getCoordinateSequenceX a i
ya <- getCoordinateSequenceY a i
xb <- getCoordinateSequenceX b i
yb <- getCoordinateSequenceY b i
zd <- if zdim
then do
za <- getCoordinateSequenceZ a i
zb <- getCoordinateSequenceZ b i
return $ za == zb
else return True
return $ (xa == xb) && (ya == yb) && acc && zd
instance Show CoordSeq where
show = coordSeqShow
instance Show CoordSeqConst where
show = coordSeqShow
coordSeqShow :: CoordinateSequence a => a -> String
coordSeqShow a = runGeos $ do
sa <- getCoordinateSequenceSize a
unlines `fmap` mapM show' [0..(sa-1)]
where
show' i = do
xa <- getCoordinateSequenceX a i
ya <- getCoordinateSequenceY a i
return . show $ (xa, ya)
instance CoordinateSequence CoordSeq where
withCoordinateSequence (CoordSeq fp) f = withForeignPtr fp f
createEmptyCoordinateSequence size dim = do
ptr <- withGeos $ \h ->
throwIfNull "createEmptyCoordinateSequence" $ I.geos_CoordSeqCreate h (fromIntegral size) (fromIntegral dim)
createCoordinateSequence ptr
createCoordinateSequence ptr = withGeos $ \h -> do
fptr <- newForeignPtrEnv I.geos_CoordSeqDestroy h ptr
return $ CoordSeq fptr
instance CoordinateSequence CoordSeqConst where
withCoordinateSequence (CoordSeqConst p) f = f p
createEmptyCoordinateSequence size dim = do
ptr <- withGeos $ \h ->
throwIfNull "createEmptyCoordinateSequence" $ I.geos_CoordSeqCreate h (fromIntegral size) (fromIntegral dim)
createCoordinateSequence ptr
createCoordinateSequence ptr = return $ CoordSeqConst ptr
getCoordinateSequenceD_ :: CoordinateSequence a
=> (I.GEOSContextHandle_t -> Ptr I.GEOSCoordSequence -> CUInt -> Ptr CDouble -> IO CInt)
-> a
-> Int
-> Geos Double
getCoordinateSequenceD_ f cs idx = withGeos $ \h ->
alloca $ \dptr -> do
_ <- throwIfZero (mkErrorMessage "getCoordiniateSequenceN") $
withCoordinateSequence cs $ \pcs -> f h pcs (fromIntegral idx) dptr
d <- peek dptr
return $ realToFrac d
getCoordinateSequenceX :: CoordinateSequence a => a -> Int -> Geos Double
getCoordinateSequenceX = getCoordinateSequenceD_ I.geos_CoordSeqGetX
getCoordinateSequenceY :: CoordinateSequence a => a -> Int -> Geos Double
getCoordinateSequenceY = getCoordinateSequenceD_ I.geos_CoordSeqGetY
getCoordinateSequenceZ :: CoordinateSequence a => a -> Int -> Geos Double
getCoordinateSequenceZ = getCoordinateSequenceD_ I.geos_CoordSeqGetZ
getCoordinateSequenceSize :: CoordinateSequence a => a -> Geos Int
getCoordinateSequenceSize c = withGeos $ \h ->
alloca $ \ptr -> do
_ <- throwIfZero (mkErrorMessage "getCoordinateSequenceSize") $
withCoordinateSequence c $ \pc ->
I.geos_CoordSeqGetSize h pc ptr
s <- peek ptr
return $ fromIntegral s
getCoordinateSequenceDimensions :: CoordinateSequence a => a -> Geos Int
getCoordinateSequenceDimensions c = withGeos $ \h ->
alloca $ \ptr -> do
_ <- throwIfZero (mkErrorMessage "getCoordinateSeqenceDimensions") $
withCoordinateSequence c $ \pc ->
I.geos_CoordSeqGetDimensions h pc ptr
s <- peek ptr
return $ fromIntegral s
setCoordinateSequence_ :: CoordinateSequence a
=> (I.GEOSContextHandle_t -> Ptr I.GEOSCoordSequence -> CUInt -> CDouble -> IO CInt)
-> a
-> Int
-> Double
-> Geos ()
setCoordinateSequence_ f cs idx val = withGeos $ \h -> do
_ <- throwIfZero (mkErrorMessage "setCoordinateSEquenceN") $
withCoordinateSequence cs $ \pcs ->
f h pcs (fromIntegral idx) (realToFrac val)
return ()
setCoordinateSequenceX :: CoordinateSequence a => a -> Int -> Double -> Geos ()
setCoordinateSequenceX = setCoordinateSequence_ I.geos_CoordSeqSetX
setCoordinateSequenceY :: CoordinateSequence a => a -> Int -> Double -> Geos ()
setCoordinateSequenceY = setCoordinateSequence_ I.geos_CoordSeqSetY
setCoordinateSequenceZ :: CoordinateSequence a => a -> Int -> Double -> Geos ()
setCoordinateSequenceZ = setCoordinateSequence_ I.geos_CoordSeqSetZ
setCoordinateSequenceOrd :: CoordinateSequence a => a -> Int -> Int -> Double -> Geos Int
setCoordinateSequenceOrd cs idx dim v = withGeos $ \h -> do
i <- throwIfZero (mkErrorMessage "setCoordinateSequenceN") $
withCoordinateSequence cs $ \pcs ->
I.geos_CoordSeqSetOrdinate h pcs (fromIntegral idx) (fromIntegral dim) (realToFrac v)
return $ fromIntegral i