{-# LINE 1 "FreeType/Format/CID/Internal.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module FreeType.Format.CID.Internal
  ( -- ** FT_Get_CID_Registry_Ordering_Supplement
    ft_Get_CID_Registry_Ordering_Supplement'
    -- ** FT_Get_CID_Is_Internally_CID_Keyed
  , ft_Get_CID_Is_Internally_CID_Keyed'
    -- ** FT_Get_CID_From_Glyph_Index
  , ft_Get_CID_From_Glyph_Index'
  ) where

import           FreeType.Core.Base
import           FreeType.Core.Types.Types

import           Data.Int
import           Foreign.Ptr




foreign import ccall "FT_Get_CID_Registry_Ordering_Supplement"
  ft_Get_CID_Registry_Ordering_Supplement'
    :: FT_Face                -- ^ face
    -> Ptr (Ptr Int8) -- ^ registry
{-# LINE 25 "FreeType/Format/CID/Internal.hsc" #-}
    -> Ptr (Ptr Int8) -- ^ ordering
{-# LINE 26 "FreeType/Format/CID/Internal.hsc" #-}
    -> Ptr FT_Int             -- ^ supplement
    -> IO FT_Error



foreign import ccall "FT_Get_CID_Is_Internally_CID_Keyed"
  ft_Get_CID_Is_Internally_CID_Keyed'
    :: FT_Face     -- ^ face
    -> Ptr FT_Bool -- ^ is_cid
    -> IO FT_Error



foreign import ccall "FT_Get_CID_From_Glyph_Index"
  ft_Get_CID_From_Glyph_Index'
    :: FT_Face     -- ^ face
    -> FT_UInt     -- ^ glyph_index
    -> Ptr FT_UInt -- ^ cid
    -> IO FT_Error