--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GLU.Tessellation
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to chapter 5 (Polygon Tessellation) of the GLU specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GLU.Tessellation (
   -- * Polygon description
   AnnotatedVertex(..), ComplexContour(..), ComplexPolygon(..),

   -- * Combining vertices
   WeightedProperties(..), Combiner,

   -- * Tessellation parameters
   TessWinding(..), Tolerance,

   -- * Tessellator type
   Tessellator,

   -- * Contour extraction
   SimpleContour(..), PolygonContours(..), extractContours,

   -- * Triangulation
   TriangleVertex, Triangle(..), Triangulation(..), triangulate,

   -- * Tessellation into primitives
   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
(TessWinding -> TessWinding -> Bool)
-> (TessWinding -> TessWinding -> Bool) -> Eq TessWinding
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
Eq TessWinding
-> (TessWinding -> TessWinding -> Ordering)
-> (TessWinding -> TessWinding -> Bool)
-> (TessWinding -> TessWinding -> Bool)
-> (TessWinding -> TessWinding -> Bool)
-> (TessWinding -> TessWinding -> Bool)
-> (TessWinding -> TessWinding -> TessWinding)
-> (TessWinding -> TessWinding -> TessWinding)
-> Ord 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
(Int -> TessWinding -> ShowS)
-> (TessWinding -> String)
-> ([TessWinding] -> ShowS)
-> Show TessWinding
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

--------------------------------------------------------------------------------

-- | The basic building block in tessellation is a 3D vertex with an associated
-- property, e.g. color, texture coordinates, etc.

data AnnotatedVertex v = AnnotatedVertex (Vertex3 GLdouble) v
   deriving ( AnnotatedVertex v -> AnnotatedVertex v -> Bool
(AnnotatedVertex v -> AnnotatedVertex v -> Bool)
-> (AnnotatedVertex v -> AnnotatedVertex v -> Bool)
-> Eq (AnnotatedVertex v)
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, Eq (AnnotatedVertex v)
Eq (AnnotatedVertex v)
-> (AnnotatedVertex v -> AnnotatedVertex v -> Ordering)
-> (AnnotatedVertex v -> AnnotatedVertex v -> Bool)
-> (AnnotatedVertex v -> AnnotatedVertex v -> Bool)
-> (AnnotatedVertex v -> AnnotatedVertex v -> Bool)
-> (AnnotatedVertex v -> AnnotatedVertex v -> Bool)
-> (AnnotatedVertex v -> AnnotatedVertex v -> AnnotatedVertex v)
-> (AnnotatedVertex v -> AnnotatedVertex v -> AnnotatedVertex v)
-> Ord (AnnotatedVertex v)
AnnotatedVertex v -> AnnotatedVertex v -> Bool
AnnotatedVertex v -> AnnotatedVertex v -> Ordering
AnnotatedVertex v -> AnnotatedVertex v -> AnnotatedVertex 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 (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 = v -> Int -> Int
forall a. Storable a => a -> Int -> Int
alignOffset v
v (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* GLdouble -> Int
forall v. Storable v => v -> Int
sizeOf GLdouble
x)
   where AnnotatedVertex (Vertex3 GLdouble
x GLdouble
_ GLdouble
_) Any
_ = AnnotatedVertex 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
a)
   where a :: Int
a = a -> Int
forall v. Storable v => v -> Int
alignment a
x
         n :: Int
n = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Int
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) =
      GLdouble -> Int -> Int
forall a. Storable a => a -> Int -> Int
alignOffset GLdouble
x (v -> Int
forall v. Storable v => v -> Int
sizeOf v
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ v -> Int
forall v. Storable v => v -> Int
offsetOfProperty v
v)

   alignment :: AnnotatedVertex v -> Int
alignment ~(AnnotatedVertex (Vertex3 GLdouble
x GLdouble
_ GLdouble
_) v
_) =
      GLdouble -> Int
forall v. Storable v => v -> Int
alignment GLdouble
x

   peek :: Ptr (AnnotatedVertex v) -> IO (AnnotatedVertex v)
peek Ptr (AnnotatedVertex v)
ptr = do
      GLdouble
x <- Ptr GLdouble -> Int -> IO GLdouble
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr (AnnotatedVertex v) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
0
      GLdouble
y <- Ptr GLdouble -> Int -> IO GLdouble
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr (AnnotatedVertex v) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
1
      GLdouble
z <- Ptr GLdouble -> Int -> IO GLdouble
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr (AnnotatedVertex v) -> Ptr GLdouble
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 = Ptr (AnnotatedVertex v) -> v
forall a. HasCallStack => a
undefined
      v
v <- Ptr Any -> Int -> IO v
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (Ptr (AnnotatedVertex v) -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) (v -> Int
forall v. Storable v => v -> Int
offsetOfProperty (Ptr (AnnotatedVertex v) -> v
forall v. Ptr (AnnotatedVertex v) -> v
dummyElement Ptr (AnnotatedVertex v)
ptr))
      AnnotatedVertex v -> IO (AnnotatedVertex v)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnotatedVertex v -> IO (AnnotatedVertex v))
-> AnnotatedVertex v -> IO (AnnotatedVertex v)
forall a b. (a -> b) -> a -> b
$ Vertex3 GLdouble -> v -> AnnotatedVertex v
forall v. Vertex3 GLdouble -> v -> AnnotatedVertex v
AnnotatedVertex (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
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
      Ptr GLdouble -> Int -> GLdouble -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr (AnnotatedVertex v) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
0 GLdouble
x
      Ptr GLdouble -> Int -> GLdouble -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr (AnnotatedVertex v) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
1 GLdouble
y
      Ptr GLdouble -> Int -> GLdouble -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr (AnnotatedVertex v) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Int
2 GLdouble
z
      Ptr Any -> Int -> v -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr (AnnotatedVertex v) -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) (v -> Int
forall v. Storable v => v -> Int
offsetOfProperty v
v) v
v

--------------------------------------------------------------------------------

-- | A complex contour, which can be self-intersecting and\/or concave.

newtype ComplexContour v = ComplexContour [AnnotatedVertex v]
   deriving ( ComplexContour v -> ComplexContour v -> Bool
(ComplexContour v -> ComplexContour v -> Bool)
-> (ComplexContour v -> ComplexContour v -> Bool)
-> Eq (ComplexContour v)
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, Eq (ComplexContour v)
Eq (ComplexContour v)
-> (ComplexContour v -> ComplexContour v -> Ordering)
-> (ComplexContour v -> ComplexContour v -> Bool)
-> (ComplexContour v -> ComplexContour v -> Bool)
-> (ComplexContour v -> ComplexContour v -> Bool)
-> (ComplexContour v -> ComplexContour v -> Bool)
-> (ComplexContour v -> ComplexContour v -> ComplexContour v)
-> (ComplexContour v -> ComplexContour v -> ComplexContour v)
-> Ord (ComplexContour v)
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) =
   [AnnotatedVertex v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AnnotatedVertex v]
vs Int -> Int -> Int
forall a. Num a => a -> a -> a
* AnnotatedVertex v -> Int
forall v. Storable v => v -> Int
sizeOf ([AnnotatedVertex v] -> AnnotatedVertex v
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) =
   Ptr (AnnotatedVertex v) -> [AnnotatedVertex v] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (Ptr (ComplexContour v) -> Ptr (AnnotatedVertex v)
forall a b. Ptr a -> Ptr b
castPtr Ptr (ComplexContour v)
ptr) [AnnotatedVertex v]
vs

--------------------------------------------------------------------------------

-- | A complex (possibly concave) polygon, represented by one or more complex
-- and possibly intersecting contours.

newtype ComplexPolygon v = ComplexPolygon [ComplexContour v]
   deriving ( ComplexPolygon v -> ComplexPolygon v -> Bool
(ComplexPolygon v -> ComplexPolygon v -> Bool)
-> (ComplexPolygon v -> ComplexPolygon v -> Bool)
-> Eq (ComplexPolygon v)
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, Eq (ComplexPolygon v)
Eq (ComplexPolygon v)
-> (ComplexPolygon v -> ComplexPolygon v -> Ordering)
-> (ComplexPolygon v -> ComplexPolygon v -> Bool)
-> (ComplexPolygon v -> ComplexPolygon v -> Bool)
-> (ComplexPolygon v -> ComplexPolygon v -> Bool)
-> (ComplexPolygon v -> ComplexPolygon v -> Bool)
-> (ComplexPolygon v -> ComplexPolygon v -> ComplexPolygon v)
-> (ComplexPolygon v -> ComplexPolygon v -> ComplexPolygon v)
-> Ord (ComplexPolygon v)
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) =
   [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ComplexContour v -> Int) -> [ComplexContour v] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ComplexContour v -> Int
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) =
   (Ptr (ComplexContour v)
 -> ComplexContour v -> IO (Ptr (ComplexContour v)))
-> Ptr (ComplexContour v) -> [ComplexContour v] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Ptr (ComplexContour v)
-> ComplexContour v -> IO (Ptr (ComplexContour v))
forall {v} {b}.
Storable v =>
Ptr (ComplexContour v) -> ComplexContour v -> IO (Ptr b)
pokeAndAdvance (Ptr (ComplexPolygon v) -> Ptr (ComplexContour v)
forall a b. Ptr a -> Ptr b
castPtr Ptr (ComplexPolygon v)
ptr) [ComplexContour v]
complexContours IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
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
            Ptr (ComplexContour v) -> ComplexContour v -> IO ()
forall v.
Storable v =>
Ptr (ComplexContour v) -> ComplexContour v -> IO ()
pokeComplexContour Ptr (ComplexContour v)
p ComplexContour v
complexContour
            Ptr b -> IO (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr b -> IO (Ptr b)) -> Ptr b -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ Ptr (ComplexContour v)
p Ptr (ComplexContour v) -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ComplexContour v -> Int
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 =
   Int -> (Ptr (ComplexPolygon v) -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (ComplexPolygon v -> Int
forall v. Storable v => ComplexPolygon v -> Int
sizeOfComplexPolygon ComplexPolygon v
complexPolygon) ((Ptr (ComplexPolygon v) -> IO a) -> IO a)
-> (Ptr (ComplexPolygon v) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (ComplexPolygon v)
ptr -> do
      Ptr (ComplexPolygon v) -> ComplexPolygon v -> IO ()
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

--------------------------------------------------------------------------------

-- | Four vertex properties (cf. 'AnnotatedVertex') with associated weigths
-- summing up to 1.0.

data WeightedProperties v
   = WeightedProperties (GLfloat, v)
                        (GLfloat, v)
                        (GLfloat, v)
                        (GLfloat, v)
   deriving ( WeightedProperties v -> WeightedProperties v -> Bool
(WeightedProperties v -> WeightedProperties v -> Bool)
-> (WeightedProperties v -> WeightedProperties v -> Bool)
-> Eq (WeightedProperties v)
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, Eq (WeightedProperties v)
Eq (WeightedProperties v)
-> (WeightedProperties v -> WeightedProperties v -> Ordering)
-> (WeightedProperties v -> WeightedProperties v -> Bool)
-> (WeightedProperties v -> WeightedProperties v -> Bool)
-> (WeightedProperties v -> WeightedProperties v -> Bool)
-> (WeightedProperties v -> WeightedProperties v -> Bool)
-> (WeightedProperties v
    -> WeightedProperties v -> WeightedProperties v)
-> (WeightedProperties v
    -> WeightedProperties v -> WeightedProperties v)
-> Ord (WeightedProperties v)
WeightedProperties v -> WeightedProperties v -> Bool
WeightedProperties v -> WeightedProperties v -> Ordering
WeightedProperties v
-> WeightedProperties v -> WeightedProperties 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 (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 )

-- | A function combining given vertex properties into a property for a newly
-- generated vertex

type Combiner v
    = Vertex3 GLdouble
   -> WeightedProperties v
   -> v

--------------------------------------------------------------------------------

-- | The relative tolerance under which two vertices can be combined (see
-- 'Combiner'). Multiplication with the largest coordinate magnitude of all
-- polygon vertices yields the maximum distance between two mergeable vertices.
--
-- Note that merging is optional and the tolerance is only a hint.

type Tolerance = GLdouble

--------------------------------------------------------------------------------

-- | A general tessellator type.
--
-- Before tessellation of a complex polygon, all its vertices are projected into
-- a plane perpendicular to the given normal. If the given normal is
-- @Normal3 0 0 0@, a fitting plane of all vertices is used.

type Tessellator p v
   = TessWinding
  -> Tolerance
  -> Normal3 GLdouble
  -> Combiner v
  -> ComplexPolygon v
  -> IO (p v)

--------------------------------------------------------------------------------

-- | A simple, non-self-intersecting contour

newtype SimpleContour v = SimpleContour [AnnotatedVertex v]
   deriving ( SimpleContour v -> SimpleContour v -> Bool
(SimpleContour v -> SimpleContour v -> Bool)
-> (SimpleContour v -> SimpleContour v -> Bool)
-> Eq (SimpleContour v)
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, Eq (SimpleContour v)
Eq (SimpleContour v)
-> (SimpleContour v -> SimpleContour v -> Ordering)
-> (SimpleContour v -> SimpleContour v -> Bool)
-> (SimpleContour v -> SimpleContour v -> Bool)
-> (SimpleContour v -> SimpleContour v -> Bool)
-> (SimpleContour v -> SimpleContour v -> Bool)
-> (SimpleContour v -> SimpleContour v -> SimpleContour v)
-> (SimpleContour v -> SimpleContour v -> SimpleContour v)
-> Ord (SimpleContour v)
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 )

-- | The contours of a complex polygon, represented by one or more
-- non-intersecting simple contours

newtype PolygonContours v = PolygonContours [SimpleContour v]
   deriving ( PolygonContours v -> PolygonContours v -> Bool
(PolygonContours v -> PolygonContours v -> Bool)
-> (PolygonContours v -> PolygonContours v -> Bool)
-> Eq (PolygonContours v)
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, Eq (PolygonContours v)
Eq (PolygonContours v)
-> (PolygonContours v -> PolygonContours v -> Ordering)
-> (PolygonContours v -> PolygonContours v -> Bool)
-> (PolygonContours v -> PolygonContours v -> Bool)
-> (PolygonContours v -> PolygonContours v -> Bool)
-> (PolygonContours v -> PolygonContours v -> Bool)
-> (PolygonContours v -> PolygonContours v -> PolygonContours v)
-> (PolygonContours v -> PolygonContours v -> PolygonContours v)
-> Ord (PolygonContours v)
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
extractContours :: forall v. Storable v => Tessellator PolygonContours v
extractContours TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Combiner v
combiner ComplexPolygon v
complexPoly = do

   IORef [AnnotatedVertex v]
vertices <- [AnnotatedVertex v] -> IO (IORef [AnnotatedVertex v])
forall a. a -> IO (IORef a)
newIORef []
   let addVertex :: AnnotatedVertex v -> IO ()
addVertex AnnotatedVertex v
v = IORef [AnnotatedVertex v]
-> ([AnnotatedVertex v] -> [AnnotatedVertex v]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [AnnotatedVertex v]
vertices (AnnotatedVertex v
vAnnotatedVertex v -> [AnnotatedVertex v] -> [AnnotatedVertex v]
forall a. a -> [a] -> [a]
:)

   IORef [SimpleContour v]
contours <- [SimpleContour v] -> IO (IORef [SimpleContour v])
forall a. a -> IO (IORef a)
newIORef []
   let finishContour :: IO ()
finishContour = do
          [AnnotatedVertex v]
vs <- IORef [AnnotatedVertex v] -> IO [AnnotatedVertex v]
forall a. IORef a -> IO a
readIORef IORef [AnnotatedVertex v]
vertices
          IORef [AnnotatedVertex v] -> [AnnotatedVertex v] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [AnnotatedVertex v]
vertices []
          IORef [SimpleContour v]
-> ([SimpleContour v] -> [SimpleContour v]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [SimpleContour v]
contours ([AnnotatedVertex v] -> SimpleContour v
forall v. [AnnotatedVertex v] -> SimpleContour v
SimpleContour ([AnnotatedVertex v] -> [AnnotatedVertex v]
forall a. [a] -> [a]
reverse [AnnotatedVertex v]
vs) SimpleContour v -> [SimpleContour v] -> [SimpleContour v]
forall a. a -> [a] -> [a]
:)

       getContours :: IO (PolygonContours v)
getContours = ([SimpleContour v] -> PolygonContours v)
-> IO [SimpleContour v] -> IO (PolygonContours v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SimpleContour v] -> PolygonContours v
forall v. [SimpleContour v] -> PolygonContours v
PolygonContours ([SimpleContour v] -> PolygonContours v)
-> ([SimpleContour v] -> [SimpleContour v])
-> [SimpleContour v]
-> PolygonContours v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SimpleContour v] -> [SimpleContour v]
forall a. [a] -> [a]
reverse) (IORef [SimpleContour v] -> IO [SimpleContour v]
forall a. IORef a -> IO a
readIORef IORef [SimpleContour v]
contours)

   PolygonContours v
-> (Ptr GLUtesselator -> IO (PolygonContours v))
-> IO (PolygonContours v)
forall a. a -> (Ptr GLUtesselator -> IO a) -> IO a
withTessellatorObj ([SimpleContour v] -> PolygonContours v
forall v. [SimpleContour v] -> PolygonContours v
PolygonContours [])((Ptr GLUtesselator -> IO (PolygonContours v))
 -> IO (PolygonContours v))
-> (Ptr GLUtesselator -> IO (PolygonContours v))
-> IO (PolygonContours v)
forall a b. (a -> b) -> a -> b
$ \Ptr GLUtesselator
tessObj -> do
      Ptr GLUtesselator
-> TessWinding -> GLdouble -> Normal3 GLdouble -> Bool -> IO ()
setTessellatorProperties Ptr GLUtesselator
tessObj TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Bool
True
      Ptr GLUtesselator
-> (AnnotatedVertex v -> IO ())
-> IO (PolygonContours v)
-> IO (PolygonContours v)
forall v a.
Storable v =>
Ptr GLUtesselator -> VertexCallback v -> IO a -> IO a
withVertexCallback Ptr GLUtesselator
tessObj AnnotatedVertex v -> IO ()
addVertex (IO (PolygonContours v) -> IO (PolygonContours v))
-> IO (PolygonContours v) -> IO (PolygonContours v)
forall a b. (a -> b) -> a -> b
$
         Ptr GLUtesselator
-> IO () -> IO (PolygonContours v) -> IO (PolygonContours v)
forall a. Ptr GLUtesselator -> IO () -> IO a -> IO a
withEndCallback Ptr GLUtesselator
tessObj IO ()
finishContour (IO (PolygonContours v) -> IO (PolygonContours v))
-> IO (PolygonContours v) -> IO (PolygonContours v)
forall a b. (a -> b) -> a -> b
$
            Ptr GLUtesselator
-> IO (PolygonContours v) -> IO (PolygonContours v)
forall a. Ptr GLUtesselator -> IO a -> IO a
checkForError Ptr GLUtesselator
tessObj (IO (PolygonContours v) -> IO (PolygonContours v))
-> IO (PolygonContours v) -> IO (PolygonContours v)
forall a b. (a -> b) -> a -> b
$
               Ptr GLUtesselator
-> Combiner v -> IO (PolygonContours v) -> IO (PolygonContours v)
forall v a.
Storable v =>
Ptr GLUtesselator -> Combiner v -> IO a -> IO a
withCombineCallback Ptr GLUtesselator
tessObj Combiner v
combiner (IO (PolygonContours v) -> IO (PolygonContours v))
-> IO (PolygonContours v) -> IO (PolygonContours v)
forall a b. (a -> b) -> a -> b
$ do
                  Ptr GLUtesselator -> ComplexPolygon v -> IO ()
forall v.
Storable v =>
Ptr GLUtesselator -> ComplexPolygon v -> IO ()
defineComplexPolygon Ptr GLUtesselator
tessObj ComplexPolygon v
complexPoly
                  IO (PolygonContours v)
getContours

--------------------------------------------------------------------------------

-- | A triangle vertex with additional information about the edge it begins

type TriangleVertex v = AnnotatedVertex (v,EdgeFlag)

-- | A triangle, represented by three triangle vertices

data Triangle v
   = Triangle (TriangleVertex v) (TriangleVertex v) (TriangleVertex v)
   deriving ( Triangle v -> Triangle v -> Bool
(Triangle v -> Triangle v -> Bool)
-> (Triangle v -> Triangle v -> Bool) -> Eq (Triangle v)
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, Eq (Triangle v)
Eq (Triangle v)
-> (Triangle v -> Triangle v -> Ordering)
-> (Triangle v -> Triangle v -> Bool)
-> (Triangle v -> Triangle v -> Bool)
-> (Triangle v -> Triangle v -> Bool)
-> (Triangle v -> Triangle v -> Bool)
-> (Triangle v -> Triangle v -> Triangle v)
-> (Triangle v -> Triangle v -> Triangle v)
-> Ord (Triangle v)
Triangle v -> Triangle v -> Bool
Triangle v -> Triangle v -> Ordering
Triangle v -> Triangle v -> Triangle 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 (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 )

-- | A triangulation of a complex polygon

newtype Triangulation v = Triangulation [Triangle v]
   deriving ( Triangulation v -> Triangulation v -> Bool
(Triangulation v -> Triangulation v -> Bool)
-> (Triangulation v -> Triangulation v -> Bool)
-> Eq (Triangulation v)
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, Eq (Triangulation v)
Eq (Triangulation v)
-> (Triangulation v -> Triangulation v -> Ordering)
-> (Triangulation v -> Triangulation v -> Bool)
-> (Triangulation v -> Triangulation v -> Bool)
-> (Triangulation v -> Triangulation v -> Bool)
-> (Triangulation v -> Triangulation v -> Bool)
-> (Triangulation v -> Triangulation v -> Triangulation v)
-> (Triangulation v -> Triangulation v -> Triangulation v)
-> Ord (Triangulation v)
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 <- EdgeFlag -> IO (IORef EdgeFlag)
forall a. a -> IO (IORef a)
newIORef EdgeFlag
BeginsInteriorEdge
   let registerEdgeFlag :: EdgeFlag -> IO ()
registerEdgeFlag = IORef EdgeFlag -> EdgeFlag -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef EdgeFlag
edgeFlagState

   IORef [TriangleVertex v]
vertices <- [TriangleVertex v] -> IO (IORef [TriangleVertex v])
forall a. a -> IO (IORef a)
newIORef []
   let addVertex :: AnnotatedVertex v -> IO ()
addVertex (AnnotatedVertex Vertex3 GLdouble
xyz v
v) = do
          EdgeFlag
ef <- IORef EdgeFlag -> IO EdgeFlag
forall a. IORef a -> IO a
readIORef IORef EdgeFlag
edgeFlagState
          IORef [TriangleVertex v]
-> ([TriangleVertex v] -> [TriangleVertex v]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [TriangleVertex v]
vertices (Vertex3 GLdouble -> (v, EdgeFlag) -> TriangleVertex v
forall v. Vertex3 GLdouble -> v -> AnnotatedVertex v
AnnotatedVertex Vertex3 GLdouble
xyz (v
v,EdgeFlag
ef) TriangleVertex v -> [TriangleVertex v] -> [TriangleVertex v]
forall a. a -> [a] -> [a]
:)

       getTriangulation :: IO (Triangulation v)
getTriangulation = do
          [TriangleVertex v]
vs <- IORef [TriangleVertex v] -> IO [TriangleVertex v]
forall a. IORef a -> IO a
readIORef IORef [TriangleVertex v]
vertices
          Triangulation v -> IO (Triangulation v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Triangulation v -> IO (Triangulation v))
-> Triangulation v -> IO (Triangulation v)
forall a b. (a -> b) -> a -> b
$ [Triangle v] -> Triangulation v
forall v. [Triangle v] -> Triangulation v
Triangulation ([TriangleVertex v] -> [Triangle v]
forall v. [TriangleVertex v] -> [Triangle v]
collectTriangles ([TriangleVertex v] -> [TriangleVertex v]
forall a. [a] -> [a]
reverse [TriangleVertex v]
vs))

   Triangulation v
-> (Ptr GLUtesselator -> IO (Triangulation v))
-> IO (Triangulation v)
forall a. a -> (Ptr GLUtesselator -> IO a) -> IO a
withTessellatorObj ([Triangle v] -> Triangulation v
forall v. [Triangle v] -> Triangulation v
Triangulation []) ((Ptr GLUtesselator -> IO (Triangulation v))
 -> IO (Triangulation v))
-> (Ptr GLUtesselator -> IO (Triangulation v))
-> IO (Triangulation v)
forall a b. (a -> b) -> a -> b
$ \Ptr GLUtesselator
tessObj -> do
      Ptr GLUtesselator
-> TessWinding -> GLdouble -> Normal3 GLdouble -> Bool -> IO ()
setTessellatorProperties Ptr GLUtesselator
tessObj TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Bool
False
      Ptr GLUtesselator
-> (EdgeFlag -> IO ())
-> IO (Triangulation v)
-> IO (Triangulation v)
forall a. Ptr GLUtesselator -> (EdgeFlag -> IO ()) -> IO a -> IO a
withEdgeFlagCallback Ptr GLUtesselator
tessObj EdgeFlag -> IO ()
registerEdgeFlag (IO (Triangulation v) -> IO (Triangulation v))
-> IO (Triangulation v) -> IO (Triangulation v)
forall a b. (a -> b) -> a -> b
$
         Ptr GLUtesselator
-> (AnnotatedVertex v -> IO ())
-> IO (Triangulation v)
-> IO (Triangulation v)
forall v a.
Storable v =>
Ptr GLUtesselator -> VertexCallback v -> IO a -> IO a
withVertexCallback Ptr GLUtesselator
tessObj AnnotatedVertex v -> IO ()
addVertex (IO (Triangulation v) -> IO (Triangulation v))
-> IO (Triangulation v) -> IO (Triangulation v)
forall a b. (a -> b) -> a -> b
$
            Ptr GLUtesselator -> IO (Triangulation v) -> IO (Triangulation v)
forall a. Ptr GLUtesselator -> IO a -> IO a
checkForError Ptr GLUtesselator
tessObj (IO (Triangulation v) -> IO (Triangulation v))
-> IO (Triangulation v) -> IO (Triangulation v)
forall a b. (a -> b) -> a -> b
$
               Ptr GLUtesselator
-> Combiner v -> IO (Triangulation v) -> IO (Triangulation v)
forall v a.
Storable v =>
Ptr GLUtesselator -> Combiner v -> IO a -> IO a
withCombineCallback Ptr GLUtesselator
tessObj Combiner v
combiner (IO (Triangulation v) -> IO (Triangulation v))
-> IO (Triangulation v) -> IO (Triangulation v)
forall a b. (a -> b) -> a -> b
$ do
                  Ptr GLUtesselator -> ComplexPolygon v -> IO ()
forall v.
Storable v =>
Ptr GLUtesselator -> ComplexPolygon v -> IO ()
defineComplexPolygon Ptr GLUtesselator
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) = TriangleVertex v
-> TriangleVertex v -> TriangleVertex v -> Triangle v
forall v.
TriangleVertex v
-> TriangleVertex v -> TriangleVertex v -> Triangle v
Triangle TriangleVertex v
a TriangleVertex v
b TriangleVertex v
c Triangle v -> [Triangle v] -> [Triangle v]
forall a. a -> [a] -> [a]
: [TriangleVertex v] -> [Triangle v]
forall v. [TriangleVertex v] -> [Triangle v]
collectTriangles [TriangleVertex v]
rest
collectTriangles [TriangleVertex v]
_            = String -> [Triangle v]
forall a. HasCallStack => String -> a
error String
"triangles left"

--------------------------------------------------------------------------------

data Primitive v = Primitive PrimitiveMode [AnnotatedVertex v]
   deriving ( Primitive v -> Primitive v -> Bool
(Primitive v -> Primitive v -> Bool)
-> (Primitive v -> Primitive v -> Bool) -> Eq (Primitive v)
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, Eq (Primitive v)
Eq (Primitive v)
-> (Primitive v -> Primitive v -> Ordering)
-> (Primitive v -> Primitive v -> Bool)
-> (Primitive v -> Primitive v -> Bool)
-> (Primitive v -> Primitive v -> Bool)
-> (Primitive v -> Primitive v -> Bool)
-> (Primitive v -> Primitive v -> Primitive v)
-> (Primitive v -> Primitive v -> Primitive v)
-> Ord (Primitive v)
Primitive v -> Primitive v -> Bool
Primitive v -> Primitive v -> Ordering
Primitive v -> Primitive v -> Primitive 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 (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
(SimplePolygon v -> SimplePolygon v -> Bool)
-> (SimplePolygon v -> SimplePolygon v -> Bool)
-> Eq (SimplePolygon v)
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, Eq (SimplePolygon v)
Eq (SimplePolygon v)
-> (SimplePolygon v -> SimplePolygon v -> Ordering)
-> (SimplePolygon v -> SimplePolygon v -> Bool)
-> (SimplePolygon v -> SimplePolygon v -> Bool)
-> (SimplePolygon v -> SimplePolygon v -> Bool)
-> (SimplePolygon v -> SimplePolygon v -> Bool)
-> (SimplePolygon v -> SimplePolygon v -> SimplePolygon v)
-> (SimplePolygon v -> SimplePolygon v -> SimplePolygon v)
-> Ord (SimplePolygon v)
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 <- PrimitiveMode -> IO (IORef PrimitiveMode)
forall a. a -> IO (IORef a)
newIORef PrimitiveMode
forall a. HasCallStack => a
undefined
   let setPrimitiveMode :: PrimitiveMode -> IO ()
setPrimitiveMode = IORef PrimitiveMode -> PrimitiveMode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef PrimitiveMode
beginModeState

   IORef [AnnotatedVertex v]
vertices <- [AnnotatedVertex v] -> IO (IORef [AnnotatedVertex v])
forall a. a -> IO (IORef a)
newIORef []
   let addVertex :: AnnotatedVertex v -> IO ()
addVertex AnnotatedVertex v
v = IORef [AnnotatedVertex v]
-> ([AnnotatedVertex v] -> [AnnotatedVertex v]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [AnnotatedVertex v]
vertices (AnnotatedVertex v
vAnnotatedVertex v -> [AnnotatedVertex v] -> [AnnotatedVertex v]
forall a. a -> [a] -> [a]
:)

   IORef [Primitive v]
primitives <- [Primitive v] -> IO (IORef [Primitive v])
forall a. a -> IO (IORef a)
newIORef []
   let finishPrimitive :: IO ()
finishPrimitive = do
          PrimitiveMode
beginMode <- IORef PrimitiveMode -> IO PrimitiveMode
forall a. IORef a -> IO a
readIORef IORef PrimitiveMode
beginModeState
          [AnnotatedVertex v]
vs <- IORef [AnnotatedVertex v] -> IO [AnnotatedVertex v]
forall a. IORef a -> IO a
readIORef IORef [AnnotatedVertex v]
vertices
          IORef [AnnotatedVertex v] -> [AnnotatedVertex v] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [AnnotatedVertex v]
vertices []
          IORef [Primitive v] -> ([Primitive v] -> [Primitive v]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [Primitive v]
primitives (PrimitiveMode -> [AnnotatedVertex v] -> Primitive v
forall v. PrimitiveMode -> [AnnotatedVertex v] -> Primitive v
Primitive PrimitiveMode
beginMode ([AnnotatedVertex v] -> [AnnotatedVertex v]
forall a. [a] -> [a]
reverse [AnnotatedVertex v]
vs) Primitive v -> [Primitive v] -> [Primitive v]
forall a. a -> [a] -> [a]
:)

       getSimplePolygon :: IO (SimplePolygon v)
getSimplePolygon = ([Primitive v] -> SimplePolygon v)
-> IO [Primitive v] -> IO (SimplePolygon v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Primitive v] -> SimplePolygon v
forall v. [Primitive v] -> SimplePolygon v
SimplePolygon ([Primitive v] -> SimplePolygon v)
-> ([Primitive v] -> [Primitive v])
-> [Primitive v]
-> SimplePolygon v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive v] -> [Primitive v]
forall a. [a] -> [a]
reverse) (IORef [Primitive v] -> IO [Primitive v]
forall a. IORef a -> IO a
readIORef IORef [Primitive v]
primitives)

   SimplePolygon v
-> (Ptr GLUtesselator -> IO (SimplePolygon v))
-> IO (SimplePolygon v)
forall a. a -> (Ptr GLUtesselator -> IO a) -> IO a
withTessellatorObj ([Primitive v] -> SimplePolygon v
forall v. [Primitive v] -> SimplePolygon v
SimplePolygon []) ((Ptr GLUtesselator -> IO (SimplePolygon v))
 -> IO (SimplePolygon v))
-> (Ptr GLUtesselator -> IO (SimplePolygon v))
-> IO (SimplePolygon v)
forall a b. (a -> b) -> a -> b
$ \Ptr GLUtesselator
tessObj -> do
      Ptr GLUtesselator
-> TessWinding -> GLdouble -> Normal3 GLdouble -> Bool -> IO ()
setTessellatorProperties Ptr GLUtesselator
tessObj TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Bool
False
      Ptr GLUtesselator
-> (PrimitiveMode -> IO ())
-> IO (SimplePolygon v)
-> IO (SimplePolygon v)
forall a.
Ptr GLUtesselator -> (PrimitiveMode -> IO ()) -> IO a -> IO a
withBeginCallback Ptr GLUtesselator
tessObj PrimitiveMode -> IO ()
setPrimitiveMode (IO (SimplePolygon v) -> IO (SimplePolygon v))
-> IO (SimplePolygon v) -> IO (SimplePolygon v)
forall a b. (a -> b) -> a -> b
$
         Ptr GLUtesselator
-> (AnnotatedVertex v -> IO ())
-> IO (SimplePolygon v)
-> IO (SimplePolygon v)
forall v a.
Storable v =>
Ptr GLUtesselator -> VertexCallback v -> IO a -> IO a
withVertexCallback Ptr GLUtesselator
tessObj AnnotatedVertex v -> IO ()
addVertex (IO (SimplePolygon v) -> IO (SimplePolygon v))
-> IO (SimplePolygon v) -> IO (SimplePolygon v)
forall a b. (a -> b) -> a -> b
$
            Ptr GLUtesselator
-> IO () -> IO (SimplePolygon v) -> IO (SimplePolygon v)
forall a. Ptr GLUtesselator -> IO () -> IO a -> IO a
withEndCallback Ptr GLUtesselator
tessObj IO ()
finishPrimitive (IO (SimplePolygon v) -> IO (SimplePolygon v))
-> IO (SimplePolygon v) -> IO (SimplePolygon v)
forall a b. (a -> b) -> a -> b
$
               Ptr GLUtesselator -> IO (SimplePolygon v) -> IO (SimplePolygon v)
forall a. Ptr GLUtesselator -> IO a -> IO a
checkForError Ptr GLUtesselator
tessObj (IO (SimplePolygon v) -> IO (SimplePolygon v))
-> IO (SimplePolygon v) -> IO (SimplePolygon v)
forall a b. (a -> b) -> a -> b
$
                  Ptr GLUtesselator
-> Combiner v -> IO (SimplePolygon v) -> IO (SimplePolygon v)
forall v a.
Storable v =>
Ptr GLUtesselator -> Combiner v -> IO a -> IO a
withCombineCallback Ptr GLUtesselator
tessObj Combiner v
combiner (IO (SimplePolygon v) -> IO (SimplePolygon v))
-> IO (SimplePolygon v) -> IO (SimplePolygon v)
forall a b. (a -> b) -> a -> b
$ do
                     Ptr GLUtesselator -> ComplexPolygon v -> IO ()
forall v.
Storable v =>
Ptr GLUtesselator -> ComplexPolygon v -> IO ()
defineComplexPolygon Ptr GLUtesselator
tessObj ComplexPolygon v
complexPoly
                     IO (SimplePolygon v)
getSimplePolygon

--------------------------------------------------------------------------------
-- chapter 5.1: The Tessellation Object

-- an opaque pointer to a tessellator object
type TessellatorObj = Ptr GLUtesselator

isNullTesselatorObj :: TessellatorObj -> Bool
isNullTesselatorObj :: Ptr GLUtesselator -> Bool
isNullTesselatorObj = (Ptr GLUtesselator
forall a. Ptr a
nullPtr Ptr GLUtesselator -> Ptr GLUtesselator -> Bool
forall a. Eq a => a -> a -> Bool
==)

withTessellatorObj :: a -> (TessellatorObj -> IO a) -> IO a
withTessellatorObj :: forall a. a -> (Ptr GLUtesselator -> IO a) -> IO a
withTessellatorObj a
failureValue Ptr GLUtesselator -> IO a
action =
   IO (Ptr GLUtesselator)
-> (Ptr GLUtesselator -> IO ())
-> (Ptr GLUtesselator -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr GLUtesselator)
forall (m :: * -> *). MonadIO m => m (Ptr GLUtesselator)
gluNewTess Ptr GLUtesselator -> IO ()
safeDeleteTess
           (\Ptr GLUtesselator
tessObj -> if Ptr GLUtesselator -> Bool
isNullTesselatorObj Ptr GLUtesselator
tessObj
                           then do IO ()
recordOutOfMemory
                                   a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
failureValue
                           else Ptr GLUtesselator -> IO a
action Ptr GLUtesselator
tessObj)

safeDeleteTess :: TessellatorObj -> IO ()
safeDeleteTess :: Ptr GLUtesselator -> IO ()
safeDeleteTess Ptr GLUtesselator
tessObj =
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr GLUtesselator -> Bool
isNullTesselatorObj Ptr GLUtesselator
tessObj) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr GLUtesselator -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLUtesselator -> m ()
gluDeleteTess Ptr GLUtesselator
tessObj

--------------------------------------------------------------------------------
-- chapter 5.2: Polygon Definition (polygons)

defineComplexPolygon ::
   Storable v => TessellatorObj -> ComplexPolygon v -> IO ()
defineComplexPolygon :: forall v.
Storable v =>
Ptr GLUtesselator -> ComplexPolygon v -> IO ()
defineComplexPolygon Ptr GLUtesselator
tessObj cp :: ComplexPolygon v
cp@(ComplexPolygon [ComplexContour v]
complexContours) =
   ComplexPolygon v -> (Ptr (ComplexPolygon v) -> IO ()) -> IO ()
forall v a.
Storable v =>
ComplexPolygon v -> (Ptr (ComplexPolygon v) -> IO a) -> IO a
withComplexPolygon ComplexPolygon v
cp ((Ptr (ComplexPolygon v) -> IO ()) -> IO ())
-> (Ptr (ComplexPolygon v) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (ComplexPolygon v)
ptr ->
      Ptr GLUtesselator -> Ptr Any -> IO () -> IO ()
forall p a. Ptr GLUtesselator -> Ptr p -> IO a -> IO a
tessBeginEndPolygon Ptr GLUtesselator
tessObj Ptr Any
forall a. Ptr a
nullPtr (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         let loop :: Ptr b -> [ComplexContour v] -> IO ()
loop Ptr b
_ []     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             loop Ptr b
p (ComplexContour v
c:[ComplexContour v]
cs) = do Ptr GLUtesselator
-> Ptr (ComplexContour v) -> ComplexContour v -> IO ()
forall v.
Storable v =>
Ptr GLUtesselator
-> Ptr (ComplexContour v) -> ComplexContour v -> IO ()
defineComplexContour Ptr GLUtesselator
tessObj (Ptr b -> Ptr (ComplexContour v)
forall a b. Ptr a -> Ptr b
castPtr Ptr b
p) ComplexContour v
c
                                Ptr b -> [ComplexContour v] -> IO ()
loop (Ptr b
p Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ComplexContour v -> Int
forall v. Storable v => ComplexContour v -> Int
sizeOfComplexContour ComplexContour v
c) [ComplexContour v]
cs
         in Ptr (ComplexPolygon v) -> [ComplexContour v] -> IO ()
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. Ptr GLUtesselator -> Ptr p -> IO a -> IO a
tessBeginEndPolygon Ptr GLUtesselator
tessObj Ptr p
ptr IO a
f = do
   Ptr GLUtesselator -> Ptr p -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr GLUtesselator -> Ptr a -> m ()
gluTessBeginPolygon Ptr GLUtesselator
tessObj Ptr p
ptr
   a
res <- IO a
f
   Ptr GLUtesselator -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLUtesselator -> m ()
gluTessEndPolygon Ptr GLUtesselator
tessObj
   a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

--------------------------------------------------------------------------------
-- chapter 5.2: Polygon Definition (contours)

defineComplexContour ::
   Storable v =>
   TessellatorObj -> Ptr (ComplexContour v) -> ComplexContour v -> IO ()
defineComplexContour :: forall v.
Storable v =>
Ptr GLUtesselator
-> Ptr (ComplexContour v) -> ComplexContour v -> IO ()
defineComplexContour Ptr GLUtesselator
tessObj Ptr (ComplexContour v)
ptr (ComplexContour [AnnotatedVertex v]
annotatedVertices) =
   Ptr GLUtesselator -> IO () -> IO ()
forall a. Ptr GLUtesselator -> IO a -> IO a
tessBeginEndContour Ptr GLUtesselator
tessObj (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         let loop :: Ptr b -> [a] -> IO ()
loop Ptr b
_ []     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             loop Ptr b
p (a
v:[a]
vs) = do Ptr GLUtesselator -> Ptr (AnnotatedVertex Any) -> IO ()
forall v. Ptr GLUtesselator -> Ptr (AnnotatedVertex v) -> IO ()
defineVertex Ptr GLUtesselator
tessObj (Ptr b -> Ptr (AnnotatedVertex Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr b
p)
                                Ptr b -> [a] -> IO ()
loop (Ptr b
p Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall v. Storable v => v -> Int
sizeOf a
v) [a]
vs
         in Ptr (ComplexContour v) -> [AnnotatedVertex v] -> IO ()
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. Ptr GLUtesselator -> IO a -> IO a
tessBeginEndContour Ptr GLUtesselator
tessObj IO a
f = do
   Ptr GLUtesselator -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLUtesselator -> m ()
gluTessBeginContour Ptr GLUtesselator
tessObj
   a
res <- IO a
f
   Ptr GLUtesselator -> IO ()
forall (m :: * -> *). MonadIO m => Ptr GLUtesselator -> m ()
gluTessEndContour Ptr GLUtesselator
tessObj
   a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

--------------------------------------------------------------------------------
-- chapter 5.2: Polygon Definition (vertices)

defineVertex :: TessellatorObj -> Ptr (AnnotatedVertex v) -> IO ()
defineVertex :: forall v. Ptr GLUtesselator -> Ptr (AnnotatedVertex v) -> IO ()
defineVertex Ptr GLUtesselator
tessObj Ptr (AnnotatedVertex v)
ptr = Ptr GLUtesselator
-> Ptr GLdouble -> Ptr (AnnotatedVertex v) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr GLUtesselator -> Ptr GLdouble -> Ptr a -> m ()
gluTessVertex Ptr GLUtesselator
tessObj (Ptr (AnnotatedVertex v) -> Ptr GLdouble
forall a b. Ptr a -> Ptr b
castPtr Ptr (AnnotatedVertex v)
ptr) Ptr (AnnotatedVertex v)
ptr

--------------------------------------------------------------------------------
-- chapter 5.3: Callbacks (begin)

type BeginCallback  = PrimitiveMode -> IO ()

withBeginCallback :: TessellatorObj -> BeginCallback -> IO a -> IO a
withBeginCallback :: forall a.
Ptr GLUtesselator -> (PrimitiveMode -> IO ()) -> IO a -> IO a
withBeginCallback Ptr GLUtesselator
tessObj PrimitiveMode -> IO ()
beginCallback IO a
action =
   IO (FunPtr TessBeginCallback)
-> (FunPtr TessBeginCallback -> IO ())
-> (FunPtr TessBeginCallback -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TessBeginCallback -> IO (FunPtr TessBeginCallback)
makeTessBeginCallback (PrimitiveMode -> IO ()
beginCallback (PrimitiveMode -> IO ())
-> (GLenum -> PrimitiveMode) -> TessBeginCallback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> PrimitiveMode
unmarshalPrimitiveMode))
           FunPtr TessBeginCallback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr TessBeginCallback -> IO a) -> IO a)
-> (FunPtr TessBeginCallback -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr TessBeginCallback
callbackPtr -> do
      Ptr GLUtesselator -> GLenum -> FunPtr TessBeginCallback -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr GLUtesselator -> GLenum -> FunPtr a -> m ()
gluTessCallback Ptr GLUtesselator
tessObj GLenum
GLU_TESS_BEGIN FunPtr TessBeginCallback
callbackPtr
      IO a
action

--------------------------------------------------------------------------------
-- chapter 5.3: Callbacks (edgeFlag)

type EdgeFlagCallback  = EdgeFlag -> IO ()

withEdgeFlagCallback :: TessellatorObj -> EdgeFlagCallback -> IO a -> IO a
withEdgeFlagCallback :: forall a. Ptr GLUtesselator -> (EdgeFlag -> IO ()) -> IO a -> IO a
withEdgeFlagCallback Ptr GLUtesselator
tessObj EdgeFlag -> IO ()
edgeFlagCallback IO a
action =
   IO (FunPtr TessEdgeFlagCallback)
-> (FunPtr TessEdgeFlagCallback -> IO ())
-> (FunPtr TessEdgeFlagCallback -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TessEdgeFlagCallback -> IO (FunPtr TessEdgeFlagCallback)
makeTessEdgeFlagCallback (EdgeFlag -> IO ()
edgeFlagCallback (EdgeFlag -> IO ())
-> (GLboolean -> EdgeFlag) -> TessEdgeFlagCallback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLboolean -> EdgeFlag
unmarshalEdgeFlag))
           FunPtr TessEdgeFlagCallback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr TessEdgeFlagCallback -> IO a) -> IO a)
-> (FunPtr TessEdgeFlagCallback -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr TessEdgeFlagCallback
callbackPtr -> do
      Ptr GLUtesselator -> GLenum -> FunPtr TessEdgeFlagCallback -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr GLUtesselator -> GLenum -> FunPtr a -> m ()
gluTessCallback Ptr GLUtesselator
tessObj GLenum
GLU_TESS_EDGE_FLAG FunPtr TessEdgeFlagCallback
callbackPtr
      IO a
action

--------------------------------------------------------------------------------
-- chapter 5.3: Callbacks (vertex)

type VertexCallback v = AnnotatedVertex v -> IO ()

withVertexCallback ::
   Storable v => TessellatorObj -> VertexCallback v -> IO a -> IO a
withVertexCallback :: forall v a.
Storable v =>
Ptr GLUtesselator -> VertexCallback v -> IO a -> IO a
withVertexCallback Ptr GLUtesselator
tessObj VertexCallback v
vertexCallback IO a
action =
   IO (FunPtr (TessVertexCallback (AnnotatedVertex v)))
-> (FunPtr (TessVertexCallback (AnnotatedVertex v)) -> IO ())
-> (FunPtr (TessVertexCallback (AnnotatedVertex v)) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TessVertexCallback (AnnotatedVertex v)
-> IO (FunPtr (TessVertexCallback (AnnotatedVertex v)))
forall v.
TessVertexCallback v -> IO (FunPtr (TessVertexCallback v))
makeTessVertexCallback (\Ptr (AnnotatedVertex v)
p -> Ptr (AnnotatedVertex v) -> IO (AnnotatedVertex v)
forall a. Storable a => Ptr a -> IO a
peek Ptr (AnnotatedVertex v)
p IO (AnnotatedVertex v) -> VertexCallback v -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VertexCallback v
vertexCallback))
           FunPtr (TessVertexCallback (AnnotatedVertex v)) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr (TessVertexCallback (AnnotatedVertex v)) -> IO a) -> IO a)
-> (FunPtr (TessVertexCallback (AnnotatedVertex v)) -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr (TessVertexCallback (AnnotatedVertex v))
callbackPtr -> do
      Ptr GLUtesselator
-> GLenum
-> FunPtr (TessVertexCallback (AnnotatedVertex v))
-> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr GLUtesselator -> GLenum -> FunPtr a -> m ()
gluTessCallback Ptr GLUtesselator
tessObj GLenum
GLU_TESS_VERTEX FunPtr (TessVertexCallback (AnnotatedVertex v))
callbackPtr
      IO a
action

--------------------------------------------------------------------------------
-- chapter 5.3: Callbacks (end)

type EndCallback  = IO ()

withEndCallback :: TessellatorObj -> EndCallback -> IO a -> IO a
withEndCallback :: forall a. Ptr GLUtesselator -> IO () -> IO a -> IO a
withEndCallback Ptr GLUtesselator
tessObj IO ()
endCallback IO a
action =
   IO (FunPtr (IO ()))
-> (FunPtr (IO ()) -> IO ()) -> (FunPtr (IO ()) -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO () -> IO (FunPtr (IO ()))
makeTessEndCallback IO ()
endCallback) FunPtr (IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr (IO ()) -> IO a) -> IO a)
-> (FunPtr (IO ()) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr (IO ())
callbackPtr -> do
      Ptr GLUtesselator -> GLenum -> FunPtr (IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr GLUtesselator -> GLenum -> FunPtr a -> m ()
gluTessCallback Ptr GLUtesselator
tessObj GLenum
GLU_TESS_END FunPtr (IO ())
callbackPtr
      IO a
action

--------------------------------------------------------------------------------
-- chapter 5.3: Callbacks (error)

type ErrorCallback = GLenum -> IO ()

withErrorCallback :: TessellatorObj -> ErrorCallback -> IO a -> IO a
withErrorCallback :: forall a. Ptr GLUtesselator -> TessBeginCallback -> IO a -> IO a
withErrorCallback Ptr GLUtesselator
tessObj TessBeginCallback
errorCallback IO a
action =
   IO (FunPtr TessBeginCallback)
-> (FunPtr TessBeginCallback -> IO ())
-> (FunPtr TessBeginCallback -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TessBeginCallback -> IO (FunPtr TessBeginCallback)
makeTessErrorCallback TessBeginCallback
errorCallback)
           FunPtr TessBeginCallback -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr TessBeginCallback -> IO a) -> IO a)
-> (FunPtr TessBeginCallback -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr TessBeginCallback
callbackPtr -> do
      Ptr GLUtesselator -> GLenum -> FunPtr TessBeginCallback -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr GLUtesselator -> GLenum -> FunPtr a -> m ()
gluTessCallback Ptr GLUtesselator
tessObj GLenum
GLU_TESS_ERROR FunPtr TessBeginCallback
callbackPtr
      IO a
action

checkForError :: TessellatorObj -> IO a -> IO a
checkForError :: forall a. Ptr GLUtesselator -> IO a -> IO a
checkForError Ptr GLUtesselator
tessObj = Ptr GLUtesselator -> TessBeginCallback -> IO a -> IO a
forall a. Ptr GLUtesselator -> TessBeginCallback -> IO a -> IO a
withErrorCallback Ptr GLUtesselator
tessObj TessBeginCallback
recordErrorCode

--------------------------------------------------------------------------------
-- chapter 5.3: Callbacks (combine)

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 =>
Ptr GLUtesselator -> Combiner v -> IO a -> IO a
withCombineCallback Ptr GLUtesselator
tessObj Combiner v
combiner IO a
action =
   (Pool -> IO a) -> IO a
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO a) -> IO a) -> (Pool -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Pool
vertexPool ->
      IO (FunPtr (TessCombineCallback (AnnotatedVertex v)))
-> (FunPtr (TessCombineCallback (AnnotatedVertex v)) -> IO ())
-> (FunPtr (TessCombineCallback (AnnotatedVertex v)) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TessCombineCallback (AnnotatedVertex v)
-> IO (FunPtr (TessCombineCallback (AnnotatedVertex v)))
forall v.
TessCombineCallback v -> IO (FunPtr (TessCombineCallback v))
makeTessCombineCallback (Pool -> Combiner v -> TessCombineCallback (AnnotatedVertex v)
forall v. Storable v => Pool -> Combiner v -> CombineCallback v
combineProperties Pool
vertexPool Combiner v
combiner))
              FunPtr (TessCombineCallback (AnnotatedVertex v)) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr (TessCombineCallback (AnnotatedVertex v)) -> IO a)
 -> IO a)
-> (FunPtr (TessCombineCallback (AnnotatedVertex v)) -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \FunPtr (TessCombineCallback (AnnotatedVertex v))
callbackPtr -> do
         Ptr GLUtesselator
-> GLenum
-> FunPtr (TessCombineCallback (AnnotatedVertex v))
-> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr GLUtesselator -> GLenum -> FunPtr a -> m ()
gluTessCallback Ptr GLUtesselator
tessObj GLenum
GLU_TESS_COMBINE FunPtr (TessCombineCallback (AnnotatedVertex v))
callbackPtr
         IO a
action

-- NOTE: SGI's tesselator has a bug, sometimes passing NULL for the last two
-- vertices instead of valid vertex data, so we have to work around this. We
-- just pass the first vertex in these cases, which is OK, because the
-- corresponding weight is 0.
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 <- Ptr (Vertex3 GLdouble) -> IO (Vertex3 GLdouble)
forall a. Storable a => Ptr a -> IO a
peek (Ptr GLdouble -> Ptr (Vertex3 GLdouble)
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] <- (Int -> IO (Maybe v)) -> [Int] -> IO [Maybe v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr (Ptr (AnnotatedVertex v)) -> Int -> IO (Maybe v)
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] <- Int -> Ptr GLfloat -> IO [GLfloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr GLfloat
weights
   let defaultProperty :: v
defaultProperty = Maybe v -> v
forall a. HasCallStack => Maybe a -> a
fromJust Maybe v
v0
       f :: Maybe v -> v
f = v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
defaultProperty
       wp :: WeightedProperties v
wp = (GLfloat, v)
-> (GLfloat, v)
-> (GLfloat, v)
-> (GLfloat, v)
-> WeightedProperties v
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 = Vertex3 GLdouble -> v -> AnnotatedVertex v
forall v. Vertex3 GLdouble -> v -> AnnotatedVertex v
AnnotatedVertex Vertex3 GLdouble
newVertex (Combiner v
combiner Vertex3 GLdouble
newVertex WeightedProperties v
wp)
   Ptr (Ptr (AnnotatedVertex v)) -> Ptr (AnnotatedVertex v) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr (AnnotatedVertex v))
result (Ptr (AnnotatedVertex v) -> IO ())
-> IO (Ptr (AnnotatedVertex v)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pool -> AnnotatedVertex v -> IO (Ptr (AnnotatedVertex v))
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 = Ptr (Ptr (AnnotatedVertex v))
-> Int -> IO (Ptr (AnnotatedVertex v))
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr (AnnotatedVertex v))
propertyPtrs Int
n IO (Ptr (AnnotatedVertex v))
-> (Ptr (AnnotatedVertex v) -> IO (Maybe v)) -> IO (Maybe v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                             IO (Maybe v)
-> (Ptr (AnnotatedVertex v) -> IO (Maybe v))
-> Ptr (AnnotatedVertex v)
-> IO (Maybe v)
forall b a. b -> (Ptr a -> b) -> Ptr a -> b
maybeNullPtr (Maybe v -> IO (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing) Ptr (AnnotatedVertex v) -> IO (Maybe v)
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 <- Ptr (AnnotatedVertex v) -> IO (AnnotatedVertex v)
forall a. Storable a => Ptr a -> IO a
peek Ptr (AnnotatedVertex v)
ptr
   Maybe v -> IO (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return (v -> Maybe v
forall a. a -> Maybe a
Just v
v)

--------------------------------------------------------------------------------
-- chapter 5.4: Control over Tessellation

setTessellatorProperties ::
    TessellatorObj -> TessWinding -> Tolerance -> Normal3 GLdouble -> Bool
 -> IO ()
setTessellatorProperties :: Ptr GLUtesselator
-> TessWinding -> GLdouble -> Normal3 GLdouble -> Bool -> IO ()
setTessellatorProperties Ptr GLUtesselator
tessObj TessWinding
windingRule GLdouble
tolerance Normal3 GLdouble
theNormal Bool
boundaryOnly = do
   Ptr GLUtesselator -> TessWinding -> IO ()
setWindingRule Ptr GLUtesselator
tessObj TessWinding
windingRule
   Ptr GLUtesselator -> GLdouble -> IO ()
setTolerance Ptr GLUtesselator
tessObj GLdouble
tolerance
   Ptr GLUtesselator -> Normal3 GLdouble -> IO ()
setNormal Ptr GLUtesselator
tessObj Normal3 GLdouble
theNormal
   Ptr GLUtesselator -> Bool -> IO ()
setBoundaryOnly Ptr GLUtesselator
tessObj Bool
boundaryOnly

setWindingRule :: TessellatorObj -> TessWinding -> IO ()
setWindingRule :: Ptr GLUtesselator -> TessWinding -> IO ()
setWindingRule Ptr GLUtesselator
tessObj =
   Ptr GLUtesselator -> GLenum -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr GLUtesselator -> GLenum -> GLdouble -> m ()
gluTessProperty Ptr GLUtesselator
tessObj GLenum
GLU_TESS_WINDING_RULE (GLdouble -> IO ())
-> (TessWinding -> GLdouble) -> TessWinding -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLdouble)
-> (TessWinding -> GLenum) -> TessWinding -> GLdouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TessWinding -> GLenum
marshalTessWinding

setBoundaryOnly :: TessellatorObj -> Bool -> IO ()
setBoundaryOnly :: Ptr GLUtesselator -> Bool -> IO ()
setBoundaryOnly Ptr GLUtesselator
tessObj =
   Ptr GLUtesselator -> GLenum -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr GLUtesselator -> GLenum -> GLdouble -> m ()
gluTessProperty Ptr GLUtesselator
tessObj GLenum
GLU_TESS_BOUNDARY_ONLY (GLdouble -> IO ()) -> (Bool -> GLdouble) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GLdouble
forall a. Num a => Bool -> a
marshalGLboolean

setTolerance :: TessellatorObj -> Tolerance -> IO ()
setTolerance :: Ptr GLUtesselator -> GLdouble -> IO ()
setTolerance Ptr GLUtesselator
tessObj = Ptr GLUtesselator -> GLenum -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr GLUtesselator -> GLenum -> GLdouble -> m ()
gluTessProperty Ptr GLUtesselator
tessObj GLenum
GLU_TESS_TOLERANCE

setNormal :: TessellatorObj -> Normal3 GLdouble -> IO ()
setNormal :: Ptr GLUtesselator -> Normal3 GLdouble -> IO ()
setNormal Ptr GLUtesselator
tessObj (Normal3 GLdouble
x GLdouble
y GLdouble
z) = Ptr GLUtesselator -> GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr GLUtesselator -> GLdouble -> GLdouble -> GLdouble -> m ()
gluTessNormal Ptr GLUtesselator
tessObj GLdouble
x GLdouble
y GLdouble
z