module Graphics.Rendering.OpenGL.GLU.Tessellation (
AnnotatedVertex(..), ComplexContour(..), ComplexPolygon(..),
WeightedProperties(..), Combiner,
TessWinding(..), Tolerance,
Tessellator,
SimpleContour(..), PolygonContours(..), extractContours,
TriangleVertex, Triangle(..), Triangulation(..), triangulate,
Primitive(..), SimplePolygon(..), tessellate
) where
import Control.Monad ( foldM_, unless )
import Data.IORef ( newIORef, readIORef, writeIORef, modifyIORef )
import Data.Maybe ( fromJust, fromMaybe )
import Foreign.Marshal.Alloc ( allocaBytes )
import Foreign.Marshal.Array ( peekArray, pokeArray )
import Foreign.Marshal.Pool ( Pool, withPool, pooledNew )
import Foreign.Ptr ( Ptr, nullPtr, plusPtr, castPtr, freeHaskellFunPtr )
import Foreign.Storable ( Storable(..) )
import Graphics.GLU
import Graphics.Rendering.OpenGL.GL.Tensor
import Graphics.Rendering.OpenGL.GL.EdgeFlag ( unmarshalEdgeFlag )
import Graphics.Rendering.OpenGL.GL.Exception ( bracket )
import Graphics.Rendering.OpenGL.GL.GLboolean ( marshalGLboolean )
import Graphics.Rendering.OpenGL.GL.PrimitiveMode ( PrimitiveMode )
import Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal ( unmarshalPrimitiveMode )
import Graphics.Rendering.OpenGL.GL.BeginEnd ( EdgeFlag(BeginsInteriorEdge) )
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL
data TessWinding =
TessWindingOdd
| TessWindingNonzero
| TessWindingPositive
| TessWindingNegative
| TessWindingAbsGeqTwo
deriving ( TessWinding -> TessWinding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TessWinding -> TessWinding -> Bool
$c/= :: TessWinding -> TessWinding -> Bool
== :: TessWinding -> TessWinding -> Bool
$c== :: TessWinding -> TessWinding -> Bool
Eq, Eq TessWinding
TessWinding -> TessWinding -> Bool
TessWinding -> TessWinding -> Ordering
TessWinding -> TessWinding -> TessWinding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TessWinding -> TessWinding -> TessWinding
$cmin :: TessWinding -> TessWinding -> TessWinding
max :: TessWinding -> TessWinding -> TessWinding
$cmax :: TessWinding -> TessWinding -> TessWinding
>= :: TessWinding -> TessWinding -> Bool
$c>= :: TessWinding -> TessWinding -> Bool
> :: TessWinding -> TessWinding -> Bool
$c> :: TessWinding -> TessWinding -> Bool
<= :: TessWinding -> TessWinding -> Bool
$c<= :: TessWinding -> TessWinding -> Bool
< :: TessWinding -> TessWinding -> Bool
$c< :: TessWinding -> TessWinding -> Bool
compare :: TessWinding -> TessWinding -> Ordering
$ccompare :: TessWinding -> TessWinding -> Ordering
Ord, Int -> TessWinding -> ShowS
[TessWinding] -> ShowS
TessWinding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TessWinding] -> ShowS
$cshowList :: [TessWinding] -> ShowS
show :: TessWinding -> String
$cshow :: TessWinding -> String
showsPrec :: Int -> TessWinding -> ShowS
$cshowsPrec :: Int -> TessWinding -> ShowS
Show )
marshalTessWinding :: TessWinding -> GLenum
marshalTessWinding :: TessWinding -> GLenum
marshalTessWinding TessWinding
x = case TessWinding
x of
TessWinding
TessWindingOdd -> GLenum
GLU_TESS_WINDING_ODD
TessWinding
TessWindingNonzero -> GLenum
GLU_TESS_WINDING_NONZERO
TessWinding
TessWindingPositive -> GLenum
GLU_TESS_WINDING_POSITIVE
TessWinding
TessWindingNegative -> GLenum
GLU_TESS_WINDING_NEGATIVE
TessWinding
TessWindingAbsGeqTwo -> GLenum
GLU_TESS_WINDING_ABS_GEQ_TWO
data AnnotatedVertex v = AnnotatedVertex (Vertex3 GLdouble) v
deriving ( AnnotatedVertex v -> AnnotatedVertex v -> Bool
forall v. Eq v => AnnotatedVertex v -> AnnotatedVertex v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotatedVertex v -> AnnotatedVertex v -> Bool
$c/= :: forall v. Eq v => AnnotatedVertex v -> AnnotatedVertex v -> Bool
== :: AnnotatedVertex v -> AnnotatedVertex v -> Bool
$c== :: forall v. Eq v => AnnotatedVertex v -> AnnotatedVertex v -> Bool
Eq, AnnotatedVertex v -> AnnotatedVertex v -> Bool
AnnotatedVertex v -> AnnotatedVertex v -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (AnnotatedVertex v)
forall v. Ord v => AnnotatedVertex v -> AnnotatedVertex v -> Bool
forall v.
Ord v =>
AnnotatedVertex v -> AnnotatedVertex v -> Ordering
forall v.
Ord v =>
AnnotatedVertex v -> AnnotatedVertex v -> AnnotatedVertex v
min :: AnnotatedVertex v -> AnnotatedVertex v -> AnnotatedVertex v
$cmin :: forall v.
Ord v =>
AnnotatedVertex v -> AnnotatedVertex v -> AnnotatedVertex v
max :: AnnotatedVertex v -> AnnotatedVertex v -> AnnotatedVertex v
$cmax :: forall v.
Ord v =>
AnnotatedVertex v -> AnnotatedVertex v -> AnnotatedVertex v
>= :: AnnotatedVertex v -> AnnotatedVertex v -> Bool
$c>= :: forall v. Ord v => AnnotatedVertex v -> AnnotatedVertex v -> Bool
> :: AnnotatedVertex v -> AnnotatedVertex v -> Bool
$c> :: forall v. Ord v => AnnotatedVertex v -> AnnotatedVertex v -> Bool
<= :: AnnotatedVertex v -> AnnotatedVertex v -> Bool
$c<= :: forall v. Ord v => AnnotatedVertex v -> AnnotatedVertex v -> Bool
< :: AnnotatedVertex v -> AnnotatedVertex v -> Bool
$c< :: forall v. Ord v => AnnotatedVertex v -> AnnotatedVertex v -> Bool
compare :: AnnotatedVertex v -> AnnotatedVertex v -> Ordering
$ccompare :: forall v.
Ord v =>
AnnotatedVertex v -> AnnotatedVertex v -> Ordering
Ord )
offsetOfProperty :: Storable v => v -> Int
offsetOfProperty :: forall v. Storable v => v -> Int
offsetOfProperty v
v = forall a. Storable a => a -> Int -> Int
alignOffset v
v (Int
3 forall a. Num a => a -> a -> a
* forall v. Storable v => v -> Int
sizeOf GLdouble
x)
where AnnotatedVertex (Vertex3 GLdouble
x GLdouble
_ GLdouble
_) Any
_ = forall a. HasCallStack => a
undefined
alignOffset :: Storable a => a -> Int -> Int
alignOffset :: forall a. Storable a => a -> Int -> Int
alignOffset a
x Int
offset = Int
n forall a. Num a => a -> a -> a
- (Int
n forall a. Integral a => a -> a -> a
`mod` Int
a)
where a :: Int
a = forall v. Storable v => v -> Int
alignment a
x
n :: Int
n = Int
a forall a. Num a => a -> a -> a
+ Int
offset forall a. Num a => a -> a -> a
- Int
1
instance Storable v => Storable (AnnotatedVertex v) where
sizeOf :: AnnotatedVertex v -> Int
sizeOf ~(AnnotatedVertex (Vertex3 GLdouble
x GLdouble
_ GLdouble
_) v
v) =
forall a. Storable a => a -> Int -> Int
alignOffset GLdouble
x (forall v. Storable v => v -> Int
sizeOf v
v forall a. Num a => a -> a -> a
+ forall v. Storable v => v -> Int
offsetOfProperty v
v)
alignment :: AnnotatedVertex v -> Int
alignment ~(AnnotatedVertex (Vertex3 GLdouble
x GLdouble
_ GLdouble
_) v
_) =
forall v. Storable v => v -> Int
alignment GLdouble
x
peek :: Ptr (AnnotatedVertex v) -> IO (AnnotatedVertex v)
peek Ptr (AnnotatedVertex v)
ptr = do
GLdouble
x <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
0
GLdouble
y <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
1
GLdouble
z <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
2
let dummyElement :: Ptr (AnnotatedVertex v) -> v
dummyElement :: forall v. Ptr (AnnotatedVertex v) -> v
dummyElement = forall a. HasCallStack => a
undefined
v
v <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) (forall v. Storable v => v -> Int
offsetOfProperty (forall v. Ptr (AnnotatedVertex v) -> v
dummyElement Ptr (AnnotatedVertex v)
ptr))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v. Vertex3 GLdouble -> v -> AnnotatedVertex v
AnnotatedVertex (forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x GLdouble
y GLdouble
z) v
v
poke :: Ptr (AnnotatedVertex v) -> AnnotatedVertex v -> IO ()
poke Ptr (AnnotatedVertex v)
ptr (AnnotatedVertex (Vertex3 GLdouble
x GLdouble
y GLdouble
z) v
v) = do
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
0 GLdouble
x
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
1 GLdouble
y
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
2 GLdouble
z
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) (forall v. Storable v => v -> Int
offsetOfProperty v
v) v
v
newtype ComplexContour v = ComplexContour [AnnotatedVertex v]
deriving ( ComplexContour v -> ComplexContour v -> Bool
forall v. Eq v => ComplexContour v -> ComplexContour v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComplexContour v -> ComplexContour v -> Bool
$c/= :: forall v. Eq v => ComplexContour v -> ComplexContour v -> Bool
== :: ComplexContour v -> ComplexContour v -> Bool
$c== :: forall v. Eq v => ComplexContour v -> ComplexContour v -> Bool
Eq, ComplexContour v -> ComplexContour v -> Bool
ComplexContour v -> ComplexContour v -> Ordering
ComplexContour v -> ComplexContour v -> ComplexContour v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (ComplexContour v)
forall v. Ord v => ComplexContour v -> ComplexContour v -> Bool
forall v. Ord v => ComplexContour v -> ComplexContour v -> Ordering
forall v.
Ord v =>
ComplexContour v -> ComplexContour v -> ComplexContour v
min :: ComplexContour v -> ComplexContour v -> ComplexContour v
$cmin :: forall v.
Ord v =>
ComplexContour v -> ComplexContour v -> ComplexContour v
max :: ComplexContour v -> ComplexContour v -> ComplexContour v
$cmax :: forall v.
Ord v =>
ComplexContour v -> ComplexContour v -> ComplexContour v
>= :: ComplexContour v -> ComplexContour v -> Bool
$c>= :: forall v. Ord v => ComplexContour v -> ComplexContour v -> Bool
> :: ComplexContour v -> ComplexContour v -> Bool
$c> :: forall v. Ord v => ComplexContour v -> ComplexContour v -> Bool
<= :: ComplexContour v -> ComplexContour v -> Bool
$c<= :: forall v. Ord v => ComplexContour v -> ComplexContour v -> Bool
< :: ComplexContour v -> ComplexContour v -> Bool
$c< :: forall v. Ord v => ComplexContour v -> ComplexContour v -> Bool
compare :: ComplexContour v -> ComplexContour v -> Ordering
$ccompare :: forall v. Ord v => ComplexContour v -> ComplexContour v -> Ordering
Ord )
sizeOfComplexContour :: Storable v => ComplexContour v -> Int
sizeOfComplexContour :: forall v. Storable v => ComplexContour v -> Int
sizeOfComplexContour (ComplexContour [AnnotatedVertex v]
vs) =
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AnnotatedVertex v]
vs forall a. Num a => a -> a -> a
* forall v. Storable v => v -> Int
sizeOf (forall a. [a] -> a
head [AnnotatedVertex v]
vs)
pokeComplexContour ::
Storable v => Ptr (ComplexContour v) -> ComplexContour v -> IO ()
pokeComplexContour :: forall v.
Storable v =>
Ptr (ComplexContour v) -> ComplexContour v -> IO ()
pokeComplexContour Ptr (ComplexContour v)
ptr (ComplexContour [AnnotatedVertex v]
vs) =
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (forall a b. Ptr a -> Ptr b
castPtr Ptr (ComplexContour v)
ptr) [AnnotatedVertex v]
vs
newtype ComplexPolygon v = ComplexPolygon [ComplexContour v]
deriving ( ComplexPolygon v -> ComplexPolygon v -> Bool
forall v. Eq v => ComplexPolygon v -> ComplexPolygon v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComplexPolygon v -> ComplexPolygon v -> Bool
$c/= :: forall v. Eq v => ComplexPolygon v -> ComplexPolygon v -> Bool
== :: ComplexPolygon v -> ComplexPolygon v -> Bool
$c== :: forall v. Eq v => ComplexPolygon v -> ComplexPolygon v -> Bool
Eq, ComplexPolygon v -> ComplexPolygon v -> Bool
ComplexPolygon v -> ComplexPolygon v -> Ordering
ComplexPolygon v -> ComplexPolygon v -> ComplexPolygon v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (ComplexPolygon v)
forall v. Ord v => ComplexPolygon v -> ComplexPolygon v -> Bool
forall v. Ord v => ComplexPolygon v -> ComplexPolygon v -> Ordering
forall v.
Ord v =>
ComplexPolygon v -> ComplexPolygon v -> ComplexPolygon v
min :: ComplexPolygon v -> ComplexPolygon v -> ComplexPolygon v
$cmin :: forall v.
Ord v =>
ComplexPolygon v -> ComplexPolygon v -> ComplexPolygon v
max :: ComplexPolygon v -> ComplexPolygon v -> ComplexPolygon v
$cmax :: forall v.
Ord v =>
ComplexPolygon v -> ComplexPolygon v -> ComplexPolygon v
>= :: ComplexPolygon v -> ComplexPolygon v -> Bool
$c>= :: forall v. Ord v => ComplexPolygon v -> ComplexPolygon v -> Bool
> :: ComplexPolygon v -> ComplexPolygon v -> Bool
$c> :: forall v. Ord v => ComplexPolygon v -> ComplexPolygon v -> Bool
<= :: ComplexPolygon v -> ComplexPolygon v -> Bool
$c<= :: forall v. Ord v => ComplexPolygon v -> ComplexPolygon v -> Bool
< :: ComplexPolygon v -> ComplexPolygon v -> Bool
$c< :: forall v. Ord v => ComplexPolygon v -> ComplexPolygon v -> Bool
compare :: ComplexPolygon v -> ComplexPolygon v -> Ordering
$ccompare :: forall v. Ord v => ComplexPolygon v -> ComplexPolygon v -> Ordering
Ord )
sizeOfComplexPolygon :: Storable v => ComplexPolygon v -> Int
sizeOfComplexPolygon :: forall v. Storable v => ComplexPolygon v -> Int
sizeOfComplexPolygon (ComplexPolygon [ComplexContour v]
complexContours) =
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall v. Storable v => ComplexContour v -> Int
sizeOfComplexContour [ComplexContour v]
complexContours)
pokeComplexPolygon ::
Storable v => Ptr (ComplexPolygon v) -> ComplexPolygon v -> IO ()
pokeComplexPolygon :: forall v.
Storable v =>
Ptr (ComplexPolygon v) -> ComplexPolygon v -> IO ()
pokeComplexPolygon Ptr (ComplexPolygon v)
ptr (ComplexPolygon [ComplexContour v]
complexContours) =
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ forall {v} {b}.
Storable v =>
Ptr (ComplexContour v) -> ComplexContour v -> IO (Ptr b)
pokeAndAdvance (forall a b. Ptr a -> Ptr b
castPtr Ptr (ComplexPolygon v)
ptr) [ComplexContour v]
complexContours forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
where pokeAndAdvance :: Ptr (ComplexContour v) -> ComplexContour v -> IO (Ptr b)
pokeAndAdvance Ptr (ComplexContour v)
p ComplexContour v
complexContour = do
forall v.
Storable v =>
Ptr (ComplexContour v) -> ComplexContour v -> IO ()
pokeComplexContour Ptr (ComplexContour v)
p ComplexContour v
complexContour
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr (ComplexContour v)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall v. Storable v => ComplexContour v -> Int
sizeOfComplexContour ComplexContour v
complexContour
withComplexPolygon ::
Storable v => ComplexPolygon v -> (Ptr (ComplexPolygon v) -> IO a) -> IO a
withComplexPolygon :: forall v a.
Storable v =>
ComplexPolygon v -> (Ptr (ComplexPolygon v) -> IO a) -> IO a
withComplexPolygon ComplexPolygon v
complexPolygon Ptr (ComplexPolygon v) -> IO a
f =
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (forall v. Storable v => ComplexPolygon v -> Int
sizeOfComplexPolygon ComplexPolygon v
complexPolygon) forall a b. (a -> b) -> a -> b
$ \Ptr (ComplexPolygon v)
ptr -> do
forall v.
Storable v =>
Ptr (ComplexPolygon v) -> ComplexPolygon v -> IO ()
pokeComplexPolygon Ptr (ComplexPolygon v)
ptr ComplexPolygon v
complexPolygon
Ptr (ComplexPolygon v) -> IO a
f Ptr (ComplexPolygon v)
ptr
data WeightedProperties v
= WeightedProperties (GLfloat, v)
(GLfloat, v)
(GLfloat, v)
(GLfloat, v)
deriving ( WeightedProperties v -> WeightedProperties v -> Bool
forall v.
Eq v =>
WeightedProperties v -> WeightedProperties v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeightedProperties v -> WeightedProperties v -> Bool
$c/= :: forall v.
Eq v =>
WeightedProperties v -> WeightedProperties v -> Bool
== :: WeightedProperties v -> WeightedProperties v -> Bool
$c== :: forall v.
Eq v =>
WeightedProperties v -> WeightedProperties v -> Bool
Eq, WeightedProperties v -> WeightedProperties v -> Bool
WeightedProperties v -> WeightedProperties v -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (WeightedProperties v)
forall v.
Ord v =>
WeightedProperties v -> WeightedProperties v -> Bool
forall v.
Ord v =>
WeightedProperties v -> WeightedProperties v -> Ordering
forall v.
Ord v =>
WeightedProperties v
-> WeightedProperties v -> WeightedProperties v
min :: WeightedProperties v
-> WeightedProperties v -> WeightedProperties v
$cmin :: forall v.
Ord v =>
WeightedProperties v
-> WeightedProperties v -> WeightedProperties v
max :: WeightedProperties v
-> WeightedProperties v -> WeightedProperties v
$cmax :: forall v.
Ord v =>
WeightedProperties v
-> WeightedProperties v -> WeightedProperties v
>= :: WeightedProperties v -> WeightedProperties v -> Bool
$c>= :: forall v.
Ord v =>
WeightedProperties v -> WeightedProperties v -> Bool
> :: WeightedProperties v -> WeightedProperties v -> Bool
$c> :: forall v.
Ord v =>
WeightedProperties v -> WeightedProperties v -> Bool
<= :: WeightedProperties v -> WeightedProperties v -> Bool
$c<= :: forall v.
Ord v =>
WeightedProperties v -> WeightedProperties v -> Bool
< :: WeightedProperties v -> WeightedProperties v -> Bool
$c< :: forall v.
Ord v =>
WeightedProperties v -> WeightedProperties v -> Bool
compare :: WeightedProperties v -> WeightedProperties v -> Ordering
$ccompare :: forall v.
Ord v =>
WeightedProperties v -> WeightedProperties v -> Ordering
Ord )
type Combiner v
= Vertex3 GLdouble
-> WeightedProperties v
-> v
type Tolerance = GLdouble
type Tessellator p v
= TessWinding
-> Tolerance
-> Normal3 GLdouble
-> Combiner v
-> ComplexPolygon v
-> IO (p v)
newtype SimpleContour v = SimpleContour [AnnotatedVertex v]
deriving ( SimpleContour v -> SimpleContour v -> Bool
forall v. Eq v => SimpleContour v -> SimpleContour v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleContour v -> SimpleContour v -> Bool
$c/= :: forall v. Eq v => SimpleContour v -> SimpleContour v -> Bool
== :: SimpleContour v -> SimpleContour v -> Bool
$c== :: forall v. Eq v => SimpleContour v -> SimpleContour v -> Bool
Eq, SimpleContour v -> SimpleContour v -> Bool
SimpleContour v -> SimpleContour v -> Ordering
SimpleContour v -> SimpleContour v -> SimpleContour v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (SimpleContour v)
forall v. Ord v => SimpleContour v -> SimpleContour v -> Bool
forall v. Ord v => SimpleContour v -> SimpleContour v -> Ordering
forall v.
Ord v =>
SimpleContour v -> SimpleContour v -> SimpleContour v
min :: SimpleContour v -> SimpleContour v -> SimpleContour v
$cmin :: forall v.
Ord v =>
SimpleContour v -> SimpleContour v -> SimpleContour v
max :: SimpleContour v -> SimpleContour v -> SimpleContour v
$cmax :: forall v.
Ord v =>
SimpleContour v -> SimpleContour v -> SimpleContour v
>= :: SimpleContour v -> SimpleContour v -> Bool
$c>= :: forall v. Ord v => SimpleContour v -> SimpleContour v -> Bool
> :: SimpleContour v -> SimpleContour v -> Bool
$c> :: forall v. Ord v => SimpleContour v -> SimpleContour v -> Bool
<= :: SimpleContour v -> SimpleContour v -> Bool
$c<= :: forall v. Ord v => SimpleContour v -> SimpleContour v -> Bool
< :: SimpleContour v -> SimpleContour v -> Bool
$c< :: forall v. Ord v => SimpleContour v -> SimpleContour v -> Bool
compare :: SimpleContour v -> SimpleContour v -> Ordering
$ccompare :: forall v. Ord v => SimpleContour v -> SimpleContour v -> Ordering
Ord )
newtype PolygonContours v = PolygonContours [SimpleContour v]
deriving ( PolygonContours v -> PolygonContours v -> Bool
forall v. Eq v => PolygonContours v -> PolygonContours v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolygonContours v -> PolygonContours v -> Bool
$c/= :: forall v. Eq v => PolygonContours v -> PolygonContours v -> Bool
== :: PolygonContours v -> PolygonContours v -> Bool
$c== :: forall v. Eq v => PolygonContours v -> PolygonContours v -> Bool
Eq, PolygonContours v -> PolygonContours v -> Bool
PolygonContours v -> PolygonContours v -> Ordering
PolygonContours v -> PolygonContours v -> PolygonContours v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (PolygonContours v)
forall v. Ord v => PolygonContours v -> PolygonContours v -> Bool
forall v.
Ord v =>
PolygonContours v -> PolygonContours v -> Ordering
forall v.
Ord v =>
PolygonContours v -> PolygonContours v -> PolygonContours v
min :: PolygonContours v -> PolygonContours v -> PolygonContours v
$cmin :: forall v.
Ord v =>
PolygonContours v -> PolygonContours v -> PolygonContours v
max :: PolygonContours v -> PolygonContours v -> PolygonContours v
$cmax :: forall v.
Ord v =>
PolygonContours v -> PolygonContours v -> PolygonContours v
>= :: PolygonContours v -> PolygonContours v -> Bool
$c>= :: forall v. Ord v => PolygonContours v -> PolygonContours v -> Bool
> :: PolygonContours v -> PolygonContours v -> Bool
$c> :: forall v. Ord v => PolygonContours v -> PolygonContours v -> Bool
<= :: PolygonContours v -> PolygonContours v -> Bool
$c<= :: forall v. Ord v => PolygonContours v -> PolygonContours v -> Bool
< :: PolygonContours v -> PolygonContours v -> Bool
$c< :: forall v. Ord v => PolygonContours v -> PolygonContours v -> Bool
compare :: PolygonContours v -> PolygonContours v -> Ordering
$ccompare :: forall v.
Ord v =>
PolygonContours v -> PolygonContours v -> Ordering
Ord )
extractContours :: Storable v => Tessellator PolygonContours v
TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Combiner v
combiner ComplexPolygon v
complexPoly = do
IORef [AnnotatedVertex v]
vertices <- forall a. a -> IO (IORef a)
newIORef []
let addVertex :: AnnotatedVertex v -> IO ()
addVertex AnnotatedVertex v
v = forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [AnnotatedVertex v]
vertices (AnnotatedVertex v
vforall a. a -> [a] -> [a]
:)
IORef [SimpleContour v]
contours <- forall a. a -> IO (IORef a)
newIORef []
let finishContour :: IO ()
finishContour = do
[AnnotatedVertex v]
vs <- forall a. IORef a -> IO a
readIORef IORef [AnnotatedVertex v]
vertices
forall a. IORef a -> a -> IO ()
writeIORef IORef [AnnotatedVertex v]
vertices []
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [SimpleContour v]
contours (forall v. [AnnotatedVertex v] -> SimpleContour v
SimpleContour (forall a. [a] -> [a]
reverse [AnnotatedVertex v]
vs) forall a. a -> [a] -> [a]
:)
getContours :: IO (PolygonContours v)
getContours = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall v. [SimpleContour v] -> PolygonContours v
PolygonContours forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse) (forall a. IORef a -> IO a
readIORef IORef [SimpleContour v]
contours)
forall a. a -> (TessellatorObj -> IO a) -> IO a
withTessellatorObj (forall v. [SimpleContour v] -> PolygonContours v
PolygonContours [])forall a b. (a -> b) -> a -> b
$ \TessellatorObj
tessObj -> do
TessellatorObj
-> TessWinding -> GLdouble -> Normal3 GLdouble -> Bool -> IO ()
setTessellatorProperties TessellatorObj
tessObj TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Bool
True
forall v a.
Storable v =>
TessellatorObj -> VertexCallback v -> IO a -> IO a
withVertexCallback TessellatorObj
tessObj AnnotatedVertex v -> IO ()
addVertex forall a b. (a -> b) -> a -> b
$
forall a. TessellatorObj -> IO () -> IO a -> IO a
withEndCallback TessellatorObj
tessObj IO ()
finishContour forall a b. (a -> b) -> a -> b
$
forall a. TessellatorObj -> IO a -> IO a
checkForError TessellatorObj
tessObj forall a b. (a -> b) -> a -> b
$
forall v a.
Storable v =>
TessellatorObj -> Combiner v -> IO a -> IO a
withCombineCallback TessellatorObj
tessObj Combiner v
combiner forall a b. (a -> b) -> a -> b
$ do
forall v. Storable v => TessellatorObj -> ComplexPolygon v -> IO ()
defineComplexPolygon TessellatorObj
tessObj ComplexPolygon v
complexPoly
IO (PolygonContours v)
getContours
type TriangleVertex v = AnnotatedVertex (v,EdgeFlag)
data Triangle v
= Triangle (TriangleVertex v) (TriangleVertex v) (TriangleVertex v)
deriving ( Triangle v -> Triangle v -> Bool
forall v. Eq v => Triangle v -> Triangle v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Triangle v -> Triangle v -> Bool
$c/= :: forall v. Eq v => Triangle v -> Triangle v -> Bool
== :: Triangle v -> Triangle v -> Bool
$c== :: forall v. Eq v => Triangle v -> Triangle v -> Bool
Eq, Triangle v -> Triangle v -> Bool
Triangle v -> Triangle v -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (Triangle v)
forall v. Ord v => Triangle v -> Triangle v -> Bool
forall v. Ord v => Triangle v -> Triangle v -> Ordering
forall v. Ord v => Triangle v -> Triangle v -> Triangle v
min :: Triangle v -> Triangle v -> Triangle v
$cmin :: forall v. Ord v => Triangle v -> Triangle v -> Triangle v
max :: Triangle v -> Triangle v -> Triangle v
$cmax :: forall v. Ord v => Triangle v -> Triangle v -> Triangle v
>= :: Triangle v -> Triangle v -> Bool
$c>= :: forall v. Ord v => Triangle v -> Triangle v -> Bool
> :: Triangle v -> Triangle v -> Bool
$c> :: forall v. Ord v => Triangle v -> Triangle v -> Bool
<= :: Triangle v -> Triangle v -> Bool
$c<= :: forall v. Ord v => Triangle v -> Triangle v -> Bool
< :: Triangle v -> Triangle v -> Bool
$c< :: forall v. Ord v => Triangle v -> Triangle v -> Bool
compare :: Triangle v -> Triangle v -> Ordering
$ccompare :: forall v. Ord v => Triangle v -> Triangle v -> Ordering
Ord )
newtype Triangulation v = Triangulation [Triangle v]
deriving ( Triangulation v -> Triangulation v -> Bool
forall v. Eq v => Triangulation v -> Triangulation v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Triangulation v -> Triangulation v -> Bool
$c/= :: forall v. Eq v => Triangulation v -> Triangulation v -> Bool
== :: Triangulation v -> Triangulation v -> Bool
$c== :: forall v. Eq v => Triangulation v -> Triangulation v -> Bool
Eq, Triangulation v -> Triangulation v -> Bool
Triangulation v -> Triangulation v -> Ordering
Triangulation v -> Triangulation v -> Triangulation v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (Triangulation v)
forall v. Ord v => Triangulation v -> Triangulation v -> Bool
forall v. Ord v => Triangulation v -> Triangulation v -> Ordering
forall v.
Ord v =>
Triangulation v -> Triangulation v -> Triangulation v
min :: Triangulation v -> Triangulation v -> Triangulation v
$cmin :: forall v.
Ord v =>
Triangulation v -> Triangulation v -> Triangulation v
max :: Triangulation v -> Triangulation v -> Triangulation v
$cmax :: forall v.
Ord v =>
Triangulation v -> Triangulation v -> Triangulation v
>= :: Triangulation v -> Triangulation v -> Bool
$c>= :: forall v. Ord v => Triangulation v -> Triangulation v -> Bool
> :: Triangulation v -> Triangulation v -> Bool
$c> :: forall v. Ord v => Triangulation v -> Triangulation v -> Bool
<= :: Triangulation v -> Triangulation v -> Bool
$c<= :: forall v. Ord v => Triangulation v -> Triangulation v -> Bool
< :: Triangulation v -> Triangulation v -> Bool
$c< :: forall v. Ord v => Triangulation v -> Triangulation v -> Bool
compare :: Triangulation v -> Triangulation v -> Ordering
$ccompare :: forall v. Ord v => Triangulation v -> Triangulation v -> Ordering
Ord )
triangulate :: Storable v => Tessellator Triangulation v
triangulate :: forall v. Storable v => Tessellator Triangulation v
triangulate TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Combiner v
combiner ComplexPolygon v
complexPoly = do
IORef EdgeFlag
edgeFlagState <- forall a. a -> IO (IORef a)
newIORef EdgeFlag
BeginsInteriorEdge
let registerEdgeFlag :: EdgeFlag -> IO ()
registerEdgeFlag = forall a. IORef a -> a -> IO ()
writeIORef IORef EdgeFlag
edgeFlagState
IORef [TriangleVertex v]
vertices <- forall a. a -> IO (IORef a)
newIORef []
let addVertex :: AnnotatedVertex v -> IO ()
addVertex (AnnotatedVertex Vertex3 GLdouble
xyz v
v) = do
EdgeFlag
ef <- forall a. IORef a -> IO a
readIORef IORef EdgeFlag
edgeFlagState
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [TriangleVertex v]
vertices (forall v. Vertex3 GLdouble -> v -> AnnotatedVertex v
AnnotatedVertex Vertex3 GLdouble
xyz (v
v,EdgeFlag
ef) forall a. a -> [a] -> [a]
:)
getTriangulation :: IO (Triangulation v)
getTriangulation = do
[TriangleVertex v]
vs <- forall a. IORef a -> IO a
readIORef IORef [TriangleVertex v]
vertices
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v. [Triangle v] -> Triangulation v
Triangulation (forall v. [TriangleVertex v] -> [Triangle v]
collectTriangles (forall a. [a] -> [a]
reverse [TriangleVertex v]
vs))
forall a. a -> (TessellatorObj -> IO a) -> IO a
withTessellatorObj (forall v. [Triangle v] -> Triangulation v
Triangulation []) forall a b. (a -> b) -> a -> b
$ \TessellatorObj
tessObj -> do
TessellatorObj
-> TessWinding -> GLdouble -> Normal3 GLdouble -> Bool -> IO ()
setTessellatorProperties TessellatorObj
tessObj TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Bool
False
forall a. TessellatorObj -> (EdgeFlag -> IO ()) -> IO a -> IO a
withEdgeFlagCallback TessellatorObj
tessObj EdgeFlag -> IO ()
registerEdgeFlag forall a b. (a -> b) -> a -> b
$
forall v a.
Storable v =>
TessellatorObj -> VertexCallback v -> IO a -> IO a
withVertexCallback TessellatorObj
tessObj AnnotatedVertex v -> IO ()
addVertex forall a b. (a -> b) -> a -> b
$
forall a. TessellatorObj -> IO a -> IO a
checkForError TessellatorObj
tessObj forall a b. (a -> b) -> a -> b
$
forall v a.
Storable v =>
TessellatorObj -> Combiner v -> IO a -> IO a
withCombineCallback TessellatorObj
tessObj Combiner v
combiner forall a b. (a -> b) -> a -> b
$ do
forall v. Storable v => TessellatorObj -> ComplexPolygon v -> IO ()
defineComplexPolygon TessellatorObj
tessObj ComplexPolygon v
complexPoly
IO (Triangulation v)
getTriangulation
collectTriangles :: [TriangleVertex v] -> [Triangle v]
collectTriangles :: forall v. [TriangleVertex v] -> [Triangle v]
collectTriangles [] = []
collectTriangles (TriangleVertex v
a:TriangleVertex v
b:TriangleVertex v
c:[TriangleVertex v]
rest) = forall v.
TriangleVertex v
-> TriangleVertex v -> TriangleVertex v -> Triangle v
Triangle TriangleVertex v
a TriangleVertex v
b TriangleVertex v
c forall a. a -> [a] -> [a]
: forall v. [TriangleVertex v] -> [Triangle v]
collectTriangles [TriangleVertex v]
rest
collectTriangles [TriangleVertex v]
_ = forall a. HasCallStack => String -> a
error String
"triangles left"
data Primitive v = Primitive PrimitiveMode [AnnotatedVertex v]
deriving ( Primitive v -> Primitive v -> Bool
forall v. Eq v => Primitive v -> Primitive v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Primitive v -> Primitive v -> Bool
$c/= :: forall v. Eq v => Primitive v -> Primitive v -> Bool
== :: Primitive v -> Primitive v -> Bool
$c== :: forall v. Eq v => Primitive v -> Primitive v -> Bool
Eq, Primitive v -> Primitive v -> Bool
Primitive v -> Primitive v -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (Primitive v)
forall v. Ord v => Primitive v -> Primitive v -> Bool
forall v. Ord v => Primitive v -> Primitive v -> Ordering
forall v. Ord v => Primitive v -> Primitive v -> Primitive v
min :: Primitive v -> Primitive v -> Primitive v
$cmin :: forall v. Ord v => Primitive v -> Primitive v -> Primitive v
max :: Primitive v -> Primitive v -> Primitive v
$cmax :: forall v. Ord v => Primitive v -> Primitive v -> Primitive v
>= :: Primitive v -> Primitive v -> Bool
$c>= :: forall v. Ord v => Primitive v -> Primitive v -> Bool
> :: Primitive v -> Primitive v -> Bool
$c> :: forall v. Ord v => Primitive v -> Primitive v -> Bool
<= :: Primitive v -> Primitive v -> Bool
$c<= :: forall v. Ord v => Primitive v -> Primitive v -> Bool
< :: Primitive v -> Primitive v -> Bool
$c< :: forall v. Ord v => Primitive v -> Primitive v -> Bool
compare :: Primitive v -> Primitive v -> Ordering
$ccompare :: forall v. Ord v => Primitive v -> Primitive v -> Ordering
Ord )
newtype SimplePolygon v = SimplePolygon [Primitive v]
deriving ( SimplePolygon v -> SimplePolygon v -> Bool
forall v. Eq v => SimplePolygon v -> SimplePolygon v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimplePolygon v -> SimplePolygon v -> Bool
$c/= :: forall v. Eq v => SimplePolygon v -> SimplePolygon v -> Bool
== :: SimplePolygon v -> SimplePolygon v -> Bool
$c== :: forall v. Eq v => SimplePolygon v -> SimplePolygon v -> Bool
Eq, SimplePolygon v -> SimplePolygon v -> Bool
SimplePolygon v -> SimplePolygon v -> Ordering
SimplePolygon v -> SimplePolygon v -> SimplePolygon v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (SimplePolygon v)
forall v. Ord v => SimplePolygon v -> SimplePolygon v -> Bool
forall v. Ord v => SimplePolygon v -> SimplePolygon v -> Ordering
forall v.
Ord v =>
SimplePolygon v -> SimplePolygon v -> SimplePolygon v
min :: SimplePolygon v -> SimplePolygon v -> SimplePolygon v
$cmin :: forall v.
Ord v =>
SimplePolygon v -> SimplePolygon v -> SimplePolygon v
max :: SimplePolygon v -> SimplePolygon v -> SimplePolygon v
$cmax :: forall v.
Ord v =>
SimplePolygon v -> SimplePolygon v -> SimplePolygon v
>= :: SimplePolygon v -> SimplePolygon v -> Bool
$c>= :: forall v. Ord v => SimplePolygon v -> SimplePolygon v -> Bool
> :: SimplePolygon v -> SimplePolygon v -> Bool
$c> :: forall v. Ord v => SimplePolygon v -> SimplePolygon v -> Bool
<= :: SimplePolygon v -> SimplePolygon v -> Bool
$c<= :: forall v. Ord v => SimplePolygon v -> SimplePolygon v -> Bool
< :: SimplePolygon v -> SimplePolygon v -> Bool
$c< :: forall v. Ord v => SimplePolygon v -> SimplePolygon v -> Bool
compare :: SimplePolygon v -> SimplePolygon v -> Ordering
$ccompare :: forall v. Ord v => SimplePolygon v -> SimplePolygon v -> Ordering
Ord )
tessellate :: Storable v => Tessellator SimplePolygon v
tessellate :: forall v. Storable v => Tessellator SimplePolygon v
tessellate TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Combiner v
combiner ComplexPolygon v
complexPoly = do
IORef PrimitiveMode
beginModeState <- forall a. a -> IO (IORef a)
newIORef forall a. HasCallStack => a
undefined
let setPrimitiveMode :: PrimitiveMode -> IO ()
setPrimitiveMode = forall a. IORef a -> a -> IO ()
writeIORef IORef PrimitiveMode
beginModeState
IORef [AnnotatedVertex v]
vertices <- forall a. a -> IO (IORef a)
newIORef []
let addVertex :: AnnotatedVertex v -> IO ()
addVertex AnnotatedVertex v
v = forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [AnnotatedVertex v]
vertices (AnnotatedVertex v
vforall a. a -> [a] -> [a]
:)
IORef [Primitive v]
primitives <- forall a. a -> IO (IORef a)
newIORef []
let finishPrimitive :: IO ()
finishPrimitive = do
PrimitiveMode
beginMode <- forall a. IORef a -> IO a
readIORef IORef PrimitiveMode
beginModeState
[AnnotatedVertex v]
vs <- forall a. IORef a -> IO a
readIORef IORef [AnnotatedVertex v]
vertices
forall a. IORef a -> a -> IO ()
writeIORef IORef [AnnotatedVertex v]
vertices []
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [Primitive v]
primitives (forall v. PrimitiveMode -> [AnnotatedVertex v] -> Primitive v
Primitive PrimitiveMode
beginMode (forall a. [a] -> [a]
reverse [AnnotatedVertex v]
vs) forall a. a -> [a] -> [a]
:)
getSimplePolygon :: IO (SimplePolygon v)
getSimplePolygon = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall v. [Primitive v] -> SimplePolygon v
SimplePolygon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse) (forall a. IORef a -> IO a
readIORef IORef [Primitive v]
primitives)
forall a. a -> (TessellatorObj -> IO a) -> IO a
withTessellatorObj (forall v. [Primitive v] -> SimplePolygon v
SimplePolygon []) forall a b. (a -> b) -> a -> b
$ \TessellatorObj
tessObj -> do
TessellatorObj
-> TessWinding -> GLdouble -> Normal3 GLdouble -> Bool -> IO ()
setTessellatorProperties TessellatorObj
tessObj TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Bool
False
forall a.
TessellatorObj -> (PrimitiveMode -> IO ()) -> IO a -> IO a
withBeginCallback TessellatorObj
tessObj PrimitiveMode -> IO ()
setPrimitiveMode forall a b. (a -> b) -> a -> b
$
forall v a.
Storable v =>
TessellatorObj -> VertexCallback v -> IO a -> IO a
withVertexCallback TessellatorObj
tessObj AnnotatedVertex v -> IO ()
addVertex forall a b. (a -> b) -> a -> b
$
forall a. TessellatorObj -> IO () -> IO a -> IO a
withEndCallback TessellatorObj
tessObj IO ()
finishPrimitive forall a b. (a -> b) -> a -> b
$
forall a. TessellatorObj -> IO a -> IO a
checkForError TessellatorObj
tessObj forall a b. (a -> b) -> a -> b
$
forall v a.
Storable v =>
TessellatorObj -> Combiner v -> IO a -> IO a
withCombineCallback TessellatorObj
tessObj Combiner v
combiner forall a b. (a -> b) -> a -> b
$ do
forall v. Storable v => TessellatorObj -> ComplexPolygon v -> IO ()
defineComplexPolygon TessellatorObj
tessObj ComplexPolygon v
complexPoly
IO (SimplePolygon v)
getSimplePolygon
type TessellatorObj = Ptr GLUtesselator
isNullTesselatorObj :: TessellatorObj -> Bool
isNullTesselatorObj :: TessellatorObj -> Bool
isNullTesselatorObj = (forall a. Ptr a
nullPtr forall a. Eq a => a -> a -> Bool
==)
withTessellatorObj :: a -> (TessellatorObj -> IO a) -> IO a
withTessellatorObj :: forall a. a -> (TessellatorObj -> IO a) -> IO a
withTessellatorObj a
failureValue TessellatorObj -> IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket forall (m :: * -> *). MonadIO m => m TessellatorObj
gluNewTess TessellatorObj -> IO ()
safeDeleteTess
(\TessellatorObj
tessObj -> if TessellatorObj -> Bool
isNullTesselatorObj TessellatorObj
tessObj
then do IO ()
recordOutOfMemory
forall (m :: * -> *) a. Monad m => a -> m a
return a
failureValue
else TessellatorObj -> IO a
action TessellatorObj
tessObj)
safeDeleteTess :: TessellatorObj -> IO ()
safeDeleteTess :: TessellatorObj -> IO ()
safeDeleteTess TessellatorObj
tessObj =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TessellatorObj -> Bool
isNullTesselatorObj TessellatorObj
tessObj) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => TessellatorObj -> m ()
gluDeleteTess TessellatorObj
tessObj
defineComplexPolygon ::
Storable v => TessellatorObj -> ComplexPolygon v -> IO ()
defineComplexPolygon :: forall v. Storable v => TessellatorObj -> ComplexPolygon v -> IO ()
defineComplexPolygon TessellatorObj
tessObj cp :: ComplexPolygon v
cp@(ComplexPolygon [ComplexContour v]
complexContours) =
forall v a.
Storable v =>
ComplexPolygon v -> (Ptr (ComplexPolygon v) -> IO a) -> IO a
withComplexPolygon ComplexPolygon v
cp forall a b. (a -> b) -> a -> b
$ \Ptr (ComplexPolygon v)
ptr ->
forall p a. TessellatorObj -> Ptr p -> IO a -> IO a
tessBeginEndPolygon TessellatorObj
tessObj forall a. Ptr a
nullPtr forall a b. (a -> b) -> a -> b
$
let loop :: Ptr b -> [ComplexContour v] -> IO ()
loop Ptr b
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop Ptr b
p (ComplexContour v
c:[ComplexContour v]
cs) = do forall v.
Storable v =>
TessellatorObj
-> Ptr (ComplexContour v) -> ComplexContour v -> IO ()
defineComplexContour TessellatorObj
tessObj (forall a b. Ptr a -> Ptr b
castPtr Ptr b
p) ComplexContour v
c
Ptr b -> [ComplexContour v] -> IO ()
loop (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall v. Storable v => ComplexContour v -> Int
sizeOfComplexContour ComplexContour v
c) [ComplexContour v]
cs
in forall {v} {b}. Storable v => Ptr b -> [ComplexContour v] -> IO ()
loop Ptr (ComplexPolygon v)
ptr [ComplexContour v]
complexContours
tessBeginEndPolygon :: TessellatorObj -> Ptr p -> IO a -> IO a
tessBeginEndPolygon :: forall p a. TessellatorObj -> Ptr p -> IO a -> IO a
tessBeginEndPolygon TessellatorObj
tessObj Ptr p
ptr IO a
f = do
forall (m :: * -> *) a.
MonadIO m =>
TessellatorObj -> Ptr a -> m ()
gluTessBeginPolygon TessellatorObj
tessObj Ptr p
ptr
a
res <- IO a
f
forall (m :: * -> *). MonadIO m => TessellatorObj -> m ()
gluTessEndPolygon TessellatorObj
tessObj
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
defineComplexContour ::
Storable v =>
TessellatorObj -> Ptr (ComplexContour v) -> ComplexContour v -> IO ()
defineComplexContour :: forall v.
Storable v =>
TessellatorObj
-> Ptr (ComplexContour v) -> ComplexContour v -> IO ()
defineComplexContour TessellatorObj
tessObj Ptr (ComplexContour v)
ptr (ComplexContour [AnnotatedVertex v]
annotatedVertices) =
forall a. TessellatorObj -> IO a -> IO a
tessBeginEndContour TessellatorObj
tessObj forall a b. (a -> b) -> a -> b
$
let loop :: Ptr b -> [a] -> IO ()
loop Ptr b
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop Ptr b
p (a
v:[a]
vs) = do forall v. TessellatorObj -> Ptr (AnnotatedVertex v) -> IO ()
defineVertex TessellatorObj
tessObj (forall a b. Ptr a -> Ptr b
castPtr Ptr b
p)
Ptr b -> [a] -> IO ()
loop (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall v. Storable v => v -> Int
sizeOf a
v) [a]
vs
in forall {a} {b}. Storable a => Ptr b -> [a] -> IO ()
loop Ptr (ComplexContour v)
ptr [AnnotatedVertex v]
annotatedVertices
tessBeginEndContour :: TessellatorObj -> IO a -> IO a
tessBeginEndContour :: forall a. TessellatorObj -> IO a -> IO a
tessBeginEndContour TessellatorObj
tessObj IO a
f = do
forall (m :: * -> *). MonadIO m => TessellatorObj -> m ()
gluTessBeginContour TessellatorObj
tessObj
a
res <- IO a
f
forall (m :: * -> *). MonadIO m => TessellatorObj -> m ()
gluTessEndContour TessellatorObj
tessObj
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
defineVertex :: TessellatorObj -> Ptr (AnnotatedVertex v) -> IO ()
defineVertex :: forall v. TessellatorObj -> Ptr (AnnotatedVertex v) -> IO ()
defineVertex TessellatorObj
tessObj Ptr (AnnotatedVertex v)
ptr = forall (m :: * -> *) a.
MonadIO m =>
TessellatorObj -> Ptr GLdouble -> Ptr a -> m ()
gluTessVertex TessellatorObj
tessObj (forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Ptr (AnnotatedVertex v)
ptr
type BeginCallback = PrimitiveMode -> IO ()
withBeginCallback :: TessellatorObj -> BeginCallback -> IO a -> IO a
withBeginCallback :: forall a.
TessellatorObj -> (PrimitiveMode -> IO ()) -> IO a -> IO a
withBeginCallback TessellatorObj
tessObj PrimitiveMode -> IO ()
beginCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TessBeginCallback -> IO (FunPtr TessBeginCallback)
makeTessBeginCallback (PrimitiveMode -> IO ()
beginCallback forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> PrimitiveMode
unmarshalPrimitiveMode))
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr TessBeginCallback
callbackPtr -> do
forall (m :: * -> *) a.
MonadIO m =>
TessellatorObj -> GLenum -> FunPtr a -> m ()
gluTessCallback TessellatorObj
tessObj GLenum
GLU_TESS_BEGIN FunPtr TessBeginCallback
callbackPtr
IO a
action
type EdgeFlagCallback = EdgeFlag -> IO ()
withEdgeFlagCallback :: TessellatorObj -> EdgeFlagCallback -> IO a -> IO a
withEdgeFlagCallback :: forall a. TessellatorObj -> (EdgeFlag -> IO ()) -> IO a -> IO a
withEdgeFlagCallback TessellatorObj
tessObj EdgeFlag -> IO ()
edgeFlagCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TessEdgeFlagCallback -> IO (FunPtr TessEdgeFlagCallback)
makeTessEdgeFlagCallback (EdgeFlag -> IO ()
edgeFlagCallback forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLboolean -> EdgeFlag
unmarshalEdgeFlag))
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr TessEdgeFlagCallback
callbackPtr -> do
forall (m :: * -> *) a.
MonadIO m =>
TessellatorObj -> GLenum -> FunPtr a -> m ()
gluTessCallback TessellatorObj
tessObj GLenum
GLU_TESS_EDGE_FLAG FunPtr TessEdgeFlagCallback
callbackPtr
IO a
action
type VertexCallback v = AnnotatedVertex v -> IO ()
withVertexCallback ::
Storable v => TessellatorObj -> VertexCallback v -> IO a -> IO a
withVertexCallback :: forall v a.
Storable v =>
TessellatorObj -> VertexCallback v -> IO a -> IO a
withVertexCallback TessellatorObj
tessObj VertexCallback v
vertexCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall v.
TessVertexCallback v -> IO (FunPtr (TessVertexCallback v))
makeTessVertexCallback (\Ptr (AnnotatedVertex v)
p -> forall a. Storable a => Ptr a -> IO a
peek Ptr (AnnotatedVertex v)
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VertexCallback v
vertexCallback))
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr (Ptr (AnnotatedVertex v) -> IO ())
callbackPtr -> do
forall (m :: * -> *) a.
MonadIO m =>
TessellatorObj -> GLenum -> FunPtr a -> m ()
gluTessCallback TessellatorObj
tessObj GLenum
GLU_TESS_VERTEX FunPtr (Ptr (AnnotatedVertex v) -> IO ())
callbackPtr
IO a
action
type EndCallback = IO ()
withEndCallback :: TessellatorObj -> EndCallback -> IO a -> IO a
withEndCallback :: forall a. TessellatorObj -> IO () -> IO a -> IO a
withEndCallback TessellatorObj
tessObj IO ()
endCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO () -> IO (FunPtr (IO ()))
makeTessEndCallback IO ()
endCallback) forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr (IO ())
callbackPtr -> do
forall (m :: * -> *) a.
MonadIO m =>
TessellatorObj -> GLenum -> FunPtr a -> m ()
gluTessCallback TessellatorObj
tessObj GLenum
GLU_TESS_END FunPtr (IO ())
callbackPtr
IO a
action
type ErrorCallback = GLenum -> IO ()
withErrorCallback :: TessellatorObj -> ErrorCallback -> IO a -> IO a
withErrorCallback :: forall a. TessellatorObj -> TessBeginCallback -> IO a -> IO a
withErrorCallback TessellatorObj
tessObj TessBeginCallback
errorCallback IO a
action =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TessBeginCallback -> IO (FunPtr TessBeginCallback)
makeTessErrorCallback TessBeginCallback
errorCallback)
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr TessBeginCallback
callbackPtr -> do
forall (m :: * -> *) a.
MonadIO m =>
TessellatorObj -> GLenum -> FunPtr a -> m ()
gluTessCallback TessellatorObj
tessObj GLenum
GLU_TESS_ERROR FunPtr TessBeginCallback
callbackPtr
IO a
action
checkForError :: TessellatorObj -> IO a -> IO a
checkForError :: forall a. TessellatorObj -> IO a -> IO a
checkForError TessellatorObj
tessObj = forall a. TessellatorObj -> TessBeginCallback -> IO a -> IO a
withErrorCallback TessellatorObj
tessObj TessBeginCallback
recordErrorCode
type CombineCallback v =
Ptr GLdouble
-> Ptr (Ptr (AnnotatedVertex v))
-> Ptr GLfloat
-> Ptr (Ptr (AnnotatedVertex v))
-> IO ()
withCombineCallback ::
Storable v => TessellatorObj -> Combiner v -> IO a -> IO a
withCombineCallback :: forall v a.
Storable v =>
TessellatorObj -> Combiner v -> IO a -> IO a
withCombineCallback TessellatorObj
tessObj Combiner v
combiner IO a
action =
forall b. (Pool -> IO b) -> IO b
withPool forall a b. (a -> b) -> a -> b
$ \Pool
vertexPool ->
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall v.
TessCombineCallback v -> IO (FunPtr (TessCombineCallback v))
makeTessCombineCallback (forall v. Storable v => Pool -> Combiner v -> CombineCallback v
combineProperties Pool
vertexPool Combiner v
combiner))
forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr (TessCombineCallback (AnnotatedVertex v))
callbackPtr -> do
forall (m :: * -> *) a.
MonadIO m =>
TessellatorObj -> GLenum -> FunPtr a -> m ()
gluTessCallback TessellatorObj
tessObj GLenum
GLU_TESS_COMBINE FunPtr (TessCombineCallback (AnnotatedVertex v))
callbackPtr
IO a
action
combineProperties :: Storable v => Pool -> Combiner v -> CombineCallback v
combineProperties :: forall v. Storable v => Pool -> Combiner v -> CombineCallback v
combineProperties Pool
pool Combiner v
combiner Ptr GLdouble
newVertexPtr Ptr (Ptr (AnnotatedVertex v))
propertyPtrs Ptr GLfloat
weights Ptr (Ptr (AnnotatedVertex v))
result = do
Vertex3 GLdouble
newVertex <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr GLdouble
newVertexPtr :: Ptr (Vertex3 GLdouble))
[Maybe v
v0, Maybe v
v1, Maybe v
v2, Maybe v
v3] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall v.
Storable v =>
Ptr (Ptr (AnnotatedVertex v)) -> Int -> IO (Maybe v)
getProperty Ptr (Ptr (AnnotatedVertex v))
propertyPtrs) [Int
0..Int
3]
[GLfloat
w0, GLfloat
w1, GLfloat
w2, GLfloat
w3] <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr GLfloat
weights
let defaultProperty :: v
defaultProperty = forall a. HasCallStack => Maybe a -> a
fromJust Maybe v
v0
f :: Maybe v -> v
f = forall a. a -> Maybe a -> a
fromMaybe v
defaultProperty
wp :: WeightedProperties v
wp = forall v.
(GLfloat, v)
-> (GLfloat, v)
-> (GLfloat, v)
-> (GLfloat, v)
-> WeightedProperties v
WeightedProperties (GLfloat
w0, Maybe v -> v
f Maybe v
v0) (GLfloat
w1, Maybe v -> v
f Maybe v
v1) (GLfloat
w2, Maybe v -> v
f Maybe v
v2) (GLfloat
w3, Maybe v -> v
f Maybe v
v3)
av :: AnnotatedVertex v
av = forall v. Vertex3 GLdouble -> v -> AnnotatedVertex v
AnnotatedVertex Vertex3 GLdouble
newVertex (Combiner v
combiner Vertex3 GLdouble
newVertex WeightedProperties v
wp)
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr (AnnotatedVertex v))
result forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Pool -> a -> IO (Ptr a)
pooledNew Pool
pool AnnotatedVertex v
av
getProperty :: Storable v => Ptr (Ptr (AnnotatedVertex v)) -> Int -> IO (Maybe v)
getProperty :: forall v.
Storable v =>
Ptr (Ptr (AnnotatedVertex v)) -> Int -> IO (Maybe v)
getProperty Ptr (Ptr (AnnotatedVertex v))
propertyPtrs Int
n = forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr (AnnotatedVertex v))
propertyPtrs Int
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall b a. b -> (Ptr a -> b) -> Ptr a -> b
maybeNullPtr (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall v. Storable v => Ptr (AnnotatedVertex v) -> IO (Maybe v)
peekProperty
peekProperty :: Storable v => Ptr (AnnotatedVertex v) -> IO (Maybe v)
peekProperty :: forall v. Storable v => Ptr (AnnotatedVertex v) -> IO (Maybe v)
peekProperty Ptr (AnnotatedVertex v)
ptr = do
AnnotatedVertex Vertex3 GLdouble
_ v
v <- forall a. Storable a => Ptr a -> IO a
peek Ptr (AnnotatedVertex v)
ptr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just v
v)
setTessellatorProperties ::
TessellatorObj -> TessWinding -> Tolerance -> Normal3 GLdouble -> Bool
-> IO ()
setTessellatorProperties :: TessellatorObj
-> TessWinding -> GLdouble -> Normal3 GLdouble -> Bool -> IO ()
setTessellatorProperties TessellatorObj
tessObj TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Bool
boundaryOnly = do
TessellatorObj -> TessWinding -> IO ()
setWindingRule TessellatorObj
tessObj TessWinding
windingRule
TessellatorObj -> GLdouble -> IO ()
setTolerance TessellatorObj
tessObj GLdouble
tolerance
TessellatorObj -> Normal3 GLdouble -> IO ()
setNormal TessellatorObj
tessObj Normal3 GLdouble
theNormal
TessellatorObj -> Bool -> IO ()
setBoundaryOnly TessellatorObj
tessObj Bool
boundaryOnly
setWindingRule :: TessellatorObj -> TessWinding -> IO ()
setWindingRule :: TessellatorObj -> TessWinding -> IO ()
setWindingRule TessellatorObj
tessObj =
forall (m :: * -> *).
MonadIO m =>
TessellatorObj -> GLenum -> GLdouble -> m ()
gluTessProperty TessellatorObj
tessObj GLenum
GLU_TESS_WINDING_RULE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. TessWinding -> GLenum
marshalTessWinding
setBoundaryOnly :: TessellatorObj -> Bool -> IO ()
setBoundaryOnly :: TessellatorObj -> Bool -> IO ()
setBoundaryOnly TessellatorObj
tessObj =
forall (m :: * -> *).
MonadIO m =>
TessellatorObj -> GLenum -> GLdouble -> m ()
gluTessProperty TessellatorObj
tessObj GLenum
GLU_TESS_BOUNDARY_ONLY forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Bool -> a
marshalGLboolean
setTolerance :: TessellatorObj -> Tolerance -> IO ()
setTolerance :: TessellatorObj -> GLdouble -> IO ()
setTolerance TessellatorObj
tessObj = forall (m :: * -> *).
MonadIO m =>
TessellatorObj -> GLenum -> GLdouble -> m ()
gluTessProperty TessellatorObj
tessObj GLenum
GLU_TESS_TOLERANCE
setNormal :: TessellatorObj -> Normal3 GLdouble -> IO ()
setNormal :: TessellatorObj -> Normal3 GLdouble -> IO ()
setNormal TessellatorObj
tessObj (Normal3 GLdouble
x GLdouble
y GLdouble
z) = forall (m :: * -> *).
MonadIO m =>
TessellatorObj -> GLdouble -> GLdouble -> GLdouble -> m ()
gluTessNormal TessellatorObj
tessObj GLdouble
x GLdouble
y GLdouble
z