{-# OPTIONS_GHC -optc-DUSE_SURFACE_BTREE #-}
{-# LINE 1 "src/Bindings/GTS.hsc" #-}

{-# LINE 2 "src/Bindings/GTS.hsc" #-}

{-# LINE 3 "src/Bindings/GTS.hsc" #-}

{-# LINE 4 "src/Bindings/GTS.hsc" #-}

{-# LINE 5 "src/Bindings/GTS.hsc" #-}

{-# LINE 6 "src/Bindings/GTS.hsc" #-}

-- REMEMBER ForeignPtr for garbage collection!

-- | Bindings DSL file for the Gnu Triangulated Surface Library
module Bindings.GTS where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 12 "src/Bindings/GTS.hsc" #-}
-- import Bindings.GObject
import Bindings.GLib.Fundamentals
import Bindings.GLib.Fundamentals.BasicTypes

c'GTS_1_OUT_2 = 0
c'GTS_1_OUT_2 :: (Num a) => a

{-# LINE 17 "src/Bindings/GTS.hsc" #-}
c'GTS_1_IN_2 = 1
c'GTS_1_IN_2 :: (Num a) => a

{-# LINE 18 "src/Bindings/GTS.hsc" #-}
c'GTS_2_OUT_1 = 2
c'GTS_2_OUT_1 :: (Num a) => a

{-# LINE 19 "src/Bindings/GTS.hsc" #-}
c'GTS_2_IN_1 = 3
c'GTS_2_IN_1 :: (Num a) => a

{-# LINE 20 "src/Bindings/GTS.hsc" #-}

foreign import ccall "inline_GTS_CHECK_VERSION" c'GTS_CHECK_VERSION
  :: C'guint -> C'guint -> C'guint -> IO C'gboolean

{-# LINE 22 "src/Bindings/GTS.hsc" #-}
foreign import ccall "&gts_allow_floating_vertices" p'gts_allow_floating_vertices
  :: Ptr (IO C'gboolean)

{-# LINE 23 "src/Bindings/GTS.hsc" #-}

data C'GSList = C'GSList{
{-# LINE 25 "src/Bindings/GTS.hsc" #-}

  c'GSList'data :: C'gpointer
{-# LINE 26 "src/Bindings/GTS.hsc" #-}
,
  c'GSList'next :: Ptr C'GSList
{-# LINE 27 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GSList where
  sizeOf _ = 8
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    return $ C'GSList v0 v1
  poke p (C'GSList v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    return ()

{-# LINE 28 "src/Bindings/GTS.hsc" #-}

data C'GList = C'GList{
{-# LINE 30 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GList where
  sizeOf _ = 12
  alignment = sizeOf
  peek p = do
    return $ C'GList
  poke p (C'GList) = do
    return ()

{-# LINE 31 "src/Bindings/GTS.hsc" #-}

-- | Allocate a node in a GSList from gobject. Note this function should not be used as the append/insert
--    functions call it internally
foreign import ccall "g_slist_alloc" c'g_slist_alloc
  :: IO (Ptr C'GSList)
foreign import ccall "&g_slist_alloc" p'g_slist_alloc
  :: FunPtr (IO (Ptr C'GSList))

{-# LINE 35 "src/Bindings/GTS.hsc" #-}

-- | Free all the nodes in an GSList. See the glib library
foreign import ccall "g_slist_free" c'g_slist_free
  :: Ptr C'GSList -> IO ()
foreign import ccall "&g_slist_free" p'g_slist_free
  :: FunPtr (Ptr C'GSList -> IO ())

{-# LINE 38 "src/Bindings/GTS.hsc" #-}

-- | Free one node in a GSList
foreign import ccall "g_slist_free_1" c'g_slist_free_1
  :: Ptr C'GSList -> IO ()
foreign import ccall "&g_slist_free_1" p'g_slist_free_1
  :: FunPtr (Ptr C'GSList -> IO ())

{-# LINE 41 "src/Bindings/GTS.hsc" #-}

-- | Get the pointer to the next element in the GSList
foreign import ccall "inline_g_slist_next" c'g_slist_next
  :: Ptr C'GSList -> IO (Ptr C'GSList)

{-# LINE 44 "src/Bindings/GTS.hsc" #-}

-- | Get the pointer to the last element in the GSList
foreign import ccall "g_slist_last" c'g_slist_last
  :: Ptr C'GSList -> IO (Ptr C'GSList)
foreign import ccall "&g_slist_last" p'g_slist_last
  :: FunPtr (Ptr C'GSList -> IO (Ptr C'GSList))

{-# LINE 47 "src/Bindings/GTS.hsc" #-}

-- | Get the length of the GSList
foreign import ccall "g_slist_length" c'g_slist_length
  :: Ptr C'GSList -> IO C'guint
foreign import ccall "&g_slist_length" p'g_slist_length
  :: FunPtr (Ptr C'GSList -> IO C'guint)

{-# LINE 50 "src/Bindings/GTS.hsc" #-}

-- | Get the n-th element of the GSList counting from 0
foreign import ccall "g_slist_nth" c'g_slist_nth
  :: Ptr C'GSList -> C'guint -> IO (Ptr C'GSList)
foreign import ccall "&g_slist_nth" p'g_slist_nth
  :: FunPtr (Ptr C'GSList -> C'guint -> IO (Ptr C'GSList))

{-# LINE 53 "src/Bindings/GTS.hsc" #-}

-- | Append a new node to a GSList
foreign import ccall "g_slist_append" c'g_slist_append
  :: Ptr C'GSList -> C'gpointer -> IO (Ptr C'GSList)
foreign import ccall "&g_slist_append" p'g_slist_append
  :: FunPtr (Ptr C'GSList -> C'gpointer -> IO (Ptr C'GSList))

{-# LINE 56 "src/Bindings/GTS.hsc" #-}

-- | Insert a new node in a GSList before the referenced node
foreign import ccall "g_slist_insert_before" c'g_slist_insert_before
  :: Ptr C'GSList -> Ptr C'GSList -> C'gpointer -> IO (Ptr C'GSList)
foreign import ccall "&g_slist_insert_before" p'g_slist_insert_before
  :: FunPtr (Ptr C'GSList -> Ptr C'GSList -> C'gpointer -> IO (Ptr C'GSList))

{-# LINE 59 "src/Bindings/GTS.hsc" #-}

-- | Insert a new node in a GSList at the specified position
foreign import ccall "g_slist_insert" c'g_slist_insert
  :: Ptr C'GSList -> C'gpointer -> C'gint -> IO (Ptr C'GSList)
foreign import ccall "&g_slist_insert" p'g_slist_insert
  :: FunPtr (Ptr C'GSList -> C'gpointer -> C'gint -> IO (Ptr C'GSList))

{-# LINE 62 "src/Bindings/GTS.hsc" #-}

-- | Callback for the GTS Object class initialization - don't use this unless you know what you are doing
type C'GtsObjectClassInitFunc = FunPtr (Ptr C'GtsObjectClass -> IO ())
foreign import ccall "wrapper" mk'GtsObjectClassInitFunc
  :: (Ptr C'GtsObjectClass -> IO ()) -> IO C'GtsObjectClassInitFunc
foreign import ccall "dynamic" mK'GtsObjectClassInitFunc
  :: C'GtsObjectClassInitFunc -> (Ptr C'GtsObjectClass -> IO ())

{-# LINE 65 "src/Bindings/GTS.hsc" #-}

-- | Callback for the GTS Object initialization - don't use this unless you know what you are doing
type C'GtsObjectInitFunc = FunPtr (Ptr C'GtsObject -> IO ())
foreign import ccall "wrapper" mk'GtsObjectInitFunc
  :: (Ptr C'GtsObject -> IO ()) -> IO C'GtsObjectInitFunc
foreign import ccall "dynamic" mK'GtsObjectInitFunc
  :: C'GtsObjectInitFunc -> (Ptr C'GtsObject -> IO ())

{-# LINE 68 "src/Bindings/GTS.hsc" #-}

-- | Callback for the GTS argument set method - don't use this unless you know what you are doing
type C'GtsArgSetFunc = FunPtr (Ptr C'GtsObject -> IO ())
foreign import ccall "wrapper" mk'GtsArgSetFunc
  :: (Ptr C'GtsObject -> IO ()) -> IO C'GtsArgSetFunc
foreign import ccall "dynamic" mK'GtsArgSetFunc
  :: C'GtsArgSetFunc -> (Ptr C'GtsObject -> IO ())

{-# LINE 71 "src/Bindings/GTS.hsc" #-}

-- | Callback for the GTS argument get method - don't use this unless you know what you are doing
type C'GtsArgGetFunc = FunPtr (Ptr C'GtsObject -> IO ())
foreign import ccall "wrapper" mk'GtsArgGetFunc
  :: (Ptr C'GtsObject -> IO ()) -> IO C'GtsArgGetFunc
foreign import ccall "dynamic" mK'GtsArgGetFunc
  :: C'GtsArgGetFunc -> (Ptr C'GtsObject -> IO ())

{-# LINE 74 "src/Bindings/GTS.hsc" #-}

c'GTS_CLASS_NAME_LENGTH = 40
c'GTS_CLASS_NAME_LENGTH :: (Num a) => a

{-# LINE 76 "src/Bindings/GTS.hsc" #-}

-- | Type of the GTS Vector object in Haskell
data C'GtsVector = C'GtsVector{
{-# LINE 79 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsVector where
  sizeOf _ = 24
  alignment = sizeOf
  peek p = do
    return $ C'GtsVector
  poke p (C'GtsVector) = do
    return ()

{-# LINE 80 "src/Bindings/GTS.hsc" #-}

-- | Type of the GTS Matrix object in Haskell
data C'GtsMatrix = C'GtsMatrix{
{-# LINE 83 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsMatrix where
  sizeOf _ = 32
  alignment = sizeOf
  peek p = do
    return $ C'GtsMatrix
  poke p (C'GtsMatrix) = do
    return ()

{-# LINE 84 "src/Bindings/GTS.hsc" #-}

-- | Create a new GTS Matrix 4x4 object and return the pointer to it.
foreign import ccall "gts_matrix_new" c'gts_matrix_new
  :: C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_new" p'gts_matrix_new
  :: FunPtr (C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> IO (Ptr C'GtsMatrix))

{-# LINE 87 "src/Bindings/GTS.hsc" #-}

-- | Set the fields of an existing GTS Matrix object
foreign import ccall "gts_matrix_assign" c'gts_matrix_assign
  :: Ptr C'GtsMatrix -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_assign" p'gts_matrix_assign
  :: FunPtr (Ptr C'GtsMatrix -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> C'gdouble -> IO (Ptr C'GtsMatrix))

{-# LINE 90 "src/Bindings/GTS.hsc" #-}

-- | Destroy a GTS matrix and free the associated memory - Use this with ForeignPtr for GC
foreign import ccall "gts_matrix_destroy" c'gts_matrix_destroy
  :: Ptr C'GtsMatrix -> IO ()
foreign import ccall "&gts_matrix_destroy" p'gts_matrix_destroy
  :: FunPtr (Ptr C'GtsMatrix -> IO ())

{-# LINE 93 "src/Bindings/GTS.hsc" #-}

-- | Set a GTS matrix to the Zero matrix (if the matrix is NULL a new one is allocated)
foreign import ccall "gts_matrix_zero" c'gts_matrix_zero
  :: Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_zero" p'gts_matrix_zero
  :: FunPtr (Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix))

{-# LINE 96 "src/Bindings/GTS.hsc" #-}

-- | Set a GTS matrix to the Identity matrix (if the matrix is NULL a new one is allocated)
foreign import ccall "gts_matrix_identity" c'gts_matrix_identity
  :: Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_identity" p'gts_matrix_identity
  :: FunPtr (Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix))

{-# LINE 99 "src/Bindings/GTS.hsc" #-}

-- | Transpose a GTS Matrix and return the newly allocated matrix
foreign import ccall "gts_matrix_transpose" c'gts_matrix_transpose
  :: Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_transpose" p'gts_matrix_transpose
  :: FunPtr (Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix))

{-# LINE 102 "src/Bindings/GTS.hsc" #-}

-- | Invert a GTS Matrix and return the newly allocated matrix or NULL if the matrix can't be inverted
foreign import ccall "gts_matrix_inverse" c'gts_matrix_inverse
  :: Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_inverse" p'gts_matrix_inverse
  :: FunPtr (Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix))

{-# LINE 105 "src/Bindings/GTS.hsc" #-}

-- | Calculate the product of two matricies and return the newly allocated matrix
foreign import ccall "gts_matrix_product" c'gts_matrix_product
  :: Ptr C'GtsMatrix -> Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_product" p'gts_matrix_product
  :: FunPtr (Ptr C'GtsMatrix -> Ptr C'GtsMatrix -> IO (Ptr C'GtsMatrix))

{-# LINE 108 "src/Bindings/GTS.hsc" #-}

-- | Scale a GTS Matrix in place
foreign import ccall "gts_matrix_scale" c'gts_matrix_scale
  :: Ptr C'GtsMatrix -> Ptr C'GtsVector -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_scale" p'gts_matrix_scale
  :: FunPtr (Ptr C'GtsMatrix -> Ptr C'GtsVector -> IO (Ptr C'GtsMatrix))

{-# LINE 111 "src/Bindings/GTS.hsc" #-}

-- | Translate the GTS Matrix by the GTS Vector (If the Matrix is NULL a new one is allocated and translated)
foreign import ccall "gts_matrix_translate" c'gts_matrix_translate
  :: Ptr C'GtsMatrix -> Ptr C'GtsVector -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_translate" p'gts_matrix_translate
  :: FunPtr (Ptr C'GtsMatrix -> Ptr C'GtsVector -> IO (Ptr C'GtsMatrix))

{-# LINE 114 "src/Bindings/GTS.hsc" #-}

-- | Rotate the GTS Matrix around the vector by the
foreign import ccall "gts_matrix_rotate" c'gts_matrix_rotate
  :: Ptr C'GtsMatrix -> Ptr C'GtsVector -> C'gdouble -> IO (Ptr C'GtsMatrix)
foreign import ccall "&gts_matrix_rotate" p'gts_matrix_rotate
  :: FunPtr (Ptr C'GtsMatrix -> Ptr C'GtsVector -> C'gdouble -> IO (Ptr C'GtsMatrix))

{-# LINE 117 "src/Bindings/GTS.hsc" #-}

-- | Type for an (r,g,b) triple in GTS (floating point)
data C'GtsColor = C'GtsColor{
{-# LINE 120 "src/Bindings/GTS.hsc" #-}

  c'GtsColor'r :: C'gfloat
{-# LINE 121 "src/Bindings/GTS.hsc" #-}
,
  c'GtsColor'g :: C'gfloat
{-# LINE 122 "src/Bindings/GTS.hsc" #-}
,
  c'GtsColor'b :: C'gfloat
{-# LINE 123 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsColor where
  sizeOf _ = 12
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    return $ C'GtsColor v0 v1 v2
  poke p (C'GtsColor v0 v1 v2) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    return ()

{-# LINE 124 "src/Bindings/GTS.hsc" #-}

-- | Callback for most GTS visitors
type C'GtsFunc = FunPtr (C'gpointer -> C'gpointer -> IO C'gint)
foreign import ccall "wrapper" mk'GtsFunc
  :: (C'gpointer -> C'gpointer -> IO C'gint) -> IO C'GtsFunc
foreign import ccall "dynamic" mK'GtsFunc
  :: C'GtsFunc -> (C'gpointer -> C'gpointer -> IO C'gint)

{-# LINE 127 "src/Bindings/GTS.hsc" #-}

-- | Callback for gts_vertices_merge
type C'GtsVertexMergeFunc = FunPtr (Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO C'gboolean)
foreign import ccall "wrapper" mk'GtsVertexMergeFunc
  :: (Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO C'gboolean) -> IO C'GtsVertexMergeFunc
foreign import ccall "dynamic" mK'GtsVertexMergeFunc
  :: C'GtsVertexMergeFunc -> (Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO C'gboolean)

{-# LINE 130 "src/Bindings/GTS.hsc" #-}

-- | GTS formatted data file
data C'GtsFile = C'GtsFile{
{-# LINE 133 "src/Bindings/GTS.hsc" #-}

  c'GtsFile'line :: C'guint
{-# LINE 134 "src/Bindings/GTS.hsc" #-}
,
  c'GtsFile'pos :: C'guint
{-# LINE 135 "src/Bindings/GTS.hsc" #-}
,
  c'GtsFile'error :: Ptr C'gchar
{-# LINE 136 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsFile where
  sizeOf _ = 64
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 12
    v1 <- peekByteOff p 16
    v2 <- peekByteOff p 28
    return $ C'GtsFile v0 v1 v2
  poke p (C'GtsFile v0 v1 v2) = do
    pokeByteOff p 12 v0
    pokeByteOff p 16 v1
    pokeByteOff p 28 v2
    return ()

{-# LINE 137 "src/Bindings/GTS.hsc" #-}

-- | A GTS formatted data file variable
data C'GtsFileVariable = C'GtsFileVariable{
{-# LINE 140 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsFileVariable where
  sizeOf _ = 56
  alignment = sizeOf
  peek p = do
    return $ C'GtsFileVariable
  poke p (C'GtsFileVariable) = do
    return ()

{-# LINE 141 "src/Bindings/GTS.hsc" #-}

-- | Open a C file
foreign import ccall "fopen" c'fopen
  :: CString -> CString -> IO (Ptr CFile)
foreign import ccall "&fopen" p'fopen
  :: FunPtr (CString -> CString -> IO (Ptr CFile))

{-# LINE 144 "src/Bindings/GTS.hsc" #-}

-- | Close a C file
foreign import ccall "fclose" c'fclose
  :: Ptr CFile -> IO Int
foreign import ccall "&fclose" p'fclose
  :: FunPtr (Ptr CFile -> IO Int)

{-# LINE 147 "src/Bindings/GTS.hsc" #-}

-- | Create a new GTS file handle from an C file
foreign import ccall "gts_file_new" c'gts_file_new
  :: Ptr CFile -> IO (Ptr C'GtsFile)
foreign import ccall "&gts_file_new" p'gts_file_new
  :: FunPtr (Ptr CFile -> IO (Ptr C'GtsFile))

{-# LINE 150 "src/Bindings/GTS.hsc" #-}

-- | Create a new GTS file handle from a C String. Note this method doesn't seem to work
foreign import ccall "gts_file_new_from_string" c'gts_file_new_from_string
  :: Ptr C'gchar -> IO ( Ptr C'GtsFile)
foreign import ccall "&gts_file_new_from_string" p'gts_file_new_from_string
  :: FunPtr (Ptr C'gchar -> IO ( Ptr C'GtsFile))

{-# LINE 153 "src/Bindings/GTS.hsc" #-}

-- | Get a character from a GTS file (Don't use this)
foreign import ccall "gts_file_getc" c'gts_file_getc
  :: Ptr C'GtsFile -> IO C'gint
foreign import ccall "&gts_file_getc" p'gts_file_getc
  :: FunPtr (Ptr C'GtsFile -> IO C'gint)

{-# LINE 156 "src/Bindings/GTS.hsc" #-}

-- | Destroy a GTS file handle and free the memory
foreign import ccall "gts_file_destroy" c'gts_file_destroy
  :: IO (Ptr C'GtsFile)
foreign import ccall "&gts_file_destroy" p'gts_file_destroy
  :: FunPtr (IO (Ptr C'GtsFile))

{-# LINE 159 "src/Bindings/GTS.hsc" #-}

-- #cinline GTS_OBJECT_FLAGS, Ptr <GtsObject> -> <guint32>

data C'GtsObjectClassInfo = C'GtsObjectClassInfo{
{-# LINE 163 "src/Bindings/GTS.hsc" #-}

  c'GtsObjectClassInfo'name :: [C'gchar]
{-# LINE 164 "src/Bindings/GTS.hsc" #-}
,
  c'GtsObjectClassInfo'object_size :: C'guint
{-# LINE 165 "src/Bindings/GTS.hsc" #-}
,
  c'GtsObjectClassInfo'class_size :: C'guint
{-# LINE 166 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsObjectClassInfo where
  sizeOf _ = 64
  alignment = sizeOf
  peek p = do
    v0 <- peekArray 40 (plusPtr p 0)
    v1 <- peekByteOff p 40
    v2 <- peekByteOff p 44
    return $ C'GtsObjectClassInfo v0 v1 v2
  poke p (C'GtsObjectClassInfo v0 v1 v2) = do
    pokeArray (plusPtr p 0) (take 40 v0)
    pokeByteOff p 40 v1
    pokeByteOff p 44 v2
    return ()

{-# LINE 167 "src/Bindings/GTS.hsc" #-}

data C'GtsObjectClass = C'GtsObjectClass{
{-# LINE 169 "src/Bindings/GTS.hsc" #-}

  c'GtsObjectClass'info :: C'GtsObjectClassInfo
{-# LINE 170 "src/Bindings/GTS.hsc" #-}
,
  c'GtsObjectClass'parent_class :: Ptr C'GtsObjectClass
{-# LINE 171 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsObjectClass where
  sizeOf _ = 92
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 64
    return $ C'GtsObjectClass v0 v1
  poke p (C'GtsObjectClass v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 64 v1
    return ()

{-# LINE 172 "src/Bindings/GTS.hsc" #-}

data C'GtsObject = C'GtsObject{
{-# LINE 174 "src/Bindings/GTS.hsc" #-}

  c'GtsObject'klass :: Ptr C'GtsObjectClass
{-# LINE 175 "src/Bindings/GTS.hsc" #-}
,
  c'GtsObject'flags :: C'guint32
{-# LINE 176 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsObject where
  sizeOf _ = 12
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 8
    return $ C'GtsObject v0 v1
  poke p (C'GtsObject v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 8 v1
    return ()

{-# LINE 177 "src/Bindings/GTS.hsc" #-}

data C'GtsPointClass = C'GtsPointClass{
{-# LINE 179 "src/Bindings/GTS.hsc" #-}

  c'GtsPointClass'parent_class :: C'GtsObjectClass
{-# LINE 180 "src/Bindings/GTS.hsc" #-}
,
  c'GtsPointClass'binary :: C'gboolean
{-# LINE 181 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsPointClass where
  sizeOf _ = 96
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 92
    return $ C'GtsPointClass v0 v1
  poke p (C'GtsPointClass v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 92 v1
    return ()

{-# LINE 182 "src/Bindings/GTS.hsc" #-}

data C'GtsPoint = C'GtsPoint{
{-# LINE 184 "src/Bindings/GTS.hsc" #-}

  c'GtsPoint'object :: Ptr C'GtsObject
{-# LINE 185 "src/Bindings/GTS.hsc" #-}
,
  c'GtsPoint'x :: C'gdouble
{-# LINE 186 "src/Bindings/GTS.hsc" #-}
,
  c'GtsPoint'y :: C'gdouble
{-# LINE 187 "src/Bindings/GTS.hsc" #-}
,
  c'GtsPoint'z :: C'gdouble
{-# LINE 188 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsPoint where
  sizeOf _ = 36
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 12
    v2 <- peekByteOff p 20
    v3 <- peekByteOff p 28
    return $ C'GtsPoint v0 v1 v2 v3
  poke p (C'GtsPoint v0 v1 v2 v3) = do
    pokeByteOff p 0 v0
    pokeByteOff p 12 v1
    pokeByteOff p 20 v2
    pokeByteOff p 28 v3
    return ()

{-# LINE 189 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_object_class" c'gts_object_class
  :: IO C'gpointer
foreign import ccall "&gts_object_class" p'gts_object_class
  :: FunPtr (IO C'gpointer)

{-# LINE 191 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_object_class_new" c'gts_object_class_new
  :: Ptr C'GtsObjectClass -> Ptr C'GtsObjectClassInfo -> IO C'gpointer
foreign import ccall "&gts_object_class_new" p'gts_object_class_new
  :: FunPtr (Ptr C'GtsObjectClass -> Ptr C'GtsObjectClassInfo -> IO C'gpointer)

{-# LINE 192 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_object_check_cast" c'gts_object_check_cast
  :: C'gpointer -> C'gpointer -> IO C'gpointer
foreign import ccall "&gts_object_check_cast" p'gts_object_check_cast
  :: FunPtr (C'gpointer -> C'gpointer -> IO C'gpointer)

{-# LINE 193 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_object_class_check_cast" c'gts_object_class_check_cast
  :: C'gpointer -> C'gpointer -> IO C'gpointer
foreign import ccall "&gts_object_class_check_cast" p'gts_object_class_check_cast
  :: FunPtr (C'gpointer -> C'gpointer -> IO C'gpointer)

{-# LINE 194 "src/Bindings/GTS.hsc" #-}
-- #cinline gts_object_is_from_class,  <gpointer> -> <gpointer> -> IO <gpointer>
-- #cinline gts_object_class_is_from_class,  <gpointer> -> <gpointer> -> IO <gpointer>
foreign import ccall "gts_object_class_from_name" c'gts_object_class_from_name
  :: Ptr C'gchar -> IO (Ptr C'GtsObjectClass)
foreign import ccall "&gts_object_class_from_name" p'gts_object_class_from_name
  :: FunPtr (Ptr C'gchar -> IO (Ptr C'GtsObjectClass))

{-# LINE 197 "src/Bindings/GTS.hsc" #-}

data C'GtsRange = C'GtsRange{
{-# LINE 199 "src/Bindings/GTS.hsc" #-}

  c'GtsRange'min :: C'gdouble
{-# LINE 200 "src/Bindings/GTS.hsc" #-}
,
  c'GtsRange'max :: C'gdouble
{-# LINE 201 "src/Bindings/GTS.hsc" #-}
,
  c'GtsRange'sum :: C'gdouble
{-# LINE 202 "src/Bindings/GTS.hsc" #-}
,
  c'GtsRange'sum2 :: C'gdouble
{-# LINE 203 "src/Bindings/GTS.hsc" #-}
,
  c'GtsRange'mean :: C'gdouble
{-# LINE 204 "src/Bindings/GTS.hsc" #-}
,
  c'GtsRange'stddev :: C'gdouble
{-# LINE 205 "src/Bindings/GTS.hsc" #-}
,
  c'GtsRange'n :: C'guint
{-# LINE 206 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsRange where
  sizeOf _ = 52
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 8
    v2 <- peekByteOff p 16
    v3 <- peekByteOff p 24
    v4 <- peekByteOff p 32
    v5 <- peekByteOff p 40
    v6 <- peekByteOff p 48
    return $ C'GtsRange v0 v1 v2 v3 v4 v5 v6
  poke p (C'GtsRange v0 v1 v2 v3 v4 v5 v6) = do
    pokeByteOff p 0 v0
    pokeByteOff p 8 v1
    pokeByteOff p 16 v2
    pokeByteOff p 24 v3
    pokeByteOff p 32 v4
    pokeByteOff p 40 v5
    pokeByteOff p 48 v6
    return ()

{-# LINE 207 "src/Bindings/GTS.hsc" #-}

data C'GtsSegment = C'GtsSegment{
{-# LINE 209 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsSegment where
  sizeOf _ = 20
  alignment = sizeOf
  peek p = do
    return $ C'GtsSegment
  poke p (C'GtsSegment) = do
    return ()

{-# LINE 210 "src/Bindings/GTS.hsc" #-}

data C'GtsTriangleClass = C'GtsTriangleClass{
{-# LINE 212 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsTriangleClass where
  sizeOf _ = 92
  alignment = sizeOf
  peek p = do
    return $ C'GtsTriangleClass
  poke p (C'GtsTriangleClass) = do
    return ()

{-# LINE 213 "src/Bindings/GTS.hsc" #-}

data C'GtsTriangle = C'GtsTriangle{
{-# LINE 215 "src/Bindings/GTS.hsc" #-}

  c'GtsTriangle'e1 :: Ptr C'GtsEdge
{-# LINE 216 "src/Bindings/GTS.hsc" #-}
,
  c'GtsTriangle'e2 :: Ptr C'GtsEdge
{-# LINE 217 "src/Bindings/GTS.hsc" #-}
,
  c'GtsTriangle'e3 :: Ptr C'GtsEdge
{-# LINE 218 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsTriangle where
  sizeOf _ = 24
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 12
    v1 <- peekByteOff p 16
    v2 <- peekByteOff p 20
    return $ C'GtsTriangle v0 v1 v2
  poke p (C'GtsTriangle v0 v1 v2) = do
    pokeByteOff p 12 v0
    pokeByteOff p 16 v1
    pokeByteOff p 20 v2
    return ()

{-# LINE 219 "src/Bindings/GTS.hsc" #-}

-- | Create a triangle which is guarenteed to enclose all the points in the list
foreign import ccall "gts_triangle_enclosing" c'gts_triangle_enclosing
  :: Ptr C'GtsTriangleClass -> Ptr C'GSList -> C'gdouble -> IO (Ptr C'GtsTriangle)
foreign import ccall "&gts_triangle_enclosing" p'gts_triangle_enclosing
  :: FunPtr (Ptr C'GtsTriangleClass -> Ptr C'GSList -> C'gdouble -> IO (Ptr C'GtsTriangle))

{-# LINE 222 "src/Bindings/GTS.hsc" #-}

-- | Get the class descriptor for the GTS Triangle class
foreign import ccall "gts_triangle_class" c'gts_triangle_class
  :: IO (Ptr C'GtsTriangleClass)
foreign import ccall "&gts_triangle_class" p'gts_triangle_class
  :: FunPtr (IO (Ptr C'GtsTriangleClass))

{-# LINE 225 "src/Bindings/GTS.hsc" #-}

-- | Create a new triangle from 3 edges
foreign import ccall "gts_triangle_new" c'gts_triangle_new
  :: Ptr C'GtsTriangleClass -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> IO (Ptr C'GtsTriangle)
foreign import ccall "&gts_triangle_new" p'gts_triangle_new
  :: FunPtr (Ptr C'GtsTriangleClass -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> IO (Ptr C'GtsTriangle))

{-# LINE 228 "src/Bindings/GTS.hsc" #-}

-- | Discard the existing edges of the triangle and replace with the new ones
foreign import ccall "gts_triangle_set" c'gts_triangle_set
  :: Ptr C'GtsTriangleClass -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> IO ()
foreign import ccall "&gts_triangle_set" p'gts_triangle_set
  :: FunPtr (Ptr C'GtsTriangleClass -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> IO ())

{-# LINE 231 "src/Bindings/GTS.hsc" #-}

-- | Get the area of this triangle
foreign import ccall "gts_triangle_area" c'gts_triangle_area
  :: Ptr C'GtsTriangle -> IO C'gdouble
foreign import ccall "&gts_triangle_area" p'gts_triangle_area
  :: FunPtr (Ptr C'GtsTriangle -> IO C'gdouble)

{-# LINE 234 "src/Bindings/GTS.hsc" #-}

-- | Get the perimeter of this triangle
foreign import ccall "gts_triangle_perimeter" c'gts_triangle_perimeter
  :: Ptr C'GtsTriangle -> IO C'gdouble
foreign import ccall "&gts_triangle_perimeter" p'gts_triangle_perimeter
  :: FunPtr (Ptr C'GtsTriangle -> IO C'gdouble)

{-# LINE 237 "src/Bindings/GTS.hsc" #-}

-- | Get a measure of the quality of this triangle (how close to equilateral it is?)
foreign import ccall "gts_triangle_quality" c'gts_triangle_quality
  :: Ptr C'GtsTriangle -> IO C'gdouble
foreign import ccall "&gts_triangle_quality" p'gts_triangle_quality
  :: FunPtr (Ptr C'GtsTriangle -> IO C'gdouble)

{-# LINE 240 "src/Bindings/GTS.hsc" #-}

-- | Get the normal to the plane of this triangle
foreign import ccall "gts_triangle_normal" c'gts_triangle_normal
  :: Ptr C'GtsTriangle -> Ptr C'gdouble -> Ptr C'gdouble -> Ptr C'gdouble -> IO ()
foreign import ccall "&gts_triangle_normal" p'gts_triangle_normal
  :: FunPtr (Ptr C'GtsTriangle -> Ptr C'gdouble -> Ptr C'gdouble -> Ptr C'gdouble -> IO ())

{-# LINE 243 "src/Bindings/GTS.hsc" #-}

-- | Changes the orientation of triangle t, turning it inside out
foreign import ccall "gts_triangle_revert" c'gts_triangle_revert
  :: Ptr C'GtsTriangle -> IO ()
foreign import ccall "&gts_triangle_revert" p'gts_triangle_revert
  :: FunPtr (Ptr C'GtsTriangle -> IO ())

{-# LINE 246 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_triangle_orientation" c'gts_triangle_orientation
  :: Ptr C'GtsTriangle -> IO C'gdouble
foreign import ccall "&gts_triangle_orientation" p'gts_triangle_orientation
  :: FunPtr (Ptr C'GtsTriangle -> IO C'gdouble)

{-# LINE 248 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_neighbors" c'gts_triangle_neighbors
  :: Ptr C'GtsTriangle -> IO (Ptr C'GSList)
foreign import ccall "&gts_triangle_neighbors" p'gts_triangle_neighbors
  :: FunPtr (Ptr C'GtsTriangle -> IO (Ptr C'GSList))

{-# LINE 249 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_vertices_edges" c'gts_triangle_vertices_edges
  :: Ptr C'GtsTriangle -> Ptr C'GtsEdge -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsEdge) -> Ptr (Ptr C'GtsEdge) -> Ptr (Ptr C'GtsEdge) -> IO ()
foreign import ccall "&gts_triangle_vertices_edges" p'gts_triangle_vertices_edges
  :: FunPtr (Ptr C'GtsTriangle -> Ptr C'GtsEdge -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsEdge) -> Ptr (Ptr C'GtsEdge) -> Ptr (Ptr C'GtsEdge) -> IO ())

{-# LINE 250 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_vertices" c'gts_triangle_vertices
  :: Ptr C'GtsTriangle -> Ptr C'GtsEdge -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsVertex) -> IO ()
foreign import ccall "&gts_triangle_vertices" p'gts_triangle_vertices
  :: FunPtr (Ptr C'GtsTriangle -> Ptr C'GtsEdge -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsVertex) -> Ptr (Ptr C'GtsVertex) -> IO ())

{-# LINE 251 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_vertex_opposite" c'gts_triangle_vertex_opposite
  :: Ptr C'GtsTriangle -> Ptr C'GtsEdge -> IO (Ptr C'GtsVertex)
foreign import ccall "&gts_triangle_vertex_opposite" p'gts_triangle_vertex_opposite
  :: FunPtr (Ptr C'GtsTriangle -> Ptr C'GtsEdge -> IO (Ptr C'GtsVertex))

{-# LINE 252 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_edge_opposite" c'gts_triangle_edge_opposite
  :: Ptr C'GtsTriangle -> Ptr C'GtsVertex -> IO (Ptr C'GtsEdge)
foreign import ccall "&gts_triangle_edge_opposite" p'gts_triangle_edge_opposite
  :: FunPtr (Ptr C'GtsTriangle -> Ptr C'GtsVertex -> IO (Ptr C'GtsEdge))

{-# LINE 253 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_is_ok" c'gts_triangle_is_ok
  :: Ptr C'GtsTriangle -> IO C'gboolean
foreign import ccall "&gts_triangle_is_ok" p'gts_triangle_is_ok
  :: FunPtr (Ptr C'GtsTriangle -> IO C'gboolean)

{-# LINE 254 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_circumcircle_center" c'gts_triangle_circumcircle_center
  :: Ptr C'GtsTriangle -> Ptr C'GtsPointClass -> IO (Ptr C'GtsPoint)
foreign import ccall "&gts_triangle_circumcircle_center" p'gts_triangle_circumcircle_center
  :: FunPtr (Ptr C'GtsTriangle -> Ptr C'GtsPointClass -> IO (Ptr C'GtsPoint))

{-# LINE 255 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_interpolate_height" c'gts_triangle_interpolate_height
  :: Ptr C'GtsTriangle -> Ptr C'GtsPoint -> IO ()
foreign import ccall "&gts_triangle_interpolate_height" p'gts_triangle_interpolate_height
  :: FunPtr (Ptr C'GtsTriangle -> Ptr C'GtsPoint -> IO ())

{-# LINE 256 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangles_from_edges" c'gts_triangles_from_edges
  :: Ptr C'GSList -> IO (Ptr C'GSList)
foreign import ccall "&gts_triangles_from_edges" p'gts_triangles_from_edges
  :: FunPtr (Ptr C'GSList -> IO (Ptr C'GSList))

{-# LINE 257 "src/Bindings/GTS.hsc" #-}

data C'GtsVertex = C'GtsVertex{
{-# LINE 259 "src/Bindings/GTS.hsc" #-}

  c'GtsVertex'p :: C'GtsPoint
{-# LINE 260 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsVertex where
  sizeOf _ = 40
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    return $ C'GtsVertex v0
  poke p (C'GtsVertex v0) = do
    pokeByteOff p 0 v0
    return ()

{-# LINE 261 "src/Bindings/GTS.hsc" #-}

data C'GtsVertexClass = C'GtsVertexClass{
{-# LINE 263 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsVertexClass where
  sizeOf _ = 100
  alignment = sizeOf
  peek p = do
    return $ C'GtsVertexClass
  poke p (C'GtsVertexClass) = do
    return ()

{-# LINE 264 "src/Bindings/GTS.hsc" #-}

-- | Clear a range
foreign import ccall "gts_range_init" c'gts_range_init
  :: Ptr C'GtsRange -> IO ()
foreign import ccall "&gts_range_init" p'gts_range_init
  :: FunPtr (Ptr C'GtsRange -> IO ())

{-# LINE 267 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_range_reset" c'gts_range_reset
  :: Ptr C'GtsRange -> IO ()
foreign import ccall "&gts_range_reset" p'gts_range_reset
  :: FunPtr (Ptr C'GtsRange -> IO ())

{-# LINE 268 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_range_add_value" c'gts_range_add_value
  :: Ptr C'GtsRange -> C'gdouble -> IO ()
foreign import ccall "&gts_range_add_value" p'gts_range_add_value
  :: FunPtr (Ptr C'GtsRange -> C'gdouble -> IO ())

{-# LINE 269 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_range_update" c'gts_range_update
  :: Ptr C'GtsRange -> IO ()
foreign import ccall "&gts_range_update" p'gts_range_update
  :: FunPtr (Ptr C'GtsRange -> IO ())

{-# LINE 270 "src/Bindings/GTS.hsc" #-}

-- | GLib class pointer for the GTS point object class
foreign import ccall "gts_point_class" c'gts_point_class
  :: IO (Ptr C'GtsPointClass)
foreign import ccall "&gts_point_class" p'gts_point_class
  :: FunPtr (IO (Ptr C'GtsPointClass))

{-# LINE 273 "src/Bindings/GTS.hsc" #-}

-- | Create a new GTS point in 3d space
foreign import ccall "gts_point_new" c'gts_point_new
  :: Ptr C'GtsPointClass -> C'gdouble -> C'gdouble -> C'gdouble -> IO ( Ptr C'GtsPoint )
foreign import ccall "&gts_point_new" p'gts_point_new
  :: FunPtr (Ptr C'GtsPointClass -> C'gdouble -> C'gdouble -> C'gdouble -> IO ( Ptr C'GtsPoint ))

{-# LINE 276 "src/Bindings/GTS.hsc" #-}

-- | Set the value of a GTS point in 3d space
foreign import ccall "gts_point_set" c'gts_point_set
  :: Ptr C'GtsPoint -> C'gdouble -> C'gdouble -> C'gdouble -> IO ()
foreign import ccall "&gts_point_set" p'gts_point_set
  :: FunPtr (Ptr C'GtsPoint -> C'gdouble -> C'gdouble -> C'gdouble -> IO ())

{-# LINE 279 "src/Bindings/GTS.hsc" #-}

-- | True iff the point is within or on the boundary of the box defined by the two other points
foreign import ccall "inline_gts_point_is_in_rectangle" c'gts_point_is_in_rectangle
  :: Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> IO C'gboolean

{-# LINE 282 "src/Bindings/GTS.hsc" #-}

-- | GLib class pointer for the GTS vertex class (vertex derives from point)
foreign import ccall "gts_vertex_class" c'gts_vertex_class
  :: IO (Ptr C'GtsVertexClass)
foreign import ccall "&gts_vertex_class" p'gts_vertex_class
  :: FunPtr (IO (Ptr C'GtsVertexClass))

{-# LINE 285 "src/Bindings/GTS.hsc" #-}

-- | Create a new GTS vertex in 3d space
foreign import ccall "gts_vertex_new" c'gts_vertex_new
  :: Ptr C'GtsVertexClass -> C'gdouble -> C'gdouble -> C'gdouble -> IO (Ptr C'GtsVertex)
foreign import ccall "&gts_vertex_new" p'gts_vertex_new
  :: FunPtr (Ptr C'GtsVertexClass -> C'gdouble -> C'gdouble -> C'gdouble -> IO (Ptr C'GtsVertex))

{-# LINE 288 "src/Bindings/GTS.hsc" #-}

-- | True if this vertex is not part of a GTS segment
foreign import ccall "gts_vertex_is_unattached" c'gts_vertex_is_unattached
  :: Ptr C'GtsVertex -> IO C'gboolean
foreign import ccall "&gts_vertex_is_unattached" p'gts_vertex_is_unattached
  :: FunPtr (Ptr C'GtsVertex -> IO C'gboolean)

{-# LINE 291 "src/Bindings/GTS.hsc" #-}

-- | Return the number of connected triangles sharing the vertex, if second parameter is true then sever the connection
foreign import ccall "gts_vertex_is_contact" c'gts_vertex_is_contact
  :: Ptr C'GtsVertex -> C'gboolean -> IO C'guint
foreign import ccall "&gts_vertex_is_contact" p'gts_vertex_is_contact
  :: FunPtr (Ptr C'GtsVertex -> C'gboolean -> IO C'guint)

{-# LINE 294 "src/Bindings/GTS.hsc" #-}

-- | Null unless two vertices are the endpoints of the same segment, in which case return the segment
foreign import ccall "gts_vertices_are_connected" c'gts_vertices_are_connected
  :: Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO (Ptr C'GtsSegment)
foreign import ccall "&gts_vertices_are_connected" p'gts_vertices_are_connected
  :: FunPtr (Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO (Ptr C'GtsSegment))

{-# LINE 297 "src/Bindings/GTS.hsc" #-}

-- | Replace a vertex with another vertex and update all objects using it
foreign import ccall "gts_vertex_replace" c'gts_vertex_replace
  :: Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO ()
foreign import ccall "&gts_vertex_replace" p'gts_vertex_replace
  :: FunPtr (Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO ())

{-# LINE 300 "src/Bindings/GTS.hsc" #-}

-- | Adds to list all the GtsVertex connected to v by a GtsSegment and not already in list. If surface is not NULL only the vertices connected to v by an edge belonging to surface are considered.
foreign import ccall "gts_vertex_neighbors" c'gts_vertex_neighbors
  :: Ptr C'GtsVertex -> Ptr C'GSList -> Ptr C'GtsSurface -> IO (Ptr C'GSList)
foreign import ccall "&gts_vertex_neighbors" p'gts_vertex_neighbors
  :: FunPtr (Ptr C'GtsVertex -> Ptr C'GSList -> Ptr C'GtsSurface -> IO (Ptr C'GSList))

{-# LINE 303 "src/Bindings/GTS.hsc" #-}

-- | Adds all the GtsTriangle which share v as a vertex and do not already belong to list.
foreign import ccall "gts_vertex_triangles" c'gts_vertex_triangles
  :: Ptr C'GtsVertex -> Ptr C'GSList -> IO (Ptr C'GSList)
foreign import ccall "&gts_vertex_triangles" p'gts_vertex_triangles
  :: FunPtr (Ptr C'GtsVertex -> Ptr C'GSList -> IO (Ptr C'GSList))

{-# LINE 306 "src/Bindings/GTS.hsc" #-}

-- | Adds all the GtsFace belonging to surface (if not NULL) which share v as a vertex and do not already belong to list.
foreign import ccall "gts_vertex_faces" c'gts_vertex_faces
  :: Ptr C'GtsVertex -> Ptr C'GtsSurface -> Ptr C'GSList -> IO (Ptr C'GSList)
foreign import ccall "&gts_vertex_faces" p'gts_vertex_faces
  :: FunPtr (Ptr C'GtsVertex -> Ptr C'GtsSurface -> Ptr C'GSList -> IO (Ptr C'GSList))

{-# LINE 309 "src/Bindings/GTS.hsc" #-}

-- | A list of GtsEdge describing in counterclockwise order the boundary of the fan of summit v, the faces of the fan belonging to surface
foreign import ccall "gts_vertex_fan_oriented" c'gts_vertex_fan_oriented
  :: Ptr C'GtsVertex -> Ptr C'GtsSurface -> IO (Ptr C'GSList)
foreign import ccall "&gts_vertex_fan_oriented" p'gts_vertex_fan_oriented
  :: FunPtr (Ptr C'GtsVertex -> Ptr C'GtsSurface -> IO (Ptr C'GSList))

{-# LINE 312 "src/Bindings/GTS.hsc" #-}

-- | TRUE if v is strictly contained in the diametral circle of e, FALSE otherwise
foreign import ccall "gts_vertex_encroaches_edge" c'gts_vertex_encroaches_edge
  :: Ptr C'GtsVertex -> Ptr C'GtsEdge -> IO C'gboolean
foreign import ccall "&gts_vertex_encroaches_edge" p'gts_vertex_encroaches_edge
  :: FunPtr (Ptr C'GtsVertex -> Ptr C'GtsEdge -> IO C'gboolean)

{-# LINE 315 "src/Bindings/GTS.hsc" #-}

-- | For each vertex v in vertices look if there are any vertex of vertices contained in a box centered on v of size 2*epsilon. If there are and if check is not NULL and returns TRUE, replace them with v (using gts_vertex_replace()), destroy them and remove them from list. This is done efficiently using Kd-Trees.
foreign import ccall "gts_vertices_merge" c'gts_vertices_merge
  :: Ptr C'GSList -> C'gdouble -> C'GtsVertexMergeFunc -> IO (Ptr C'GSList)
foreign import ccall "&gts_vertices_merge" p'gts_vertices_merge
  :: FunPtr (Ptr C'GSList -> C'gdouble -> C'GtsVertexMergeFunc -> IO (Ptr C'GSList))

{-# LINE 318 "src/Bindings/GTS.hsc" #-}

data C'GtsVertexNormal = C'GtsVertexNormal{
{-# LINE 320 "src/Bindings/GTS.hsc" #-}

  c'GtsVertexNormal'n :: C'GtsVector
{-# LINE 321 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsVertexNormal where
  sizeOf _ = 64
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 40
    return $ C'GtsVertexNormal v0
  poke p (C'GtsVertexNormal v0) = do
    pokeByteOff p 40 v0
    return ()

{-# LINE 322 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_vertex_normal_class" c'gts_vertex_normal_class
  :: IO (Ptr C'GtsVertexClass)
foreign import ccall "&gts_vertex_normal_class" p'gts_vertex_normal_class
  :: FunPtr (IO (Ptr C'GtsVertexClass))

{-# LINE 324 "src/Bindings/GTS.hsc" #-}

data C'GtsColorVertex = C'GtsColorVertex{
{-# LINE 326 "src/Bindings/GTS.hsc" #-}

  c'GtsColorVertex'c :: C'GtsColor
{-# LINE 327 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsColorVertex where
  sizeOf _ = 52
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 40
    return $ C'GtsColorVertex v0
  poke p (C'GtsColorVertex v0) = do
    pokeByteOff p 40 v0
    return ()

{-# LINE 328 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_color_vertex_class" c'gts_color_vertex_class
  :: IO (Ptr C'GtsVertexClass)
foreign import ccall "&gts_color_vertex_class" p'gts_color_vertex_class
  :: FunPtr (IO (Ptr C'GtsVertexClass))

{-# LINE 330 "src/Bindings/GTS.hsc" #-}

data C'GtsSurface = C'GtsSurface{
{-# LINE 332 "src/Bindings/GTS.hsc" #-}

  c'GtsSurface'keep_faces :: C'gboolean
{-# LINE 333 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsSurface where
  sizeOf _ = 32
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 28
    return $ C'GtsSurface v0
  poke p (C'GtsSurface v0) = do
    pokeByteOff p 28 v0
    return ()

{-# LINE 334 "src/Bindings/GTS.hsc" #-}

data C'GtsSurfaceClass = C'GtsSurfaceClass{
{-# LINE 336 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsSurfaceClass where
  sizeOf _ = 100
  alignment = sizeOf
  peek p = do
    return $ C'GtsSurfaceClass
  poke p (C'GtsSurfaceClass) = do
    return ()

{-# LINE 337 "src/Bindings/GTS.hsc" #-}

data C'GtsEdgeClass = C'GtsEdgeClass{
{-# LINE 339 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsEdgeClass where
  sizeOf _ = 92
  alignment = sizeOf
  peek p = do
    return $ C'GtsEdgeClass
  poke p (C'GtsEdgeClass) = do
    return ()

{-# LINE 340 "src/Bindings/GTS.hsc" #-}

data C'GtsEdge = C'GtsEdge{
{-# LINE 342 "src/Bindings/GTS.hsc" #-}

  c'GtsEdge'triangles :: Ptr C'GSList
{-# LINE 343 "src/Bindings/GTS.hsc" #-}
,
  c'GtsEdge'segment :: Ptr C'GtsSegment
{-# LINE 344 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsEdge where
  sizeOf _ = 24
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 20
    v1 <- peekByteOff p 0
    return $ C'GtsEdge v0 v1
  poke p (C'GtsEdge v0 v1) = do
    pokeByteOff p 20 v0
    pokeByteOff p 0 v1
    return ()

{-# LINE 345 "src/Bindings/GTS.hsc" #-}

data C'GtsFaceClass = C'GtsFaceClass{
{-# LINE 347 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsFaceClass where
  sizeOf _ = 92
  alignment = sizeOf
  peek p = do
    return $ C'GtsFaceClass
  poke p (C'GtsFaceClass) = do
    return ()

{-# LINE 348 "src/Bindings/GTS.hsc" #-}

data C'GtsFace = C'GtsFace{
{-# LINE 350 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsFace where
  sizeOf _ = 28
  alignment = sizeOf
  peek p = do
    return $ C'GtsFace
  poke p (C'GtsFace) = do
    return ()

{-# LINE 351 "src/Bindings/GTS.hsc" #-}

data C'GtsSurfaceStats = C'GtsSurfaceStats{
{-# LINE 353 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsSurfaceStats where
  sizeOf _ = 132
  alignment = sizeOf
  peek p = do
    return $ C'GtsSurfaceStats
  poke p (C'GtsSurfaceStats) = do
    return ()

{-# LINE 354 "src/Bindings/GTS.hsc" #-}

data C'GtsSurfaceQualityStats = C'GtsSurfaceQualityStats{
{-# LINE 356 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsSurfaceQualityStats where
  sizeOf _ = 212
  alignment = sizeOf
  peek p = do
    return $ C'GtsSurfaceQualityStats
  poke p (C'GtsSurfaceQualityStats) = do
    return ()

{-# LINE 357 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_face_class" c'gts_face_class
  :: IO (Ptr C'GtsFaceClass)
foreign import ccall "&gts_face_class" p'gts_face_class
  :: FunPtr (IO (Ptr C'GtsFaceClass))

{-# LINE 359 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_edge_class" c'gts_edge_class
  :: IO (Ptr C'GtsEdgeClass)
foreign import ccall "&gts_edge_class" p'gts_edge_class
  :: FunPtr (IO (Ptr C'GtsEdgeClass))

{-# LINE 360 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_surface_class" c'gts_surface_class
  :: IO (Ptr C'GtsSurfaceClass)
foreign import ccall "&gts_surface_class" p'gts_surface_class
  :: FunPtr (IO (Ptr C'GtsSurfaceClass))

{-# LINE 361 "src/Bindings/GTS.hsc" #-}

-- | Create a new empty surface which uses the specified types of sub-object
foreign import ccall "gts_surface_new" c'gts_surface_new
  :: Ptr C'GtsSurfaceClass -> Ptr C'GtsFaceClass -> Ptr C'GtsEdgeClass -> Ptr C'GtsVertexClass -> IO (Ptr C'GtsSurface)
foreign import ccall "&gts_surface_new" p'gts_surface_new
  :: FunPtr (Ptr C'GtsSurfaceClass -> Ptr C'GtsFaceClass -> Ptr C'GtsEdgeClass -> Ptr C'GtsVertexClass -> IO (Ptr C'GtsSurface))

{-# LINE 364 "src/Bindings/GTS.hsc" #-}

-- | Add a face to a surface
foreign import ccall "gts_surface_add_face" c'gts_surface_add_face
  :: Ptr C'GtsSurface -> Ptr C'GtsFace -> IO ()
foreign import ccall "&gts_surface_add_face" p'gts_surface_add_face
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsFace -> IO ())

{-# LINE 367 "src/Bindings/GTS.hsc" #-}

-- | Read a surface from a GTS formatted file
foreign import ccall "gts_surface_read" c'gts_surface_read
  :: Ptr C'GtsSurface -> Ptr C'GtsFile -> IO C'guint
foreign import ccall "&gts_surface_read" p'gts_surface_read
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsFile -> IO C'guint)

{-# LINE 370 "src/Bindings/GTS.hsc" #-}

-- | Remove a face from a surface
foreign import ccall "gts_surface_remove_face" c'gts_surface_remove_face
  :: Ptr C'GtsSurface -> Ptr C'GtsFace -> IO ()
foreign import ccall "&gts_surface_remove_face" p'gts_surface_remove_face
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsFace -> IO ())

{-# LINE 373 "src/Bindings/GTS.hsc" #-}

-- | Get the surface area of all triangles in the surface
foreign import ccall "gts_surface_area" c'gts_surface_area
  :: Ptr C'GtsSurface -> IO C'gdouble
foreign import ccall "&gts_surface_area" p'gts_surface_area
  :: FunPtr (Ptr C'GtsSurface -> IO C'gdouble)

{-# LINE 376 "src/Bindings/GTS.hsc" #-}

-- | Get some statistics on the surface
foreign import ccall "gts_surface_stats" c'gts_surface_stats
  :: Ptr C'GtsSurface -> Ptr C'GtsSurfaceStats -> IO ()
foreign import ccall "&gts_surface_stats" p'gts_surface_stats
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsSurfaceStats -> IO ())

{-# LINE 379 "src/Bindings/GTS.hsc" #-}

-- | Get some statistics on the quality of the triangles making up the surface
foreign import ccall "gts_surface_quality_stats" c'gts_surface_quality_stats
  :: Ptr C'GtsSurface -> Ptr C'GtsSurfaceQualityStats -> IO ()
foreign import ccall "&gts_surface_quality_stats" p'gts_surface_quality_stats
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsSurfaceQualityStats -> IO ())

{-# LINE 382 "src/Bindings/GTS.hsc" #-}

-- | Invoke a function for each vertex in the surface
foreign import ccall "gts_surface_foreach_vertex" c'gts_surface_foreach_vertex
  :: Ptr C'GtsSurface -> C'GtsFunc -> C'gpointer -> IO ()
foreign import ccall "&gts_surface_foreach_vertex" p'gts_surface_foreach_vertex
  :: FunPtr (Ptr C'GtsSurface -> C'GtsFunc -> C'gpointer -> IO ())

{-# LINE 385 "src/Bindings/GTS.hsc" #-}

-- | Invoke a function for each edge in the surface
foreign import ccall "gts_surface_foreach_edge" c'gts_surface_foreach_edge
  :: Ptr C'GtsSurface -> C'GtsFunc -> C'gpointer -> IO ()
foreign import ccall "&gts_surface_foreach_edge" p'gts_surface_foreach_edge
  :: FunPtr (Ptr C'GtsSurface -> C'GtsFunc -> C'gpointer -> IO ())

{-# LINE 388 "src/Bindings/GTS.hsc" #-}

-- | Invoke a function for each face in the surface
foreign import ccall "gts_surface_foreach_face" c'gts_surface_foreach_face
  :: Ptr C'GtsSurface -> C'GtsFunc -> C'gpointer -> IO ()
foreign import ccall "&gts_surface_foreach_face" p'gts_surface_foreach_face
  :: FunPtr (Ptr C'GtsSurface -> C'GtsFunc -> C'gpointer -> IO ())

{-# LINE 391 "src/Bindings/GTS.hsc" #-}

-- | Invoke a function for each face in the surface and remove the face afterwards
foreign import ccall "gts_surface_foreach_face_remove" c'gts_surface_foreach_face_remove
  :: Ptr C'GtsSurface -> C'GtsFunc -> C'gpointer -> IO C'guint
foreign import ccall "&gts_surface_foreach_face_remove" p'gts_surface_foreach_face_remove
  :: FunPtr (Ptr C'GtsSurface -> C'GtsFunc -> C'gpointer -> IO C'guint)

{-# LINE 394 "src/Bindings/GTS.hsc" #-}

-- | Generate a surface which is a tessalated model of a sphere
foreign import ccall "gts_surface_generate_sphere" c'gts_surface_generate_sphere
  :: Ptr C'GtsSurface -> C'guint -> IO ( Ptr C'GtsSurface )
foreign import ccall "&gts_surface_generate_sphere" p'gts_surface_generate_sphere
  :: FunPtr (Ptr C'GtsSurface -> C'guint -> IO ( Ptr C'GtsSurface ))

{-# LINE 397 "src/Bindings/GTS.hsc" #-}

-- |Add a copy of all the faces, edges and vertices of s2 to s1.
foreign import ccall "gts_surface_copy" c'gts_surface_copy
  :: Ptr C'GtsSurface -> Ptr C'GtsSurface -> IO (Ptr C'GtsSurface )
foreign import ccall "&gts_surface_copy" p'gts_surface_copy
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsSurface -> IO (Ptr C'GtsSurface ))

{-# LINE 400 "src/Bindings/GTS.hsc" #-}

-- | Adds all the faces of with which do not already belong to s to s.
foreign import ccall "gts_surface_merge" c'gts_surface_merge
  :: Ptr C'GtsSurface -> Ptr C'GtsSurface -> IO ()
foreign import ccall "&gts_surface_merge" p'gts_surface_merge
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsSurface -> IO ())

{-# LINE 403 "src/Bindings/GTS.hsc" #-}

-- | True iff the surface describes a manifold
foreign import ccall "gts_surface_is_manifold" c'gts_surface_is_manifold
  :: Ptr C'GtsSurface -> IO C'gboolean
foreign import ccall "&gts_surface_is_manifold" p'gts_surface_is_manifold
  :: FunPtr (Ptr C'GtsSurface -> IO C'gboolean)

{-# LINE 406 "src/Bindings/GTS.hsc" #-}

-- | True iff the surface is closed
foreign import ccall "gts_surface_is_closed" c'gts_surface_is_closed
  :: Ptr C'GtsSurface -> IO C'gboolean
foreign import ccall "&gts_surface_is_closed" p'gts_surface_is_closed
  :: FunPtr (Ptr C'GtsSurface -> IO C'gboolean)

{-# LINE 409 "src/Bindings/GTS.hsc" #-}

-- | True iff all the faces of the surface have a compatible orientation
foreign import ccall "gts_surface_is_orientable" c'gts_surface_is_orientable
  :: Ptr C'GtsSurface -> IO C'gboolean
foreign import ccall "&gts_surface_is_orientable" p'gts_surface_is_orientable
  :: FunPtr (Ptr C'GtsSurface -> IO C'gboolean)

{-# LINE 412 "src/Bindings/GTS.hsc" #-}

-- | Return the volume of the domain bounded by the surface, only valid if the surface is closed and orientable
foreign import ccall "gts_surface_volume" c'gts_surface_volume
  :: Ptr C'GtsSurface -> IO C'gdouble
foreign import ccall "&gts_surface_volume" p'gts_surface_volume
  :: FunPtr (Ptr C'GtsSurface -> IO C'gdouble)

{-# LINE 415 "src/Bindings/GTS.hsc" #-}

-- | Return the center of mass of the domain bounded by the surface s, only valid if the surface is closed and orientable
foreign import ccall "gts_surface_center_of_mass" c'gts_surface_center_of_mass
  :: Ptr C'GtsSurface -> Ptr C'GtsVector -> IO C'gdouble
foreign import ccall "&gts_surface_center_of_mass" p'gts_surface_center_of_mass
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsVector -> IO C'gdouble)

{-# LINE 418 "src/Bindings/GTS.hsc" #-}

-- | Return the center of area of the surface (all faces should be co-planar)
foreign import ccall "gts_surface_center_of_area" c'gts_surface_center_of_area
  :: Ptr C'GtsSurface -> Ptr C'GtsVector -> IO C'gdouble
foreign import ccall "&gts_surface_center_of_area" p'gts_surface_center_of_area
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsVector -> IO C'gdouble)

{-# LINE 421 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_surface_vertex_number" c'gts_surface_vertex_number
  :: Ptr C'GtsSurface -> IO C'guint
foreign import ccall "&gts_surface_vertex_number" p'gts_surface_vertex_number
  :: FunPtr (Ptr C'GtsSurface -> IO C'guint)

{-# LINE 423 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_surface_edge_number" c'gts_surface_edge_number
  :: Ptr C'GtsSurface -> IO C'guint
foreign import ccall "&gts_surface_edge_number" p'gts_surface_edge_number
  :: FunPtr (Ptr C'GtsSurface -> IO C'guint)

{-# LINE 424 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_surface_face_number" c'gts_surface_face_number
  :: Ptr C'GtsSurface -> IO C'guint
foreign import ccall "&gts_surface_face_number" p'gts_surface_face_number
  :: FunPtr (Ptr C'GtsSurface -> IO C'guint)

{-# LINE 425 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_surface_boundary" c'gts_surface_boundary
  :: Ptr C'GtsSurface -> IO (Ptr C'GSList)
foreign import ccall "&gts_surface_boundary" p'gts_surface_boundary
  :: FunPtr (Ptr C'GtsSurface -> IO (Ptr C'GSList))

{-# LINE 427 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_surface_split" c'gts_surface_split
  :: Ptr C'GtsSurface -> IO (Ptr C'GSList)
foreign import ccall "&gts_surface_split" p'gts_surface_split
  :: FunPtr (Ptr C'GtsSurface -> IO (Ptr C'GSList))

{-# LINE 428 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_surface_write" c'gts_surface_write
  :: Ptr C'GtsSurface -> Ptr CFile -> IO ()
foreign import ccall "&gts_surface_write" p'gts_surface_write
  :: FunPtr (Ptr C'GtsSurface -> Ptr CFile -> IO ())

{-# LINE 429 "src/Bindings/GTS.hsc" #-}

data C'GtsSurfaceInterClass = C'GtsSurfaceInterClass{
{-# LINE 431 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsSurfaceInterClass where
  sizeOf _ = 92
  alignment = sizeOf
  peek p = do
    return $ C'GtsSurfaceInterClass
  poke p (C'GtsSurfaceInterClass) = do
    return ()

{-# LINE 432 "src/Bindings/GTS.hsc" #-}

data C'GtsSurfaceInter = C'GtsSurfaceInter{
{-# LINE 434 "src/Bindings/GTS.hsc" #-}

  c'GtsSurfaceInter's1 :: Ptr C'GtsSurface
{-# LINE 435 "src/Bindings/GTS.hsc" #-}
,
  c'GtsSurfaceInter's2 :: Ptr C'GtsSurface
{-# LINE 436 "src/Bindings/GTS.hsc" #-}
,
  c'GtsSurfaceInter'edges :: Ptr C'GSList
{-# LINE 437 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsSurfaceInter where
  sizeOf _ = 24
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 12
    v1 <- peekByteOff p 16
    v2 <- peekByteOff p 20
    return $ C'GtsSurfaceInter v0 v1 v2
  poke p (C'GtsSurfaceInter v0 v1 v2) = do
    pokeByteOff p 12 v0
    pokeByteOff p 16 v1
    pokeByteOff p 20 v2
    return ()

{-# LINE 438 "src/Bindings/GTS.hsc" #-}

data C'GNode = C'GNode{
{-# LINE 440 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GNode where
  sizeOf _ = 20
  alignment = sizeOf
  peek p = do
    return $ C'GNode
  poke p (C'GNode) = do
    return ()

{-# LINE 441 "src/Bindings/GTS.hsc" #-}

-- | Create a new GTS Face from the 3 edges
foreign import ccall "gts_face_new" c'gts_face_new
  :: Ptr C'GtsFaceClass -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> IO (Ptr C'GtsFace)
foreign import ccall "&gts_face_new" p'gts_face_new
  :: FunPtr (Ptr C'GtsFaceClass -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> Ptr C'GtsEdge -> IO (Ptr C'GtsFace))

{-# LINE 444 "src/Bindings/GTS.hsc" #-}

-- | Get the class for a surface intersection
foreign import ccall "gts_surface_inter_class" c'gts_surface_inter_class
  :: IO (Ptr C'GtsSurfaceInterClass)
foreign import ccall "&gts_surface_inter_class" p'gts_surface_inter_class
  :: FunPtr (IO (Ptr C'GtsSurfaceInterClass))

{-# LINE 447 "src/Bindings/GTS.hsc" #-}

-- | Create a new surface intersection from the two surfaces and the precomputed face bounding box trees
foreign import ccall "gts_surface_inter_new" c'gts_surface_inter_new
  :: Ptr C'GtsSurfaceInterClass -> Ptr C'GtsSurface -> Ptr C'GtsSurface -> Ptr C'GNode -> Ptr C'GNode -> C'gboolean -> C'gboolean -> IO (Ptr C'GtsSurfaceInter)
foreign import ccall "&gts_surface_inter_new" p'gts_surface_inter_new
  :: FunPtr (Ptr C'GtsSurfaceInterClass -> Ptr C'GtsSurface -> Ptr C'GtsSurface -> Ptr C'GNode -> Ptr C'GNode -> C'gboolean -> C'gboolean -> IO (Ptr C'GtsSurfaceInter))

{-# LINE 450 "src/Bindings/GTS.hsc" #-}

-- | True iff the edges in the intersection form a closed curve
foreign import ccall "gts_surface_inter_check" c'gts_surface_inter_check
  :: Ptr C'GtsSurfaceInter -> Ptr C'gboolean -> IO C'gboolean
foreign import ccall "&gts_surface_inter_check" p'gts_surface_inter_check
  :: FunPtr (Ptr C'GtsSurfaceInter -> Ptr C'gboolean -> IO C'gboolean)

{-# LINE 453 "src/Bindings/GTS.hsc" #-}

-- | Adds to surface the part of the surface described by si and op.
foreign import ccall "gts_surface_inter_boolean" c'gts_surface_inter_boolean
  :: Ptr C'GtsSurfaceInter -> Ptr C'GtsSurface -> C'guint -> IO ()
foreign import ccall "&gts_surface_inter_boolean" p'gts_surface_inter_boolean
  :: FunPtr (Ptr C'GtsSurfaceInter -> Ptr C'GtsSurface -> C'guint -> IO ())

{-# LINE 456 "src/Bindings/GTS.hsc" #-}

-- | A new GtsSurface containing the faces of s which are self-intersecting or NULL if no faces of s are self-intersecting.
foreign import ccall "gts_surface_is_self_intersecting" c'gts_surface_is_self_intersecting
  :: Ptr C'GtsSurface -> IO (Ptr C'GtsSurface)
foreign import ccall "&gts_surface_is_self_intersecting" p'gts_surface_is_self_intersecting
  :: FunPtr (Ptr C'GtsSurface -> IO (Ptr C'GtsSurface))

{-# LINE 459 "src/Bindings/GTS.hsc" #-}

-- | A list of GtsEdge defining the curve intersection of the two surfaces.
foreign import ccall "gts_surface_intersection" c'gts_surface_intersection
  :: Ptr C'GtsSurface -> Ptr C'GtsSurface -> Ptr C'GNode -> Ptr C'GNode -> IO (Ptr C'GSList)
foreign import ccall "&gts_surface_intersection" p'gts_surface_intersection
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsSurface -> Ptr C'GNode -> Ptr C'GNode -> IO (Ptr C'GSList))

{-# LINE 462 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_bb_tree_new" c'gts_bb_tree_new
  :: Ptr C'GSList -> IO (Ptr C'GNode)
foreign import ccall "&gts_bb_tree_new" p'gts_bb_tree_new
  :: FunPtr (Ptr C'GSList -> IO (Ptr C'GNode))

{-# LINE 464 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_bb_tree_surface" c'gts_bb_tree_surface
  :: Ptr C'GtsSurface -> IO (Ptr C'GNode)
foreign import ccall "&gts_bb_tree_surface" p'gts_bb_tree_surface
  :: FunPtr (Ptr C'GtsSurface -> IO (Ptr C'GNode))

{-# LINE 465 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_bb_tree_destroy" c'gts_bb_tree_destroy
  :: Ptr C'GNode -> C'gboolean -> IO ()
foreign import ccall "&gts_bb_tree_destroy" p'gts_bb_tree_destroy
  :: FunPtr (Ptr C'GNode -> C'gboolean -> IO ())

{-# LINE 467 "src/Bindings/GTS.hsc" #-}

-- | TRUE if the ray starting at p and ending at (+infty, p-> y, p-> z) intersects with bb, FALSE otherwise.
foreign import ccall "gts_bb_tree_stabbed" c'gts_bb_tree_stabbed
  :: Ptr C'GNode -> Ptr C'GtsPoint -> IO (Ptr C'GSList)
foreign import ccall "&gts_bb_tree_stabbed" p'gts_bb_tree_stabbed
  :: FunPtr (Ptr C'GNode -> Ptr C'GtsPoint -> IO (Ptr C'GSList))

{-# LINE 470 "src/Bindings/GTS.hsc" #-}

-- | Destroy a GTS object and free the associated memory. This is the generic version, see the typed helper functions
foreign import ccall "gts_object_destroy" c'gts_object_destroy
  :: Ptr C'GtsObject -> IO ()
foreign import ccall "&gts_object_destroy" p'gts_object_destroy
  :: FunPtr (Ptr C'GtsObject -> IO ())

{-# LINE 473 "src/Bindings/GTS.hsc" #-}

-- #starttype GtsConstraintClass
-- #stoptype

-- #starttype GtsConstraint
-- #stoptype

type C'GtsEncroachFunc = FunPtr (Ptr C'GtsVertex -> Ptr C'GtsEdge -> Ptr C'GtsSurface -> C'gpointer -> IO C'gboolean)
foreign import ccall "wrapper" mk'GtsEncroachFunc
  :: (Ptr C'GtsVertex -> Ptr C'GtsEdge -> Ptr C'GtsSurface -> C'gpointer -> IO C'gboolean) -> IO C'GtsEncroachFunc
foreign import ccall "dynamic" mK'GtsEncroachFunc
  :: C'GtsEncroachFunc -> (Ptr C'GtsVertex -> Ptr C'GtsEdge -> Ptr C'GtsSurface -> C'gpointer -> IO C'gboolean)

{-# LINE 481 "src/Bindings/GTS.hsc" #-}
type C'GtsKeyFunc = FunPtr (C'gpointer -> C'gpointer -> IO C'gdouble)
foreign import ccall "wrapper" mk'GtsKeyFunc
  :: (C'gpointer -> C'gpointer -> IO C'gdouble) -> IO C'GtsKeyFunc
foreign import ccall "dynamic" mK'GtsKeyFunc
  :: C'GtsKeyFunc -> (C'gpointer -> C'gpointer -> IO C'gdouble)

{-# LINE 482 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_constraint_class" c'gts_constraint_class
  :: IO (Ptr C'GtsEdgeClass)
foreign import ccall "&gts_constraint_class" p'gts_constraint_class
  :: FunPtr (IO (Ptr C'GtsEdgeClass))

{-# LINE 484 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_point_locate" c'gts_point_locate
  :: Ptr C'GtsPoint -> Ptr C'GtsSurface -> Ptr C'GtsFace -> IO (Ptr C'GtsFace)
foreign import ccall "&gts_point_locate" p'gts_point_locate
  :: FunPtr (Ptr C'GtsPoint -> Ptr C'GtsSurface -> Ptr C'GtsFace -> IO (Ptr C'GtsFace))

{-# LINE 485 "src/Bindings/GTS.hsc" #-}

-- | Create a new edge from a pair of vertices
foreign import ccall "gts_edge_new" c'gts_edge_new
  :: Ptr C'GtsEdgeClass -> Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO (Ptr C'GtsEdge)
foreign import ccall "&gts_edge_new" p'gts_edge_new
  :: FunPtr (Ptr C'GtsEdgeClass -> Ptr C'GtsVertex -> Ptr C'GtsVertex -> IO (Ptr C'GtsEdge))

{-# LINE 488 "src/Bindings/GTS.hsc" #-}

-- | Replaces e with with. For each triangle which uses e as an edge, e is replaced with with. The with-> triangles list is updated appropriately and the e-> triangles list is freed and set to NULL
foreign import ccall "gts_edge_replace" c'gts_edge_replace
  :: Ptr C'GtsEdge -> Ptr C'GtsEdge -> IO ()
foreign import ccall "&gts_edge_replace" p'gts_edge_replace
  :: FunPtr (Ptr C'GtsEdge -> Ptr C'GtsEdge -> IO ())

{-# LINE 491 "src/Bindings/GTS.hsc" #-}

-- | Performs an "edge swap" on the two triangles sharing e and belonging to s.
foreign import ccall "gts_edge_swap" c'gts_edge_swap
  :: Ptr C'GtsEdge -> Ptr C'GtsSurface -> IO ()
foreign import ccall "&gts_edge_swap" p'gts_edge_swap
  :: FunPtr (Ptr C'GtsEdge -> Ptr C'GtsSurface -> IO ())

{-# LINE 494 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_segment_triangle_intersection" c'gts_segment_triangle_intersection
  :: Ptr C'GtsSegment -> Ptr C'GtsTriangle -> C'gboolean -> IO (Ptr C'GtsPoint)
foreign import ccall "&gts_segment_triangle_intersection" p'gts_segment_triangle_intersection
  :: FunPtr (Ptr C'GtsSegment -> Ptr C'GtsTriangle -> C'gboolean -> IO (Ptr C'GtsPoint))

{-# LINE 496 "src/Bindings/GTS.hsc" #-}

-- | Tests if the planar projection (x, y) of p is inside or outside the circumcircle of the planar projection of t. This function is geometrically robust.
foreign import ccall "gts_point_in_triangle_circle" c'gts_point_in_triangle_circle
  :: Ptr C'GtsPoint -> Ptr C'GtsTriangle -> IO C'gdouble
foreign import ccall "&gts_point_in_triangle_circle" p'gts_point_in_triangle_circle
  :: FunPtr (Ptr C'GtsPoint -> Ptr C'GtsTriangle -> IO C'gdouble)

{-# LINE 499 "src/Bindings/GTS.hsc" #-}

-- | Checks for orientation of the projection of three points on the (x,y) plane. The result is also an approximation of twice the signed area of the triangle defined by the three points. This function uses adaptive floating point arithmetic and is consequently geometrically robust.
foreign import ccall "gts_point_orientation" c'gts_point_orientation
  :: Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> IO C'gdouble
foreign import ccall "&gts_point_orientation" p'gts_point_orientation
  :: FunPtr (Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> IO C'gdouble)

{-# LINE 502 "src/Bindings/GTS.hsc" #-}

-- | TRUE if p is inside the surface defined by tree, FALSE otherwise.
foreign import ccall "gts_point_is_inside_surface" c'gts_point_is_inside_surface
  :: Ptr C'GtsPoint -> Ptr C'GNode -> C'gboolean -> IO C'gboolean
foreign import ccall "&gts_point_is_inside_surface" p'gts_point_is_inside_surface
  :: FunPtr (Ptr C'GtsPoint -> Ptr C'GNode -> C'gboolean -> IO C'gboolean)

{-# LINE 505 "src/Bindings/GTS.hsc" #-}

-- | Tests if the planar projection (x, y) of p is inside or outside the circle defined by the planar projection of p1, p2 and p3.
foreign import ccall "gts_point_in_circle" c'gts_point_in_circle
  :: Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> IO C'gdouble
foreign import ccall "&gts_point_in_circle" p'gts_point_in_circle
  :: FunPtr (Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> IO C'gdouble)

{-# LINE 508 "src/Bindings/GTS.hsc" #-}

-- | Checks if p4 lies above, below or on the plane passing through the points p1, p2 and p3. Below is defined so that p1, p2 and p3 appear in counterclockwise order when viewed from above the plane. The returned value is an approximation of six times the signed volume of the tetrahedron defined by the four points. This function uses adaptive floating point arithmetic and is consequently geometrically robust.
foreign import ccall "gts_point_orientation_3d" c'gts_point_orientation_3d
  :: Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> IO C'gdouble
foreign import ccall "&gts_point_orientation_3d" p'gts_point_orientation_3d
  :: FunPtr (Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> Ptr C'GtsPoint -> IO C'gdouble)

{-# LINE 511 "src/Bindings/GTS.hsc" #-}

data C'GtsBBoxClass = C'GtsBBoxClass{
{-# LINE 513 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsBBoxClass where
  sizeOf _ = 92
  alignment = sizeOf
  peek p = do
    return $ C'GtsBBoxClass
  poke p (C'GtsBBoxClass) = do
    return ()

{-# LINE 514 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_bbox_class" c'gts_bbox_class
  :: IO (Ptr C'GtsBBoxClass)
foreign import ccall "&gts_bbox_class" p'gts_bbox_class
  :: FunPtr (IO (Ptr C'GtsBBoxClass))

{-# LINE 515 "src/Bindings/GTS.hsc" #-}

data C'GtsBBox = C'GtsBBox{
{-# LINE 517 "src/Bindings/GTS.hsc" #-}

  c'GtsBBox'x1 :: C'gdouble
{-# LINE 518 "src/Bindings/GTS.hsc" #-}
,
  c'GtsBBox'y1 :: C'gdouble
{-# LINE 519 "src/Bindings/GTS.hsc" #-}
,
  c'GtsBBox'z1 :: C'gdouble
{-# LINE 520 "src/Bindings/GTS.hsc" #-}
,
  c'GtsBBox'x2 :: C'gdouble
{-# LINE 521 "src/Bindings/GTS.hsc" #-}
,
  c'GtsBBox'y2 :: C'gdouble
{-# LINE 522 "src/Bindings/GTS.hsc" #-}
,
  c'GtsBBox'z2 :: C'gdouble
{-# LINE 523 "src/Bindings/GTS.hsc" #-}
,
  c'GtsBBox'bounded :: C'gpointer
{-# LINE 524 "src/Bindings/GTS.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GtsBBox where
  sizeOf _ = 64
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 16
    v1 <- peekByteOff p 24
    v2 <- peekByteOff p 32
    v3 <- peekByteOff p 40
    v4 <- peekByteOff p 48
    v5 <- peekByteOff p 56
    v6 <- peekByteOff p 12
    return $ C'GtsBBox v0 v1 v2 v3 v4 v5 v6
  poke p (C'GtsBBox v0 v1 v2 v3 v4 v5 v6) = do
    pokeByteOff p 16 v0
    pokeByteOff p 24 v1
    pokeByteOff p 32 v2
    pokeByteOff p 40 v3
    pokeByteOff p 48 v4
    pokeByteOff p 56 v5
    pokeByteOff p 12 v6
    return ()

{-# LINE 525 "src/Bindings/GTS.hsc" #-}

-- | A list of triangle strips containing all the triangles of s. A triangle strip is itself a list of successive triangles having one edge in common.
foreign import ccall "gts_surface_strip" c'gts_surface_strip
  :: Ptr C'GtsSurface -> IO (Ptr C'GSList)
foreign import ccall "&gts_surface_strip" p'gts_surface_strip
  :: FunPtr (Ptr C'GtsSurface -> IO (Ptr C'GSList))

{-# LINE 528 "src/Bindings/GTS.hsc" #-}

-- | Using the gts_bb_tree_surface_distance() and gts_bb_tree_surface_boundary_distance() functions fills face_range and boundary_range with the min, max and average Euclidean (minimum) distances between the faces of s1 and the faces of s2 and between the boundary edges of s1 and s2.
foreign import ccall "gts_surface_distance" c'gts_surface_distance
  :: Ptr C'GtsSurface -> Ptr C'GtsSurface -> C'gdouble -> Ptr C'GtsRange -> Ptr C'GtsRange -> IO ()
foreign import ccall "&gts_surface_distance" p'gts_surface_distance
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsSurface -> C'gdouble -> Ptr C'GtsRange -> Ptr C'GtsRange -> IO ())

{-# LINE 531 "src/Bindings/GTS.hsc" #-}

-- | A new GtsBBox bounding box of surface.
foreign import ccall "gts_bbox_surface" c'gts_bbox_surface
  :: Ptr C'GtsBBoxClass -> Ptr C'GtsSurface -> IO ( Ptr C'GtsBBox )
foreign import ccall "&gts_bbox_surface" p'gts_bbox_surface
  :: FunPtr (Ptr C'GtsBBoxClass -> Ptr C'GtsSurface -> IO ( Ptr C'GtsBBox ))

{-# LINE 534 "src/Bindings/GTS.hsc" #-}

-- | TRUE if the bounding boxes bb1 and bb2 are overlapping (including just touching), FALSE otherwise.
foreign import ccall "gts_bboxes_are_overlapping" c'gts_bboxes_are_overlapping
  :: Ptr C'GtsBBox -> Ptr C'GtsBBox -> IO C'gboolean
foreign import ccall "&gts_bboxes_are_overlapping" p'gts_bboxes_are_overlapping
  :: FunPtr (Ptr C'GtsBBox -> Ptr C'GtsBBox -> IO C'gboolean)

{-# LINE 537 "src/Bindings/GTS.hsc" #-}

-- | Add a constraint edge to a Delaunay surface
foreign import ccall "gts_delaunay_add_constraint" c'gts_delaunay_add_constraint
  :: Ptr C'GtsSurface -> Ptr C'GtsEdge -> IO (Ptr C'GSList)
foreign import ccall "&gts_delaunay_add_constraint" p'gts_delaunay_add_constraint
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsEdge -> IO (Ptr C'GSList))

{-# LINE 540 "src/Bindings/GTS.hsc" #-}

-- | NULL if the planar projection of surface is a Delaunay triangulation (unconstrained), a GtsFace violating the Delaunay property otherwise.
foreign import ccall "gts_delaunay_check" c'gts_delaunay_check
  :: Ptr C'GtsSurface -> IO (Ptr C'GtsFace)
foreign import ccall "&gts_delaunay_check" p'gts_delaunay_check
  :: FunPtr (Ptr C'GtsSurface -> IO (Ptr C'GtsFace))

{-# LINE 543 "src/Bindings/GTS.hsc" #-}

-- | Removes all the edges of the boundary of surface which are not constraints.
foreign import ccall "gts_delaunay_remove_hull" c'gts_delaunay_remove_hull
  :: Ptr C'GtsSurface -> IO ()
foreign import ccall "&gts_delaunay_remove_hull" p'gts_delaunay_remove_hull
  :: FunPtr (Ptr C'GtsSurface -> IO ())

{-# LINE 546 "src/Bindings/GTS.hsc" #-}

-- | Recursively split constraints of surface which are encroached by vertices of surface (see Shewchuk 96 for details). The split constraints are destroyed and replaced by a set of new constraints of the same class. If gts_vertex_encroaches_edge() is used for encroaches, the resulting surface will be Delaunay conforming. If steiner_max is positive or nul, the recursive splitting procedure will stop when this maximum number of Steiner points is reached. In that case the resulting surface will not necessarily be Delaunay conforming.
foreign import ccall "gts_delaunay_conform" c'gts_delaunay_conform
  :: Ptr C'GtsSurface -> C'gint -> C'GtsEncroachFunc -> C'gpointer -> IO C'guint
foreign import ccall "&gts_delaunay_conform" p'gts_delaunay_conform
  :: FunPtr (Ptr C'GtsSurface -> C'gint -> C'GtsEncroachFunc -> C'gpointer -> IO C'guint)

{-# LINE 549 "src/Bindings/GTS.hsc" #-}

-- | An implementation of the refinement algorithm described in Ruppert (1995) and Shewchuk (1996).
foreign import ccall "gts_delaunay_refine" c'gts_delaunay_refine
  :: Ptr C'GtsSurface -> C'gint -> C'GtsEncroachFunc -> C'gpointer -> C'GtsKeyFunc -> C'gpointer -> IO C'guint
foreign import ccall "&gts_delaunay_refine" p'gts_delaunay_refine
  :: FunPtr (Ptr C'GtsSurface -> C'gint -> C'GtsEncroachFunc -> C'gpointer -> C'GtsKeyFunc -> C'gpointer -> IO C'guint)

{-# LINE 552 "src/Bindings/GTS.hsc" #-}

-- | Add one vertex to a Delaunay triangulation preserving the Delaunay property
foreign import ccall "gts_delaunay_add_vertex" c'gts_delaunay_add_vertex
  :: Ptr C'GtsSurface -> Ptr C'GtsVertex -> Ptr C'GtsFace -> IO (Ptr C'GtsVertex)
foreign import ccall "&gts_delaunay_add_vertex" p'gts_delaunay_add_vertex
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsVertex -> Ptr C'GtsFace -> IO (Ptr C'GtsVertex))

{-# LINE 555 "src/Bindings/GTS.hsc" #-}

-- | Add one vertex to a face of a Delaunay triangulation preserving the Delaunay property
foreign import ccall "gts_delaunay_add_vertex_to_face" c'gts_delaunay_add_vertex_to_face
  :: Ptr C'GtsSurface -> Ptr C'GtsVertex -> Ptr C'GtsFace -> IO (Ptr C'GtsVertex)
foreign import ccall "&gts_delaunay_add_vertex_to_face" p'gts_delaunay_add_vertex_to_face
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsVertex -> Ptr C'GtsFace -> IO (Ptr C'GtsVertex))

{-# LINE 558 "src/Bindings/GTS.hsc" #-}

-- | Removes v from the Delaunay triangulation defined by surface and restores the Delaunay property. Vertex v must not be used by any constrained edge otherwise the triangulation is not guaranteed to be Delaunay.
foreign import ccall "gts_delaunay_remove_vertex" c'gts_delaunay_remove_vertex
  :: Ptr C'GtsSurface -> Ptr C'GtsVertex -> IO ()
foreign import ccall "&gts_delaunay_remove_vertex" p'gts_delaunay_remove_vertex
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsVertex -> IO ())

{-# LINE 561 "src/Bindings/GTS.hsc" #-}

-- Typed helper functions
foreign import ccall "gts_surface_destroy" c'gts_surface_destroy
  :: Ptr C'GtsSurface -> IO ()
foreign import ccall "&gts_surface_destroy" p'gts_surface_destroy
  :: FunPtr (Ptr C'GtsSurface -> IO ())

{-# LINE 564 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_triangle_destroy" c'gts_triangle_destroy
  :: Ptr C'GtsTriangle -> IO ()
foreign import ccall "&gts_triangle_destroy" p'gts_triangle_destroy
  :: FunPtr (Ptr C'GtsTriangle -> IO ())

{-# LINE 565 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_vertex_destroy" c'gts_vertex_destroy
  :: Ptr C'GtsVertex -> IO ()
foreign import ccall "&gts_vertex_destroy" p'gts_vertex_destroy
  :: FunPtr (Ptr C'GtsVertex -> IO ())

{-# LINE 566 "src/Bindings/GTS.hsc" #-}

data C'GtsSurfaceTraverse = C'GtsSurfaceTraverse

{-# LINE 568 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_surface_traverse_new" c'gts_surface_traverse_new
  :: Ptr C'GtsSurface -> Ptr C'GtsFace -> IO (Ptr C'GtsSurfaceTraverse)
foreign import ccall "&gts_surface_traverse_new" p'gts_surface_traverse_new
  :: FunPtr (Ptr C'GtsSurface -> Ptr C'GtsFace -> IO (Ptr C'GtsSurfaceTraverse))

{-# LINE 570 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_surface_traverse_next" c'gts_surface_traverse_next
  :: Ptr C'GtsSurfaceTraverse -> Ptr C'guint -> IO (Ptr C'GtsFace)
foreign import ccall "&gts_surface_traverse_next" p'gts_surface_traverse_next
  :: FunPtr (Ptr C'GtsSurfaceTraverse -> Ptr C'guint -> IO (Ptr C'GtsFace))

{-# LINE 571 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_surface_traverse_destroy" c'gts_surface_traverse_destroy
  :: Ptr C'GtsSurfaceTraverse -> IO ()
foreign import ccall "&gts_surface_traverse_destroy" p'gts_surface_traverse_destroy
  :: FunPtr (Ptr C'GtsSurfaceTraverse -> IO ())

{-# LINE 572 "src/Bindings/GTS.hsc" #-}

type C'GtsRefineFunc = FunPtr (Ptr C'GtsEdge -> Ptr C'GtsVertexClass -> C'gpointer -> IO (Ptr C'GtsVertex))
foreign import ccall "wrapper" mk'GtsRefineFunc
  :: (Ptr C'GtsEdge -> Ptr C'GtsVertexClass -> C'gpointer -> IO (Ptr C'GtsVertex)) -> IO C'GtsRefineFunc
foreign import ccall "dynamic" mK'GtsRefineFunc
  :: C'GtsRefineFunc -> (Ptr C'GtsEdge -> Ptr C'GtsVertexClass -> C'gpointer -> IO (Ptr C'GtsVertex))

{-# LINE 574 "src/Bindings/GTS.hsc" #-}
type C'GtsStopFunc = FunPtr (C'gdouble -> C'guint -> C'gpointer -> IO C'gboolean)
foreign import ccall "wrapper" mk'GtsStopFunc
  :: (C'gdouble -> C'guint -> C'gpointer -> IO C'gboolean) -> IO C'GtsStopFunc
foreign import ccall "dynamic" mK'GtsStopFunc
  :: C'GtsStopFunc -> (C'gdouble -> C'guint -> C'gpointer -> IO C'gboolean)

{-# LINE 575 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_surface_tessellate" c'gts_surface_tessellate
  :: Ptr C'GtsSurface -> C'GtsRefineFunc -> C'gpointer -> IO ()
foreign import ccall "&gts_surface_tessellate" p'gts_surface_tessellate
  :: FunPtr (Ptr C'GtsSurface -> C'GtsRefineFunc -> C'gpointer -> IO ())

{-# LINE 577 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_surface_refine" c'gts_surface_refine
  :: Ptr C'GtsSurface -> C'GtsKeyFunc -> C'gpointer -> C'GtsRefineFunc -> C'gpointer -> C'GtsStopFunc -> C'gpointer -> IO ()
foreign import ccall "&gts_surface_refine" p'gts_surface_refine
  :: FunPtr (Ptr C'GtsSurface -> C'GtsKeyFunc -> C'gpointer -> C'GtsRefineFunc -> C'gpointer -> C'GtsStopFunc -> C'gpointer -> IO ())

{-# LINE 578 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_edge_face_number" c'gts_edge_face_number
  :: Ptr C'GtsEdge -> Ptr C'GtsSurface -> IO C'guint
foreign import ccall "&gts_edge_face_number" p'gts_edge_face_number
  :: FunPtr (Ptr C'GtsEdge -> Ptr C'GtsSurface -> IO C'guint)

{-# LINE 580 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_edge_manifold_faces" c'gts_edge_manifold_faces
  :: Ptr C'GtsEdge -> Ptr C'GtsSurface -> Ptr (Ptr C'GtsFace) -> Ptr (Ptr C'GtsFace) -> C'gboolean
foreign import ccall "&gts_edge_manifold_faces" p'gts_edge_manifold_faces
  :: FunPtr (Ptr C'GtsEdge -> Ptr C'GtsSurface -> Ptr (Ptr C'GtsFace) -> Ptr (Ptr C'GtsFace) -> C'gboolean)

{-# LINE 581 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_edge_belongs_to_tetrahedron" c'gts_edge_belongs_to_tetrahedron
  :: Ptr C'GtsEdge -> C'gboolean
foreign import ccall "&gts_edge_belongs_to_tetrahedron" p'gts_edge_belongs_to_tetrahedron
  :: FunPtr (Ptr C'GtsEdge -> C'gboolean)

{-# LINE 582 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_edges_from_vertices" c'gts_edges_from_vertices
  :: Ptr C'GSList -> Ptr C'GtsSurface -> IO (Ptr C'GSList)
foreign import ccall "&gts_edges_from_vertices" p'gts_edges_from_vertices
  :: FunPtr (Ptr C'GSList -> Ptr C'GtsSurface -> IO (Ptr C'GSList))

{-# LINE 584 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_edges_merge" c'gts_edges_merge
  :: Ptr C'GList -> IO (Ptr C'GList)
foreign import ccall "&gts_edges_merge" p'gts_edges_merge
  :: FunPtr (Ptr C'GList -> IO (Ptr C'GList))

{-# LINE 585 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_edge_is_contact" c'gts_edge_is_contact
  :: Ptr C'GtsEdge -> IO C'guint
foreign import ccall "&gts_edge_is_contact" p'gts_edge_is_contact
  :: FunPtr (Ptr C'GtsEdge -> IO C'guint)

{-# LINE 587 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_edge_is_boundary" c'gts_edge_is_boundary
  :: Ptr C'GtsEdge -> Ptr C'GtsSurface -> IO (Ptr C'GtsFace)
foreign import ccall "&gts_edge_is_boundary" p'gts_edge_is_boundary
  :: FunPtr (Ptr C'GtsEdge -> Ptr C'GtsSurface -> IO (Ptr C'GtsFace))

{-# LINE 588 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_edge_has_any_parent_surface" c'gts_edge_has_any_parent_surface
  :: Ptr C'GtsEdge -> IO (Ptr C'GtsFace)
foreign import ccall "&gts_edge_has_any_parent_surface" p'gts_edge_has_any_parent_surface
  :: FunPtr (Ptr C'GtsEdge -> IO (Ptr C'GtsFace))

{-# LINE 589 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_edge_has_parent_surface" c'gts_edge_has_parent_surface
  :: Ptr C'GtsEdge -> Ptr C'GtsSurface -> IO (Ptr C'GtsFace)
foreign import ccall "&gts_edge_has_parent_surface" p'gts_edge_has_parent_surface
  :: FunPtr (Ptr C'GtsEdge -> Ptr C'GtsSurface -> IO (Ptr C'GtsFace))

{-# LINE 590 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_edge_is_duplicate" c'gts_edge_is_duplicate
  :: Ptr C'GtsEdge -> IO (Ptr C'GtsEdge)
foreign import ccall "&gts_edge_is_duplicate" p'gts_edge_is_duplicate
  :: FunPtr (Ptr C'GtsEdge -> IO (Ptr C'GtsEdge))

{-# LINE 591 "src/Bindings/GTS.hsc" #-}

foreign import ccall "inline_gts_edge_is_unattached" c'gts_edge_is_unattached
  :: Ptr C'GtsEdge -> IO C'gboolean

{-# LINE 593 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_face_has_parent_surface" c'gts_face_has_parent_surface
  :: Ptr C'GtsFace -> Ptr C'GtsSurface -> IO C'gboolean
foreign import ccall "&gts_face_has_parent_surface" p'gts_face_has_parent_surface
  :: FunPtr (Ptr C'GtsFace -> Ptr C'GtsSurface -> IO C'gboolean)

{-# LINE 595 "src/Bindings/GTS.hsc" #-}

foreign import ccall "gts_triangle_revert_func" c'gts_triangle_revert_func
  :: C'gpointer -> C'gpointer -> IO C'gint
foreign import ccall "&gts_triangle_revert_func" p'gts_triangle_revert_func
  :: FunPtr (C'gpointer -> C'gpointer -> IO C'gint)

{-# LINE 597 "src/Bindings/GTS.hsc" #-}

-- | Shutdown GTS and free all memory
-- NOTE: after calling this method no other GTS functions may be called
foreign import ccall "gts_finalize" c'gts_finalize
  :: IO ()
foreign import ccall "&gts_finalize" p'gts_finalize
  :: FunPtr (IO ())

{-# LINE 601 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_object_reset_reserved" c'gts_object_reset_reserved
  :: Ptr C'GtsObject -> IO ()
foreign import ccall "&gts_object_reset_reserved" p'gts_object_reset_reserved
  :: FunPtr (Ptr C'GtsObject -> IO ())

{-# LINE 602 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_object_attributes" c'gts_object_attributes
  :: Ptr C'GtsObject -> Ptr C'GtsObject -> IO ()
foreign import ccall "&gts_object_attributes" p'gts_object_attributes
  :: FunPtr (Ptr C'GtsObject -> Ptr C'GtsObject -> IO ())

{-# LINE 603 "src/Bindings/GTS.hsc" #-}
foreign import ccall "gts_object_clone" c'gts_object_clone
  :: Ptr C'GtsObject -> IO (Ptr C'GtsObject)
foreign import ccall "&gts_object_clone" p'gts_object_clone
  :: FunPtr (Ptr C'GtsObject -> IO (Ptr C'GtsObject))

{-# LINE 604 "src/Bindings/GTS.hsc" #-}