-- Generated code. {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE ForeignFunctionInterface, ConstraintKinds, TypeFamilies, MultiParamTypeClasses, KindSignatures, FlexibleInstances, UndecidableInstances, DataKinds, OverloadedStrings, NegativeLiterals, FlexibleContexts #-} module GI.Pango where import Prelude () import Data.GI.Base.ShortPrelude import Data.Char import Data.Int import Data.Word import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString) import qualified Data.Map as Map import Foreign.C import Foreign.Ptr import Foreign.ForeignPtr import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Storable (peek, poke, sizeOf) import Control.Applicative ((<$>)) import Control.Exception (onException) import Control.Monad.IO.Class import qualified Data.Text as T import Data.GI.Base.Attributes hiding (get, set) import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.Closure import Data.GI.Base.GError import Data.GI.Base.GHashTable import Data.GI.Base.GParamSpec import Data.GI.Base.GVariant import Data.GI.Base.GValue import Data.GI.Base.ManagedPtr import Data.GI.Base.Overloading import Data.GI.Base.Properties hiding (new) import Data.GI.Base.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId) import Data.GI.Base.Utils import qualified GI.GLib as GLib import qualified GI.GLibAttributes as GLibA import qualified GI.GObject as GObject import qualified GI.GObjectAttributes as GObjectA -- Enum Alignment data Alignment = AlignmentLeft | AlignmentCenter | AlignmentRight | AnotherAlignment Int deriving (Show, Eq) instance Enum Alignment where fromEnum AlignmentLeft = 0 fromEnum AlignmentCenter = 1 fromEnum AlignmentRight = 2 fromEnum (AnotherAlignment k) = k toEnum 0 = AlignmentLeft toEnum 1 = AlignmentCenter toEnum 2 = AlignmentRight toEnum k = AnotherAlignment k foreign import ccall "pango_alignment_get_type" c_pango_alignment_get_type :: IO GType instance BoxedEnum Alignment where boxedEnumType _ = c_pango_alignment_get_type -- struct Analysis newtype Analysis = Analysis (ForeignPtr Analysis) noAnalysis :: Maybe Analysis noAnalysis = Nothing analysisReadShapeEngine :: Analysis -> IO EngineShape analysisReadShapeEngine s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr EngineShape) val' <- (newObject EngineShape) val return val' analysisReadLangEngine :: Analysis -> IO EngineLang analysisReadLangEngine s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr EngineLang) val' <- (newObject EngineLang) val return val' analysisReadFont :: Analysis -> IO Font analysisReadFont s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Font) val' <- (newObject Font) val return val' analysisReadLevel :: Analysis -> IO Word8 analysisReadLevel s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Word8 return val analysisReadGravity :: Analysis -> IO Word8 analysisReadGravity s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 25) :: IO Word8 return val analysisReadFlags :: Analysis -> IO Word8 analysisReadFlags s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 26) :: IO Word8 return val analysisReadScript :: Analysis -> IO Word8 analysisReadScript s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 27) :: IO Word8 return val analysisReadLanguage :: Analysis -> IO Language analysisReadLanguage s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO (Ptr Language) val' <- (newBoxed Language) val return val' analysisReadExtraAttrs :: Analysis -> IO ([Ptr ()]) analysisReadExtraAttrs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO (Ptr (GSList (Ptr ()))) val' <- unpackGSList val return val' -- struct AttrClass newtype AttrClass = AttrClass (ForeignPtr AttrClass) noAttrClass :: Maybe AttrClass noAttrClass = Nothing attrClassReadType :: AttrClass -> IO AttrType attrClassReadType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' -- XXX Skipped getter for "AttrClass:destroy" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "AttrClass:equal" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- struct AttrColor newtype AttrColor = AttrColor (ForeignPtr AttrColor) noAttrColor :: Maybe AttrColor noAttrColor = Nothing attrColorReadAttr :: AttrColor -> IO Attribute attrColorReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Attribute) val' <- (newPtr 16 Attribute) val return val' attrColorReadColor :: AttrColor -> IO Color attrColorReadColor s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Color) val' <- (newBoxed Color) val return val' -- callback AttrFilterFunc attrFilterFuncClosure :: AttrFilterFunc -> IO Closure attrFilterFuncClosure cb = newCClosure =<< mkAttrFilterFunc wrapped where wrapped = attrFilterFuncWrapper Nothing cb type AttrFilterFuncC = Ptr Attribute -> Ptr () -> IO CInt foreign import ccall "wrapper" mkAttrFilterFunc :: AttrFilterFuncC -> IO (FunPtr AttrFilterFuncC) type AttrFilterFunc = Attribute -> IO Bool noAttrFilterFunc :: Maybe AttrFilterFunc noAttrFilterFunc = Nothing attrFilterFuncWrapper :: Maybe (Ptr (FunPtr (AttrFilterFuncC))) -> AttrFilterFunc -> Ptr Attribute -> Ptr () -> IO CInt attrFilterFuncWrapper funptrptr _cb attribute _ = do attribute' <- (newPtr 16 Attribute) attribute result <- _cb attribute' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- struct AttrFloat newtype AttrFloat = AttrFloat (ForeignPtr AttrFloat) noAttrFloat :: Maybe AttrFloat noAttrFloat = Nothing attrFloatReadAttr :: AttrFloat -> IO Attribute attrFloatReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Attribute) val' <- (newPtr 16 Attribute) val return val' attrFloatReadValue :: AttrFloat -> IO Double attrFloatReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CDouble let val' = realToFrac val return val' -- struct AttrFontDesc newtype AttrFontDesc = AttrFontDesc (ForeignPtr AttrFontDesc) noAttrFontDesc :: Maybe AttrFontDesc noAttrFontDesc = Nothing attrFontDescReadAttr :: AttrFontDesc -> IO Attribute attrFontDescReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Attribute) val' <- (newPtr 16 Attribute) val return val' attrFontDescReadDesc :: AttrFontDesc -> IO FontDescription attrFontDescReadDesc s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr FontDescription) val' <- (newBoxed FontDescription) val return val' -- struct AttrInt newtype AttrInt = AttrInt (ForeignPtr AttrInt) noAttrInt :: Maybe AttrInt noAttrInt = Nothing attrIntReadAttr :: AttrInt -> IO Attribute attrIntReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Attribute) val' <- (newPtr 16 Attribute) val return val' attrIntReadValue :: AttrInt -> IO Int32 attrIntReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Int32 return val -- struct AttrIterator newtype AttrIterator = AttrIterator (ForeignPtr AttrIterator) noAttrIterator :: Maybe AttrIterator noAttrIterator = Nothing -- method AttrIterator::destroy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attr_iterator_destroy" pango_attr_iterator_destroy :: Ptr AttrIterator -> -- _obj : TInterface "Pango" "AttrIterator" IO () attrIteratorDestroy :: (MonadIO m) => AttrIterator -> -- _obj m () attrIteratorDestroy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_attr_iterator_destroy _obj' touchManagedPtr _obj return () -- method AttrIterator::get_attrs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TInterface "Pango" "Attribute") -- throws : False -- Skip return : False foreign import ccall "pango_attr_iterator_get_attrs" pango_attr_iterator_get_attrs :: Ptr AttrIterator -> -- _obj : TInterface "Pango" "AttrIterator" IO (Ptr (GSList (Ptr Attribute))) attrIteratorGetAttrs :: (MonadIO m) => AttrIterator -> -- _obj m [Attribute] attrIteratorGetAttrs _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_attr_iterator_get_attrs _obj' checkUnexpectedReturnNULL "pango_attr_iterator_get_attrs" result result' <- unpackGSList result result'' <- mapM (wrapPtr Attribute) result' g_slist_free result touchManagedPtr _obj return result'' -- method AttrIterator::get_font -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "extra_attrs", argType = TGSList (TInterface "Pango" "Attribute"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "extra_attrs", argType = TGSList (TInterface "Pango" "Attribute"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attr_iterator_get_font" pango_attr_iterator_get_font :: Ptr AttrIterator -> -- _obj : TInterface "Pango" "AttrIterator" Ptr FontDescription -> -- desc : TInterface "Pango" "FontDescription" Ptr Language -> -- language : TInterface "Pango" "Language" Ptr (GSList (Ptr Attribute)) -> -- extra_attrs : TGSList (TInterface "Pango" "Attribute") IO () attrIteratorGetFont :: (MonadIO m) => AttrIterator -> -- _obj FontDescription -> -- desc Maybe (Language) -> -- language [Attribute] -> -- extra_attrs m () attrIteratorGetFont _obj desc language extra_attrs = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let desc' = unsafeManagedPtrGetPtr desc maybeLanguage <- case language of Nothing -> return nullPtr Just jLanguage -> do let jLanguage' = unsafeManagedPtrGetPtr jLanguage return jLanguage' let extra_attrs' = map unsafeManagedPtrGetPtr extra_attrs extra_attrs'' <- packGSList extra_attrs' pango_attr_iterator_get_font _obj' desc' maybeLanguage extra_attrs'' touchManagedPtr _obj touchManagedPtr desc whenJust language touchManagedPtr mapM_ touchManagedPtr extra_attrs return () -- method AttrIterator::next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_attr_iterator_next" pango_attr_iterator_next :: Ptr AttrIterator -> -- _obj : TInterface "Pango" "AttrIterator" IO CInt attrIteratorNext :: (MonadIO m) => AttrIterator -> -- _obj m Bool attrIteratorNext _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_attr_iterator_next _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method AttrIterator::range -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attr_iterator_range" pango_attr_iterator_range :: Ptr AttrIterator -> -- _obj : TInterface "Pango" "AttrIterator" Ptr Int32 -> -- start : TBasicType TInt32 Ptr Int32 -> -- end : TBasicType TInt32 IO () attrIteratorRange :: (MonadIO m) => AttrIterator -> -- _obj m (Int32,Int32) attrIteratorRange _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj start <- allocMem :: IO (Ptr Int32) end <- allocMem :: IO (Ptr Int32) pango_attr_iterator_range _obj' start end start' <- peek start end' <- peek end touchManagedPtr _obj freeMem start freeMem end return (start', end') -- struct AttrLanguage newtype AttrLanguage = AttrLanguage (ForeignPtr AttrLanguage) noAttrLanguage :: Maybe AttrLanguage noAttrLanguage = Nothing attrLanguageReadAttr :: AttrLanguage -> IO Attribute attrLanguageReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Attribute) val' <- (newPtr 16 Attribute) val return val' attrLanguageReadValue :: AttrLanguage -> IO Language attrLanguageReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Language) val' <- (newBoxed Language) val return val' -- struct AttrList newtype AttrList = AttrList (ForeignPtr AttrList) noAttrList :: Maybe AttrList noAttrList = Nothing foreign import ccall "pango_attr_list_get_type" c_pango_attr_list_get_type :: IO GType instance BoxedObject AttrList where boxedType _ = c_pango_attr_list_get_type -- method AttrList::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Pango" "AttrList" -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_new" pango_attr_list_new :: IO (Ptr AttrList) attrListNew :: (MonadIO m) => m AttrList attrListNew = liftIO $ do result <- pango_attr_list_new checkUnexpectedReturnNULL "pango_attr_list_new" result result' <- (wrapBoxed AttrList) result return result' -- method AttrList::change -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_change" pango_attr_list_change :: Ptr AttrList -> -- _obj : TInterface "Pango" "AttrList" Ptr Attribute -> -- attr : TInterface "Pango" "Attribute" IO () attrListChange :: (MonadIO m) => AttrList -> -- _obj Attribute -> -- attr m () attrListChange _obj attr = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let attr' = unsafeManagedPtrGetPtr attr pango_attr_list_change _obj' attr' touchManagedPtr _obj touchManagedPtr attr return () -- method AttrList::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "AttrList" -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_copy" pango_attr_list_copy :: Ptr AttrList -> -- _obj : TInterface "Pango" "AttrList" IO (Ptr AttrList) attrListCopy :: (MonadIO m) => AttrList -> -- _obj m AttrList attrListCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_attr_list_copy _obj' checkUnexpectedReturnNULL "pango_attr_list_copy" result result' <- (wrapBoxed AttrList) result touchManagedPtr _obj return result' -- method AttrList::filter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Pango" "AttrFilterFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Pango" "AttrFilterFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "AttrList" -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_filter" pango_attr_list_filter :: Ptr AttrList -> -- _obj : TInterface "Pango" "AttrList" FunPtr AttrFilterFuncC -> -- func : TInterface "Pango" "AttrFilterFunc" Ptr () -> -- data : TBasicType TVoid IO (Ptr AttrList) attrListFilter :: (MonadIO m) => AttrList -> -- _obj AttrFilterFunc -> -- func m AttrList attrListFilter _obj func = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj func' <- mkAttrFilterFunc (attrFilterFuncWrapper Nothing func) let data_ = nullPtr result <- pango_attr_list_filter _obj' func' data_ checkUnexpectedReturnNULL "pango_attr_list_filter" result result' <- (wrapBoxed AttrList) result safeFreeFunPtr $ castFunPtrToPtr func' touchManagedPtr _obj return result' -- method AttrList::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_insert" pango_attr_list_insert :: Ptr AttrList -> -- _obj : TInterface "Pango" "AttrList" Ptr Attribute -> -- attr : TInterface "Pango" "Attribute" IO () attrListInsert :: (MonadIO m) => AttrList -> -- _obj Attribute -> -- attr m () attrListInsert _obj attr = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let attr' = unsafeManagedPtrGetPtr attr pango_attr_list_insert _obj' attr' touchManagedPtr _obj touchManagedPtr attr return () -- method AttrList::insert_before -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_insert_before" pango_attr_list_insert_before :: Ptr AttrList -> -- _obj : TInterface "Pango" "AttrList" Ptr Attribute -> -- attr : TInterface "Pango" "Attribute" IO () attrListInsertBefore :: (MonadIO m) => AttrList -> -- _obj Attribute -> -- attr m () attrListInsertBefore _obj attr = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let attr' = unsafeManagedPtrGetPtr attr pango_attr_list_insert_before _obj' attr' touchManagedPtr _obj touchManagedPtr attr return () -- method AttrList::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "AttrList" -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_ref" pango_attr_list_ref :: Ptr AttrList -> -- _obj : TInterface "Pango" "AttrList" IO (Ptr AttrList) attrListRef :: (MonadIO m) => AttrList -> -- _obj m AttrList attrListRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_attr_list_ref _obj' checkUnexpectedReturnNULL "pango_attr_list_ref" result result' <- (wrapBoxed AttrList) result touchManagedPtr _obj return result' -- method AttrList::splice -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_splice" pango_attr_list_splice :: Ptr AttrList -> -- _obj : TInterface "Pango" "AttrList" Ptr AttrList -> -- other : TInterface "Pango" "AttrList" Int32 -> -- pos : TBasicType TInt32 Int32 -> -- len : TBasicType TInt32 IO () attrListSplice :: (MonadIO m) => AttrList -> -- _obj AttrList -> -- other Int32 -> -- pos Int32 -> -- len m () attrListSplice _obj other pos len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let other' = unsafeManagedPtrGetPtr other pango_attr_list_splice _obj' other' pos len touchManagedPtr _obj touchManagedPtr other return () -- method AttrList::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attr_list_unref" pango_attr_list_unref :: Ptr AttrList -> -- _obj : TInterface "Pango" "AttrList" IO () attrListUnref :: (MonadIO m) => AttrList -> -- _obj m () attrListUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_attr_list_unref _obj' touchManagedPtr _obj return () -- struct AttrShape newtype AttrShape = AttrShape (ForeignPtr AttrShape) noAttrShape :: Maybe AttrShape noAttrShape = Nothing attrShapeReadAttr :: AttrShape -> IO Attribute attrShapeReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Attribute) val' <- (newPtr 16 Attribute) val return val' attrShapeReadInkRect :: AttrShape -> IO Rectangle attrShapeReadInkRect s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Rectangle) val' <- (newPtr 16 Rectangle) val return val' attrShapeReadLogicalRect :: AttrShape -> IO Rectangle attrShapeReadLogicalRect s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO (Ptr Rectangle) val' <- (newPtr 16 Rectangle) val return val' attrShapeReadData :: AttrShape -> IO (Ptr ()) attrShapeReadData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO (Ptr ()) return val -- XXX Skipped getter for "AttrShape:destroy_func" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- struct AttrSize newtype AttrSize = AttrSize (ForeignPtr AttrSize) noAttrSize :: Maybe AttrSize noAttrSize = Nothing attrSizeReadAttr :: AttrSize -> IO Attribute attrSizeReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Attribute) val' <- (newPtr 16 Attribute) val return val' attrSizeReadSize :: AttrSize -> IO Int32 attrSizeReadSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Int32 return val attrSizeReadAbsolute :: AttrSize -> IO Word32 attrSizeReadAbsolute s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Word32 return val -- struct AttrString newtype AttrString = AttrString (ForeignPtr AttrString) noAttrString :: Maybe AttrString noAttrString = Nothing attrStringReadAttr :: AttrString -> IO Attribute attrStringReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Attribute) val' <- (newPtr 16 Attribute) val return val' attrStringReadValue :: AttrString -> IO T.Text attrStringReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' -- Enum AttrType data AttrType = AttrTypeInvalid | AttrTypeLanguage | AttrTypeFamily | AttrTypeStyle | AttrTypeWeight | AttrTypeVariant | AttrTypeStretch | AttrTypeSize | AttrTypeFontDesc | AttrTypeForeground | AttrTypeBackground | AttrTypeUnderline | AttrTypeStrikethrough | AttrTypeRise | AttrTypeShape | AttrTypeScale | AttrTypeFallback | AttrTypeLetterSpacing | AttrTypeUnderlineColor | AttrTypeStrikethroughColor | AttrTypeAbsoluteSize | AttrTypeGravity | AttrTypeGravityHint | AnotherAttrType Int deriving (Show, Eq) instance Enum AttrType where fromEnum AttrTypeInvalid = 0 fromEnum AttrTypeLanguage = 1 fromEnum AttrTypeFamily = 2 fromEnum AttrTypeStyle = 3 fromEnum AttrTypeWeight = 4 fromEnum AttrTypeVariant = 5 fromEnum AttrTypeStretch = 6 fromEnum AttrTypeSize = 7 fromEnum AttrTypeFontDesc = 8 fromEnum AttrTypeForeground = 9 fromEnum AttrTypeBackground = 10 fromEnum AttrTypeUnderline = 11 fromEnum AttrTypeStrikethrough = 12 fromEnum AttrTypeRise = 13 fromEnum AttrTypeShape = 14 fromEnum AttrTypeScale = 15 fromEnum AttrTypeFallback = 16 fromEnum AttrTypeLetterSpacing = 17 fromEnum AttrTypeUnderlineColor = 18 fromEnum AttrTypeStrikethroughColor = 19 fromEnum AttrTypeAbsoluteSize = 20 fromEnum AttrTypeGravity = 21 fromEnum AttrTypeGravityHint = 22 fromEnum (AnotherAttrType k) = k toEnum 0 = AttrTypeInvalid toEnum 1 = AttrTypeLanguage toEnum 2 = AttrTypeFamily toEnum 3 = AttrTypeStyle toEnum 4 = AttrTypeWeight toEnum 5 = AttrTypeVariant toEnum 6 = AttrTypeStretch toEnum 7 = AttrTypeSize toEnum 8 = AttrTypeFontDesc toEnum 9 = AttrTypeForeground toEnum 10 = AttrTypeBackground toEnum 11 = AttrTypeUnderline toEnum 12 = AttrTypeStrikethrough toEnum 13 = AttrTypeRise toEnum 14 = AttrTypeShape toEnum 15 = AttrTypeScale toEnum 16 = AttrTypeFallback toEnum 17 = AttrTypeLetterSpacing toEnum 18 = AttrTypeUnderlineColor toEnum 19 = AttrTypeStrikethroughColor toEnum 20 = AttrTypeAbsoluteSize toEnum 21 = AttrTypeGravity toEnum 22 = AttrTypeGravityHint toEnum k = AnotherAttrType k foreign import ccall "pango_attr_type_get_type" c_pango_attr_type_get_type :: IO GType instance BoxedEnum AttrType where boxedEnumType _ = c_pango_attr_type_get_type -- struct Attribute newtype Attribute = Attribute (ForeignPtr Attribute) noAttribute :: Maybe Attribute noAttribute = Nothing attributeReadKlass :: Attribute -> IO AttrClass attributeReadKlass s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr AttrClass) val' <- (newPtr 32 AttrClass) val return val' attributeReadStartIndex :: Attribute -> IO Word32 attributeReadStartIndex s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val attributeReadEndIndex :: Attribute -> IO Word32 attributeReadEndIndex s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Word32 return val -- method Attribute::destroy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attribute_destroy" pango_attribute_destroy :: Ptr Attribute -> -- _obj : TInterface "Pango" "Attribute" IO () attributeDestroy :: (MonadIO m) => Attribute -> -- _obj m () attributeDestroy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_attribute_destroy _obj' touchManagedPtr _obj return () -- method Attribute::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr2", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr2", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_attribute_equal" pango_attribute_equal :: Ptr Attribute -> -- _obj : TInterface "Pango" "Attribute" Ptr Attribute -> -- attr2 : TInterface "Pango" "Attribute" IO CInt attributeEqual :: (MonadIO m) => Attribute -> -- _obj Attribute -> -- attr2 m Bool attributeEqual _obj attr2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let attr2' = unsafeManagedPtrGetPtr attr2 result <- pango_attribute_equal _obj' attr2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr attr2 return result' -- method Attribute::init -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "klass", argType = TInterface "Pango" "AttrClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Attribute", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "klass", argType = TInterface "Pango" "AttrClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_attribute_init" pango_attribute_init :: Ptr Attribute -> -- _obj : TInterface "Pango" "Attribute" Ptr AttrClass -> -- klass : TInterface "Pango" "AttrClass" IO () attributeInit :: (MonadIO m) => Attribute -> -- _obj AttrClass -> -- klass m () attributeInit _obj klass = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let klass' = unsafeManagedPtrGetPtr klass pango_attribute_init _obj' klass' touchManagedPtr _obj touchManagedPtr klass return () -- Enum BidiType data BidiType = BidiTypeL | BidiTypeLre | BidiTypeLro | BidiTypeR | BidiTypeAl | BidiTypeRle | BidiTypeRlo | BidiTypePdf | BidiTypeEn | BidiTypeEs | BidiTypeEt | BidiTypeAn | BidiTypeCs | BidiTypeNsm | BidiTypeBn | BidiTypeB | BidiTypeS | BidiTypeWs | BidiTypeOn | AnotherBidiType Int deriving (Show, Eq) instance Enum BidiType where fromEnum BidiTypeL = 0 fromEnum BidiTypeLre = 1 fromEnum BidiTypeLro = 2 fromEnum BidiTypeR = 3 fromEnum BidiTypeAl = 4 fromEnum BidiTypeRle = 5 fromEnum BidiTypeRlo = 6 fromEnum BidiTypePdf = 7 fromEnum BidiTypeEn = 8 fromEnum BidiTypeEs = 9 fromEnum BidiTypeEt = 10 fromEnum BidiTypeAn = 11 fromEnum BidiTypeCs = 12 fromEnum BidiTypeNsm = 13 fromEnum BidiTypeBn = 14 fromEnum BidiTypeB = 15 fromEnum BidiTypeS = 16 fromEnum BidiTypeWs = 17 fromEnum BidiTypeOn = 18 fromEnum (AnotherBidiType k) = k toEnum 0 = BidiTypeL toEnum 1 = BidiTypeLre toEnum 2 = BidiTypeLro toEnum 3 = BidiTypeR toEnum 4 = BidiTypeAl toEnum 5 = BidiTypeRle toEnum 6 = BidiTypeRlo toEnum 7 = BidiTypePdf toEnum 8 = BidiTypeEn toEnum 9 = BidiTypeEs toEnum 10 = BidiTypeEt toEnum 11 = BidiTypeAn toEnum 12 = BidiTypeCs toEnum 13 = BidiTypeNsm toEnum 14 = BidiTypeBn toEnum 15 = BidiTypeB toEnum 16 = BidiTypeS toEnum 17 = BidiTypeWs toEnum 18 = BidiTypeOn toEnum k = AnotherBidiType k foreign import ccall "pango_bidi_type_get_type" c_pango_bidi_type_get_type :: IO GType instance BoxedEnum BidiType where boxedEnumType _ = c_pango_bidi_type_get_type -- struct Color newtype Color = Color (ForeignPtr Color) noColor :: Maybe Color noColor = Nothing foreign import ccall "pango_color_get_type" c_pango_color_get_type :: IO GType instance BoxedObject Color where boxedType _ = c_pango_color_get_type colorReadRed :: Color -> IO Word16 colorReadRed s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word16 return val colorReadGreen :: Color -> IO Word16 colorReadGreen s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 2) :: IO Word16 return val colorReadBlue :: Color -> IO Word16 colorReadBlue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word16 return val -- method Color::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Color" -- throws : False -- Skip return : False foreign import ccall "pango_color_copy" pango_color_copy :: Ptr Color -> -- _obj : TInterface "Pango" "Color" IO (Ptr Color) colorCopy :: (MonadIO m) => Color -> -- _obj m Color colorCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_color_copy _obj' checkUnexpectedReturnNULL "pango_color_copy" result result' <- (wrapBoxed Color) result touchManagedPtr _obj return result' -- method Color::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_color_free" pango_color_free :: Ptr Color -> -- _obj : TInterface "Pango" "Color" IO () colorFree :: (MonadIO m) => Color -> -- _obj m () colorFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_color_free _obj' touchManagedPtr _obj return () -- method Color::parse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_color_parse" pango_color_parse :: Ptr Color -> -- _obj : TInterface "Pango" "Color" CString -> -- spec : TBasicType TUTF8 IO CInt colorParse :: (MonadIO m) => Color -> -- _obj T.Text -> -- spec m Bool colorParse _obj spec = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj spec' <- textToCString spec result <- pango_color_parse _obj' spec' let result' = (/= 0) result touchManagedPtr _obj freeMem spec' return result' -- method Color::to_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_color_to_string" pango_color_to_string :: Ptr Color -> -- _obj : TInterface "Pango" "Color" IO CString colorToString :: (MonadIO m) => Color -> -- _obj m T.Text colorToString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_color_to_string _obj' checkUnexpectedReturnNULL "pango_color_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- object Context newtype Context = Context (ForeignPtr Context) noContext :: Maybe Context noContext = Nothing foreign import ccall "pango_context_get_type" c_pango_context_get_type :: IO GType type instance ParentTypes Context = '[GObject.Object] instance GObject Context where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_context_get_type class GObject o => ContextK o instance (GObject o, IsDescendantOf Context o) => ContextK o toContext :: ContextK o => o -> IO Context toContext = unsafeCastTo Context -- method Context::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Pango" "Context" -- throws : False -- Skip return : False foreign import ccall "pango_context_new" pango_context_new :: IO (Ptr Context) contextNew :: (MonadIO m) => m Context contextNew = liftIO $ do result <- pango_context_new checkUnexpectedReturnNULL "pango_context_new" result result' <- (wrapObject Context) result return result' -- method Context::changed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_changed" pango_context_changed :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO () contextChanged :: (MonadIO m, ContextK a) => a -> -- _obj m () contextChanged _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_context_changed _obj' touchManagedPtr _obj return () -- method Context::get_base_dir -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Direction" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_base_dir" pango_context_get_base_dir :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO CUInt contextGetBaseDir :: (MonadIO m, ContextK a) => a -> -- _obj m Direction contextGetBaseDir _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_base_dir _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Context::get_base_gravity -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Gravity" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_base_gravity" pango_context_get_base_gravity :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO CUInt contextGetBaseGravity :: (MonadIO m, ContextK a) => a -> -- _obj m Gravity contextGetBaseGravity _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_base_gravity _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Context::get_font_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_font_description" pango_context_get_font_description :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO (Ptr FontDescription) contextGetFontDescription :: (MonadIO m, ContextK a) => a -> -- _obj m FontDescription contextGetFontDescription _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_font_description _obj' checkUnexpectedReturnNULL "pango_context_get_font_description" result result' <- (newBoxed FontDescription) result touchManagedPtr _obj return result' -- method Context::get_font_map -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontMap" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_font_map" pango_context_get_font_map :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO (Ptr FontMap) contextGetFontMap :: (MonadIO m, ContextK a) => a -> -- _obj m FontMap contextGetFontMap _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_font_map _obj' checkUnexpectedReturnNULL "pango_context_get_font_map" result result' <- (newObject FontMap) result touchManagedPtr _obj return result' -- method Context::get_gravity -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Gravity" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_gravity" pango_context_get_gravity :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO CUInt contextGetGravity :: (MonadIO m, ContextK a) => a -> -- _obj m Gravity contextGetGravity _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_gravity _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Context::get_gravity_hint -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "GravityHint" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_gravity_hint" pango_context_get_gravity_hint :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO CUInt contextGetGravityHint :: (MonadIO m, ContextK a) => a -> -- _obj m GravityHint contextGetGravityHint _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_gravity_hint _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Context::get_language -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Language" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_language" pango_context_get_language :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO (Ptr Language) contextGetLanguage :: (MonadIO m, ContextK a) => a -> -- _obj m Language contextGetLanguage _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_language _obj' checkUnexpectedReturnNULL "pango_context_get_language" result result' <- (wrapBoxed Language) result touchManagedPtr _obj return result' -- method Context::get_matrix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Matrix" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_matrix" pango_context_get_matrix :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO (Ptr Matrix) contextGetMatrix :: (MonadIO m, ContextK a) => a -> -- _obj m Matrix contextGetMatrix _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_matrix _obj' checkUnexpectedReturnNULL "pango_context_get_matrix" result result' <- (newBoxed Matrix) result touchManagedPtr _obj return result' -- method Context::get_metrics -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontMetrics" -- throws : False -- Skip return : False foreign import ccall "pango_context_get_metrics" pango_context_get_metrics :: Ptr Context -> -- _obj : TInterface "Pango" "Context" Ptr FontDescription -> -- desc : TInterface "Pango" "FontDescription" Ptr Language -> -- language : TInterface "Pango" "Language" IO (Ptr FontMetrics) contextGetMetrics :: (MonadIO m, ContextK a) => a -> -- _obj Maybe (FontDescription) -> -- desc Maybe (Language) -> -- language m FontMetrics contextGetMetrics _obj desc language = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeDesc <- case desc of Nothing -> return nullPtr Just jDesc -> do let jDesc' = unsafeManagedPtrGetPtr jDesc return jDesc' maybeLanguage <- case language of Nothing -> return nullPtr Just jLanguage -> do let jLanguage' = unsafeManagedPtrGetPtr jLanguage return jLanguage' result <- pango_context_get_metrics _obj' maybeDesc maybeLanguage checkUnexpectedReturnNULL "pango_context_get_metrics" result result' <- (wrapBoxed FontMetrics) result touchManagedPtr _obj whenJust desc touchManagedPtr whenJust language touchManagedPtr return result' -- method Context::get_serial -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "pango_context_get_serial" pango_context_get_serial :: Ptr Context -> -- _obj : TInterface "Pango" "Context" IO Word32 contextGetSerial :: (MonadIO m, ContextK a) => a -> -- _obj m Word32 contextGetSerial _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_context_get_serial _obj' touchManagedPtr _obj return result -- method Context::list_families -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "families", argType = TCArray False (-1) 2 (TInterface "Pango" "FontFamily"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferContainer},Arg {argName = "n_families", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_families", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_list_families" pango_context_list_families :: Ptr Context -> -- _obj : TInterface "Pango" "Context" Ptr (Ptr (Ptr FontFamily)) -> -- families : TCArray False (-1) 2 (TInterface "Pango" "FontFamily") Ptr Int32 -> -- n_families : TBasicType TInt32 IO () contextListFamilies :: (MonadIO m, ContextK a) => a -> -- _obj m ([FontFamily]) contextListFamilies _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj families <- allocMem :: IO (Ptr (Ptr (Ptr FontFamily))) n_families <- allocMem :: IO (Ptr Int32) pango_context_list_families _obj' families n_families n_families' <- peek n_families families' <- peek families families'' <- (unpackPtrArrayWithLength n_families') families' families''' <- mapM (newObject FontFamily) families'' freeMem families' touchManagedPtr _obj freeMem families freeMem n_families return families''' -- method Context::load_font -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Font" -- throws : False -- Skip return : False foreign import ccall "pango_context_load_font" pango_context_load_font :: Ptr Context -> -- _obj : TInterface "Pango" "Context" Ptr FontDescription -> -- desc : TInterface "Pango" "FontDescription" IO (Ptr Font) contextLoadFont :: (MonadIO m, ContextK a) => a -> -- _obj FontDescription -> -- desc m Font contextLoadFont _obj desc = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let desc' = unsafeManagedPtrGetPtr desc result <- pango_context_load_font _obj' desc' checkUnexpectedReturnNULL "pango_context_load_font" result result' <- (wrapObject Font) result touchManagedPtr _obj touchManagedPtr desc return result' -- method Context::load_fontset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Fontset" -- throws : False -- Skip return : False foreign import ccall "pango_context_load_fontset" pango_context_load_fontset :: Ptr Context -> -- _obj : TInterface "Pango" "Context" Ptr FontDescription -> -- desc : TInterface "Pango" "FontDescription" Ptr Language -> -- language : TInterface "Pango" "Language" IO (Ptr Fontset) contextLoadFontset :: (MonadIO m, ContextK a) => a -> -- _obj FontDescription -> -- desc Language -> -- language m Fontset contextLoadFontset _obj desc language = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let desc' = unsafeManagedPtrGetPtr desc let language' = unsafeManagedPtrGetPtr language result <- pango_context_load_fontset _obj' desc' language' checkUnexpectedReturnNULL "pango_context_load_fontset" result result' <- (wrapObject Fontset) result touchManagedPtr _obj touchManagedPtr desc touchManagedPtr language return result' -- method Context::set_base_dir -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "direction", argType = TInterface "Pango" "Direction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "direction", argType = TInterface "Pango" "Direction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_set_base_dir" pango_context_set_base_dir :: Ptr Context -> -- _obj : TInterface "Pango" "Context" CUInt -> -- direction : TInterface "Pango" "Direction" IO () contextSetBaseDir :: (MonadIO m, ContextK a) => a -> -- _obj Direction -> -- direction m () contextSetBaseDir _obj direction = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let direction' = (fromIntegral . fromEnum) direction pango_context_set_base_dir _obj' direction' touchManagedPtr _obj return () -- method Context::set_base_gravity -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_set_base_gravity" pango_context_set_base_gravity :: Ptr Context -> -- _obj : TInterface "Pango" "Context" CUInt -> -- gravity : TInterface "Pango" "Gravity" IO () contextSetBaseGravity :: (MonadIO m, ContextK a) => a -> -- _obj Gravity -> -- gravity m () contextSetBaseGravity _obj gravity = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let gravity' = (fromIntegral . fromEnum) gravity pango_context_set_base_gravity _obj' gravity' touchManagedPtr _obj return () -- method Context::set_font_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_set_font_description" pango_context_set_font_description :: Ptr Context -> -- _obj : TInterface "Pango" "Context" Ptr FontDescription -> -- desc : TInterface "Pango" "FontDescription" IO () contextSetFontDescription :: (MonadIO m, ContextK a) => a -> -- _obj FontDescription -> -- desc m () contextSetFontDescription _obj desc = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let desc' = unsafeManagedPtrGetPtr desc pango_context_set_font_description _obj' desc' touchManagedPtr _obj touchManagedPtr desc return () -- method Context::set_font_map -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font_map", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font_map", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_set_font_map" pango_context_set_font_map :: Ptr Context -> -- _obj : TInterface "Pango" "Context" Ptr FontMap -> -- font_map : TInterface "Pango" "FontMap" IO () contextSetFontMap :: (MonadIO m, ContextK a, FontMapK b) => a -> -- _obj b -> -- font_map m () contextSetFontMap _obj font_map = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let font_map' = unsafeManagedPtrCastPtr font_map pango_context_set_font_map _obj' font_map' touchManagedPtr _obj touchManagedPtr font_map return () -- method Context::set_gravity_hint -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TInterface "Pango" "GravityHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TInterface "Pango" "GravityHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_set_gravity_hint" pango_context_set_gravity_hint :: Ptr Context -> -- _obj : TInterface "Pango" "Context" CUInt -> -- hint : TInterface "Pango" "GravityHint" IO () contextSetGravityHint :: (MonadIO m, ContextK a) => a -> -- _obj GravityHint -> -- hint m () contextSetGravityHint _obj hint = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let hint' = (fromIntegral . fromEnum) hint pango_context_set_gravity_hint _obj' hint' touchManagedPtr _obj return () -- method Context::set_language -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_set_language" pango_context_set_language :: Ptr Context -> -- _obj : TInterface "Pango" "Context" Ptr Language -> -- language : TInterface "Pango" "Language" IO () contextSetLanguage :: (MonadIO m, ContextK a) => a -> -- _obj Language -> -- language m () contextSetLanguage _obj language = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let language' = unsafeManagedPtrGetPtr language pango_context_set_language _obj' language' touchManagedPtr _obj touchManagedPtr language return () -- method Context::set_matrix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "matrix", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "matrix", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_context_set_matrix" pango_context_set_matrix :: Ptr Context -> -- _obj : TInterface "Pango" "Context" Ptr Matrix -> -- matrix : TInterface "Pango" "Matrix" IO () contextSetMatrix :: (MonadIO m, ContextK a) => a -> -- _obj Maybe (Matrix) -> -- matrix m () contextSetMatrix _obj matrix = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeMatrix <- case matrix of Nothing -> return nullPtr Just jMatrix -> do let jMatrix' = unsafeManagedPtrGetPtr jMatrix return jMatrix' pango_context_set_matrix _obj' maybeMatrix touchManagedPtr _obj whenJust matrix touchManagedPtr return () -- struct Coverage newtype Coverage = Coverage (ForeignPtr Coverage) noCoverage :: Maybe Coverage noCoverage = Nothing -- method Coverage::get -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "CoverageLevel" -- throws : False -- Skip return : False foreign import ccall "pango_coverage_get" pango_coverage_get :: Ptr Coverage -> -- _obj : TInterface "Pango" "Coverage" Int32 -> -- index_ : TBasicType TInt32 IO CUInt coverageGet :: (MonadIO m) => Coverage -> -- _obj Int32 -> -- index_ m CoverageLevel coverageGet _obj index_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_coverage_get _obj' index_ let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Coverage::max -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "other", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_coverage_max" pango_coverage_max :: Ptr Coverage -> -- _obj : TInterface "Pango" "Coverage" Ptr Coverage -> -- other : TInterface "Pango" "Coverage" IO () coverageMax :: (MonadIO m) => Coverage -> -- _obj Coverage -> -- other m () coverageMax _obj other = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let other' = unsafeManagedPtrGetPtr other pango_coverage_max _obj' other' touchManagedPtr _obj touchManagedPtr other return () -- method Coverage::set -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TInterface "Pango" "CoverageLevel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TInterface "Pango" "CoverageLevel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_coverage_set" pango_coverage_set :: Ptr Coverage -> -- _obj : TInterface "Pango" "Coverage" Int32 -> -- index_ : TBasicType TInt32 CUInt -> -- level : TInterface "Pango" "CoverageLevel" IO () coverageSet :: (MonadIO m) => Coverage -> -- _obj Int32 -> -- index_ CoverageLevel -> -- level m () coverageSet _obj index_ level = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let level' = (fromIntegral . fromEnum) level pango_coverage_set _obj' index_ level' touchManagedPtr _obj return () -- method Coverage::to_bytes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bytes", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "n_bytes", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_bytes", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_coverage_to_bytes" pango_coverage_to_bytes :: Ptr Coverage -> -- _obj : TInterface "Pango" "Coverage" Ptr (Ptr Word8) -> -- bytes : TCArray False (-1) 2 (TBasicType TUInt8) Ptr Int32 -> -- n_bytes : TBasicType TInt32 IO () coverageToBytes :: (MonadIO m) => Coverage -> -- _obj m (ByteString) coverageToBytes _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj bytes <- allocMem :: IO (Ptr (Ptr Word8)) n_bytes <- allocMem :: IO (Ptr Int32) pango_coverage_to_bytes _obj' bytes n_bytes n_bytes' <- peek n_bytes bytes' <- peek bytes bytes'' <- (unpackByteStringWithLength n_bytes') bytes' freeMem bytes' touchManagedPtr _obj freeMem bytes freeMem n_bytes return bytes'' -- method Coverage::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Coverage", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_coverage_unref" pango_coverage_unref :: Ptr Coverage -> -- _obj : TInterface "Pango" "Coverage" IO () coverageUnref :: (MonadIO m) => Coverage -> -- _obj m () coverageUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_coverage_unref _obj' touchManagedPtr _obj return () -- Enum CoverageLevel data CoverageLevel = CoverageLevelNone | CoverageLevelFallback | CoverageLevelApproximate | CoverageLevelExact | AnotherCoverageLevel Int deriving (Show, Eq) instance Enum CoverageLevel where fromEnum CoverageLevelNone = 0 fromEnum CoverageLevelFallback = 1 fromEnum CoverageLevelApproximate = 2 fromEnum CoverageLevelExact = 3 fromEnum (AnotherCoverageLevel k) = k toEnum 0 = CoverageLevelNone toEnum 1 = CoverageLevelFallback toEnum 2 = CoverageLevelApproximate toEnum 3 = CoverageLevelExact toEnum k = AnotherCoverageLevel k foreign import ccall "pango_coverage_level_get_type" c_pango_coverage_level_get_type :: IO GType instance BoxedEnum CoverageLevel where boxedEnumType _ = c_pango_coverage_level_get_type -- Enum Direction data Direction = DirectionLtr | DirectionRtl | DirectionTtbLtr | DirectionTtbRtl | DirectionWeakLtr | DirectionWeakRtl | DirectionNeutral | AnotherDirection Int deriving (Show, Eq) instance Enum Direction where fromEnum DirectionLtr = 0 fromEnum DirectionRtl = 1 fromEnum DirectionTtbLtr = 2 fromEnum DirectionTtbRtl = 3 fromEnum DirectionWeakLtr = 4 fromEnum DirectionWeakRtl = 5 fromEnum DirectionNeutral = 6 fromEnum (AnotherDirection k) = k toEnum 0 = DirectionLtr toEnum 1 = DirectionRtl toEnum 2 = DirectionTtbLtr toEnum 3 = DirectionTtbRtl toEnum 4 = DirectionWeakLtr toEnum 5 = DirectionWeakRtl toEnum 6 = DirectionNeutral toEnum k = AnotherDirection k foreign import ccall "pango_direction_get_type" c_pango_direction_get_type :: IO GType instance BoxedEnum Direction where boxedEnumType _ = c_pango_direction_get_type -- Enum EllipsizeMode data EllipsizeMode = EllipsizeModeNone | EllipsizeModeStart | EllipsizeModeMiddle | EllipsizeModeEnd | AnotherEllipsizeMode Int deriving (Show, Eq) instance Enum EllipsizeMode where fromEnum EllipsizeModeNone = 0 fromEnum EllipsizeModeStart = 1 fromEnum EllipsizeModeMiddle = 2 fromEnum EllipsizeModeEnd = 3 fromEnum (AnotherEllipsizeMode k) = k toEnum 0 = EllipsizeModeNone toEnum 1 = EllipsizeModeStart toEnum 2 = EllipsizeModeMiddle toEnum 3 = EllipsizeModeEnd toEnum k = AnotherEllipsizeMode k foreign import ccall "pango_ellipsize_mode_get_type" c_pango_ellipsize_mode_get_type :: IO GType instance BoxedEnum EllipsizeMode where boxedEnumType _ = c_pango_ellipsize_mode_get_type -- object Engine newtype Engine = Engine (ForeignPtr Engine) noEngine :: Maybe Engine noEngine = Nothing foreign import ccall "pango_engine_get_type" c_pango_engine_get_type :: IO GType type instance ParentTypes Engine = '[GObject.Object] instance GObject Engine where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_engine_get_type class GObject o => EngineK o instance (GObject o, IsDescendantOf Engine o) => EngineK o toEngine :: EngineK o => o -> IO Engine toEngine = unsafeCastTo Engine -- struct EngineInfo newtype EngineInfo = EngineInfo (ForeignPtr EngineInfo) noEngineInfo :: Maybe EngineInfo noEngineInfo = Nothing engineInfoReadId :: EngineInfo -> IO T.Text engineInfoReadId s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' engineInfoReadEngineType :: EngineInfo -> IO T.Text engineInfoReadEngineType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' engineInfoReadRenderType :: EngineInfo -> IO T.Text engineInfoReadRenderType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' engineInfoReadScripts :: EngineInfo -> IO EngineScriptInfo engineInfoReadScripts s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr EngineScriptInfo) val' <- (newPtr 16 EngineScriptInfo) val return val' engineInfoReadNScripts :: EngineInfo -> IO Int32 engineInfoReadNScripts s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO Int32 return val -- object EngineLang newtype EngineLang = EngineLang (ForeignPtr EngineLang) noEngineLang :: Maybe EngineLang noEngineLang = Nothing foreign import ccall "pango_engine_lang_get_type" c_pango_engine_lang_get_type :: IO GType type instance ParentTypes EngineLang = '[Engine, GObject.Object] instance GObject EngineLang where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_engine_lang_get_type class GObject o => EngineLangK o instance (GObject o, IsDescendantOf EngineLang o) => EngineLangK o toEngineLang :: EngineLangK o => o -> IO EngineLang toEngineLang = unsafeCastTo EngineLang -- struct EngineScriptInfo newtype EngineScriptInfo = EngineScriptInfo (ForeignPtr EngineScriptInfo) noEngineScriptInfo :: Maybe EngineScriptInfo noEngineScriptInfo = Nothing engineScriptInfoReadScript :: EngineScriptInfo -> IO Script engineScriptInfoReadScript s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' engineScriptInfoReadLangs :: EngineScriptInfo -> IO T.Text engineScriptInfoReadLangs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' -- object EngineShape newtype EngineShape = EngineShape (ForeignPtr EngineShape) noEngineShape :: Maybe EngineShape noEngineShape = Nothing foreign import ccall "pango_engine_shape_get_type" c_pango_engine_shape_get_type :: IO GType type instance ParentTypes EngineShape = '[Engine, GObject.Object] instance GObject EngineShape where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_engine_shape_get_type class GObject o => EngineShapeK o instance (GObject o, IsDescendantOf EngineShape o) => EngineShapeK o toEngineShape :: EngineShapeK o => o -> IO EngineShape toEngineShape = unsafeCastTo EngineShape -- object Font newtype Font = Font (ForeignPtr Font) noFont :: Maybe Font noFont = Nothing foreign import ccall "pango_font_get_type" c_pango_font_get_type :: IO GType type instance ParentTypes Font = '[GObject.Object] instance GObject Font where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_font_get_type class GObject o => FontK o instance (GObject o, IsDescendantOf Font o) => FontK o toFont :: FontK o => o -> IO Font toFont = unsafeCastTo Font -- method Font::describe -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_font_describe" pango_font_describe :: Ptr Font -> -- _obj : TInterface "Pango" "Font" IO (Ptr FontDescription) fontDescribe :: (MonadIO m, FontK a) => a -> -- _obj m FontDescription fontDescribe _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_describe _obj' checkUnexpectedReturnNULL "pango_font_describe" result result' <- (wrapBoxed FontDescription) result touchManagedPtr _obj return result' -- method Font::describe_with_absolute_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_font_describe_with_absolute_size" pango_font_describe_with_absolute_size :: Ptr Font -> -- _obj : TInterface "Pango" "Font" IO (Ptr FontDescription) fontDescribeWithAbsoluteSize :: (MonadIO m, FontK a) => a -> -- _obj m FontDescription fontDescribeWithAbsoluteSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_describe_with_absolute_size _obj' checkUnexpectedReturnNULL "pango_font_describe_with_absolute_size" result result' <- (wrapBoxed FontDescription) result touchManagedPtr _obj return result' -- method Font::get_font_map -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontMap" -- throws : False -- Skip return : False foreign import ccall "pango_font_get_font_map" pango_font_get_font_map :: Ptr Font -> -- _obj : TInterface "Pango" "Font" IO (Ptr FontMap) fontGetFontMap :: (MonadIO m, FontK a) => a -> -- _obj m FontMap fontGetFontMap _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_get_font_map _obj' checkUnexpectedReturnNULL "pango_font_get_font_map" result result' <- (newObject FontMap) result touchManagedPtr _obj return result' -- method Font::get_glyph_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_get_glyph_extents" pango_font_get_glyph_extents :: Ptr Font -> -- _obj : TInterface "Pango" "Font" Word32 -> -- glyph : TBasicType TUInt32 Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () fontGetGlyphExtents :: (MonadIO m, FontK a) => a -> -- _obj Word32 -> -- glyph m (Rectangle,Rectangle) fontGetGlyphExtents _obj glyph = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_font_get_glyph_extents _obj' glyph ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method Font::get_metrics -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontMetrics" -- throws : False -- Skip return : False foreign import ccall "pango_font_get_metrics" pango_font_get_metrics :: Ptr Font -> -- _obj : TInterface "Pango" "Font" Ptr Language -> -- language : TInterface "Pango" "Language" IO (Ptr FontMetrics) fontGetMetrics :: (MonadIO m, FontK a) => a -> -- _obj Maybe (Language) -> -- language m FontMetrics fontGetMetrics _obj language = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeLanguage <- case language of Nothing -> return nullPtr Just jLanguage -> do let jLanguage' = unsafeManagedPtrGetPtr jLanguage return jLanguage' result <- pango_font_get_metrics _obj' maybeLanguage checkUnexpectedReturnNULL "pango_font_get_metrics" result result' <- (wrapBoxed FontMetrics) result touchManagedPtr _obj whenJust language touchManagedPtr return result' -- method Font::descriptions_free -- method type : MemberFunction -- Args : [Arg {argName = "descs", argType = TCArray False (-1) 1 (TInterface "Pango" "FontDescription"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "n_descs", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "n_descs", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "descs", argType = TCArray False (-1) 1 (TInterface "Pango" "FontDescription"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_descriptions_free" pango_font_descriptions_free :: Ptr (Ptr FontDescription) -> -- descs : TCArray False (-1) 1 (TInterface "Pango" "FontDescription") Int32 -> -- n_descs : TBasicType TInt32 IO () fontDescriptionsFree :: (MonadIO m) => Maybe ([FontDescription]) -> -- descs m () fontDescriptionsFree descs = liftIO $ do let n_descs = case descs of Nothing -> 0 Just jDescs -> fromIntegral $ length jDescs maybeDescs <- case descs of Nothing -> return nullPtr Just jDescs -> do jDescs' <- mapM copyBoxed jDescs jDescs'' <- packPtrArray jDescs' return jDescs'' pango_font_descriptions_free maybeDescs n_descs whenJust descs (mapM_ touchManagedPtr) return () -- struct FontDescription newtype FontDescription = FontDescription (ForeignPtr FontDescription) noFontDescription :: Maybe FontDescription noFontDescription = Nothing foreign import ccall "pango_font_description_get_type" c_pango_font_description_get_type :: IO GType instance BoxedObject FontDescription where boxedType _ = c_pango_font_description_get_type -- method FontDescription::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_new" pango_font_description_new :: IO (Ptr FontDescription) fontDescriptionNew :: (MonadIO m) => m FontDescription fontDescriptionNew = liftIO $ do result <- pango_font_description_new checkUnexpectedReturnNULL "pango_font_description_new" result result' <- (wrapBoxed FontDescription) result return result' -- method FontDescription::better_match -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_match", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_match", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_match", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_match", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_font_description_better_match" pango_font_description_better_match :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" Ptr FontDescription -> -- old_match : TInterface "Pango" "FontDescription" Ptr FontDescription -> -- new_match : TInterface "Pango" "FontDescription" IO CInt fontDescriptionBetterMatch :: (MonadIO m) => FontDescription -> -- _obj Maybe (FontDescription) -> -- old_match FontDescription -> -- new_match m Bool fontDescriptionBetterMatch _obj old_match new_match = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeOld_match <- case old_match of Nothing -> return nullPtr Just jOld_match -> do let jOld_match' = unsafeManagedPtrGetPtr jOld_match return jOld_match' let new_match' = unsafeManagedPtrGetPtr new_match result <- pango_font_description_better_match _obj' maybeOld_match new_match' let result' = (/= 0) result touchManagedPtr _obj whenJust old_match touchManagedPtr touchManagedPtr new_match return result' -- method FontDescription::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_copy" pango_font_description_copy :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO (Ptr FontDescription) fontDescriptionCopy :: (MonadIO m) => FontDescription -> -- _obj m FontDescription fontDescriptionCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_copy _obj' checkUnexpectedReturnNULL "pango_font_description_copy" result result' <- (wrapBoxed FontDescription) result touchManagedPtr _obj return result' -- method FontDescription::copy_static -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_copy_static" pango_font_description_copy_static :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO (Ptr FontDescription) fontDescriptionCopyStatic :: (MonadIO m) => FontDescription -> -- _obj m FontDescription fontDescriptionCopyStatic _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_copy_static _obj' checkUnexpectedReturnNULL "pango_font_description_copy_static" result result' <- (wrapBoxed FontDescription) result touchManagedPtr _obj return result' -- method FontDescription::equal -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc2", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc2", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_font_description_equal" pango_font_description_equal :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" Ptr FontDescription -> -- desc2 : TInterface "Pango" "FontDescription" IO CInt fontDescriptionEqual :: (MonadIO m) => FontDescription -> -- _obj FontDescription -> -- desc2 m Bool fontDescriptionEqual _obj desc2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let desc2' = unsafeManagedPtrGetPtr desc2 result <- pango_font_description_equal _obj' desc2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr desc2 return result' -- method FontDescription::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_free" pango_font_description_free :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO () fontDescriptionFree :: (MonadIO m) => FontDescription -> -- _obj m () fontDescriptionFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_font_description_free _obj' touchManagedPtr _obj return () -- method FontDescription::get_family -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_family" pango_font_description_get_family :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CString fontDescriptionGetFamily :: (MonadIO m) => FontDescription -> -- _obj m T.Text fontDescriptionGetFamily _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_family _obj' checkUnexpectedReturnNULL "pango_font_description_get_family" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FontDescription::get_gravity -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Gravity" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_gravity" pango_font_description_get_gravity :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CUInt fontDescriptionGetGravity :: (MonadIO m) => FontDescription -> -- _obj m Gravity fontDescriptionGetGravity _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_gravity _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method FontDescription::get_set_fields -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontMask" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_set_fields" pango_font_description_get_set_fields :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CUInt fontDescriptionGetSetFields :: (MonadIO m) => FontDescription -> -- _obj m [FontMask] fontDescriptionGetSetFields _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_set_fields _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method FontDescription::get_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_size" pango_font_description_get_size :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO Int32 fontDescriptionGetSize :: (MonadIO m) => FontDescription -> -- _obj m Int32 fontDescriptionGetSize _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_size _obj' touchManagedPtr _obj return result -- method FontDescription::get_size_is_absolute -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_size_is_absolute" pango_font_description_get_size_is_absolute :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CInt fontDescriptionGetSizeIsAbsolute :: (MonadIO m) => FontDescription -> -- _obj m Bool fontDescriptionGetSizeIsAbsolute _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_size_is_absolute _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FontDescription::get_stretch -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Stretch" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_stretch" pango_font_description_get_stretch :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CUInt fontDescriptionGetStretch :: (MonadIO m) => FontDescription -> -- _obj m Stretch fontDescriptionGetStretch _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_stretch _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method FontDescription::get_style -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Style" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_style" pango_font_description_get_style :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CUInt fontDescriptionGetStyle :: (MonadIO m) => FontDescription -> -- _obj m Style fontDescriptionGetStyle _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_style _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method FontDescription::get_variant -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Variant" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_variant" pango_font_description_get_variant :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CUInt fontDescriptionGetVariant :: (MonadIO m) => FontDescription -> -- _obj m Variant fontDescriptionGetVariant _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_variant _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method FontDescription::get_weight -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Weight" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_get_weight" pango_font_description_get_weight :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CUInt fontDescriptionGetWeight :: (MonadIO m) => FontDescription -> -- _obj m Weight fontDescriptionGetWeight _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_get_weight _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method FontDescription::hash -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_description_hash" pango_font_description_hash :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO Word32 fontDescriptionHash :: (MonadIO m) => FontDescription -> -- _obj m Word32 fontDescriptionHash _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_hash _obj' touchManagedPtr _obj return result -- method FontDescription::merge -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc_to_merge", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replace_existing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc_to_merge", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replace_existing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_merge" pango_font_description_merge :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" Ptr FontDescription -> -- desc_to_merge : TInterface "Pango" "FontDescription" CInt -> -- replace_existing : TBasicType TBoolean IO () fontDescriptionMerge :: (MonadIO m) => FontDescription -> -- _obj Maybe (FontDescription) -> -- desc_to_merge Bool -> -- replace_existing m () fontDescriptionMerge _obj desc_to_merge replace_existing = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeDesc_to_merge <- case desc_to_merge of Nothing -> return nullPtr Just jDesc_to_merge -> do let jDesc_to_merge' = unsafeManagedPtrGetPtr jDesc_to_merge return jDesc_to_merge' let replace_existing' = (fromIntegral . fromEnum) replace_existing pango_font_description_merge _obj' maybeDesc_to_merge replace_existing' touchManagedPtr _obj whenJust desc_to_merge touchManagedPtr return () -- method FontDescription::merge_static -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc_to_merge", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replace_existing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc_to_merge", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replace_existing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_merge_static" pango_font_description_merge_static :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" Ptr FontDescription -> -- desc_to_merge : TInterface "Pango" "FontDescription" CInt -> -- replace_existing : TBasicType TBoolean IO () fontDescriptionMergeStatic :: (MonadIO m) => FontDescription -> -- _obj FontDescription -> -- desc_to_merge Bool -> -- replace_existing m () fontDescriptionMergeStatic _obj desc_to_merge replace_existing = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let desc_to_merge' = unsafeManagedPtrGetPtr desc_to_merge let replace_existing' = (fromIntegral . fromEnum) replace_existing pango_font_description_merge_static _obj' desc_to_merge' replace_existing' touchManagedPtr _obj touchManagedPtr desc_to_merge return () -- method FontDescription::set_absolute_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_absolute_size" pango_font_description_set_absolute_size :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CDouble -> -- size : TBasicType TDouble IO () fontDescriptionSetAbsoluteSize :: (MonadIO m) => FontDescription -> -- _obj Double -> -- size m () fontDescriptionSetAbsoluteSize _obj size = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let size' = realToFrac size pango_font_description_set_absolute_size _obj' size' touchManagedPtr _obj return () -- method FontDescription::set_family -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_family" pango_font_description_set_family :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CString -> -- family : TBasicType TUTF8 IO () fontDescriptionSetFamily :: (MonadIO m) => FontDescription -> -- _obj T.Text -> -- family m () fontDescriptionSetFamily _obj family = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj family' <- textToCString family pango_font_description_set_family _obj' family' touchManagedPtr _obj freeMem family' return () -- method FontDescription::set_family_static -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "family", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_family_static" pango_font_description_set_family_static :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CString -> -- family : TBasicType TUTF8 IO () fontDescriptionSetFamilyStatic :: (MonadIO m) => FontDescription -> -- _obj T.Text -> -- family m () fontDescriptionSetFamilyStatic _obj family = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj family' <- textToCString family pango_font_description_set_family_static _obj' family' touchManagedPtr _obj freeMem family' return () -- method FontDescription::set_gravity -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_gravity" pango_font_description_set_gravity :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CUInt -> -- gravity : TInterface "Pango" "Gravity" IO () fontDescriptionSetGravity :: (MonadIO m) => FontDescription -> -- _obj Gravity -> -- gravity m () fontDescriptionSetGravity _obj gravity = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let gravity' = (fromIntegral . fromEnum) gravity pango_font_description_set_gravity _obj' gravity' touchManagedPtr _obj return () -- method FontDescription::set_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_size" pango_font_description_set_size :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" Int32 -> -- size : TBasicType TInt32 IO () fontDescriptionSetSize :: (MonadIO m) => FontDescription -> -- _obj Int32 -> -- size m () fontDescriptionSetSize _obj size = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_font_description_set_size _obj' size touchManagedPtr _obj return () -- method FontDescription::set_stretch -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stretch", argType = TInterface "Pango" "Stretch", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stretch", argType = TInterface "Pango" "Stretch", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_stretch" pango_font_description_set_stretch :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CUInt -> -- stretch : TInterface "Pango" "Stretch" IO () fontDescriptionSetStretch :: (MonadIO m) => FontDescription -> -- _obj Stretch -> -- stretch m () fontDescriptionSetStretch _obj stretch = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let stretch' = (fromIntegral . fromEnum) stretch pango_font_description_set_stretch _obj' stretch' touchManagedPtr _obj return () -- method FontDescription::set_style -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "style", argType = TInterface "Pango" "Style", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "style", argType = TInterface "Pango" "Style", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_style" pango_font_description_set_style :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CUInt -> -- style : TInterface "Pango" "Style" IO () fontDescriptionSetStyle :: (MonadIO m) => FontDescription -> -- _obj Style -> -- style m () fontDescriptionSetStyle _obj style = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let style' = (fromIntegral . fromEnum) style pango_font_description_set_style _obj' style' touchManagedPtr _obj return () -- method FontDescription::set_variant -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "variant", argType = TInterface "Pango" "Variant", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "variant", argType = TInterface "Pango" "Variant", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_variant" pango_font_description_set_variant :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CUInt -> -- variant : TInterface "Pango" "Variant" IO () fontDescriptionSetVariant :: (MonadIO m) => FontDescription -> -- _obj Variant -> -- variant m () fontDescriptionSetVariant _obj variant = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let variant' = (fromIntegral . fromEnum) variant pango_font_description_set_variant _obj' variant' touchManagedPtr _obj return () -- method FontDescription::set_weight -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "weight", argType = TInterface "Pango" "Weight", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "weight", argType = TInterface "Pango" "Weight", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_set_weight" pango_font_description_set_weight :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CUInt -> -- weight : TInterface "Pango" "Weight" IO () fontDescriptionSetWeight :: (MonadIO m) => FontDescription -> -- _obj Weight -> -- weight m () fontDescriptionSetWeight _obj weight = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let weight' = (fromIntegral . fromEnum) weight pango_font_description_set_weight _obj' weight' touchManagedPtr _obj return () -- method FontDescription::to_filename -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_font_description_to_filename" pango_font_description_to_filename :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CString fontDescriptionToFilename :: (MonadIO m) => FontDescription -> -- _obj m T.Text fontDescriptionToFilename _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_to_filename _obj' checkUnexpectedReturnNULL "pango_font_description_to_filename" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FontDescription::to_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_font_description_to_string" pango_font_description_to_string :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" IO CString fontDescriptionToString :: (MonadIO m) => FontDescription -> -- _obj m T.Text fontDescriptionToString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_description_to_string _obj' checkUnexpectedReturnNULL "pango_font_description_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' -- method FontDescription::unset_fields -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "to_unset", argType = TInterface "Pango" "FontMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "to_unset", argType = TInterface "Pango" "FontMask", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_description_unset_fields" pango_font_description_unset_fields :: Ptr FontDescription -> -- _obj : TInterface "Pango" "FontDescription" CUInt -> -- to_unset : TInterface "Pango" "FontMask" IO () fontDescriptionUnsetFields :: (MonadIO m) => FontDescription -> -- _obj [FontMask] -> -- to_unset m () fontDescriptionUnsetFields _obj to_unset = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let to_unset' = gflagsToWord to_unset pango_font_description_unset_fields _obj' to_unset' touchManagedPtr _obj return () -- object FontFace newtype FontFace = FontFace (ForeignPtr FontFace) noFontFace :: Maybe FontFace noFontFace = Nothing foreign import ccall "pango_font_face_get_type" c_pango_font_face_get_type :: IO GType type instance ParentTypes FontFace = '[GObject.Object] instance GObject FontFace where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_font_face_get_type class GObject o => FontFaceK o instance (GObject o, IsDescendantOf FontFace o) => FontFaceK o toFontFace :: FontFaceK o => o -> IO FontFace toFontFace = unsafeCastTo FontFace -- method FontFace::describe -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFace", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFace", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_font_face_describe" pango_font_face_describe :: Ptr FontFace -> -- _obj : TInterface "Pango" "FontFace" IO (Ptr FontDescription) fontFaceDescribe :: (MonadIO m, FontFaceK a) => a -> -- _obj m FontDescription fontFaceDescribe _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_face_describe _obj' checkUnexpectedReturnNULL "pango_font_face_describe" result result' <- (wrapBoxed FontDescription) result touchManagedPtr _obj return result' -- method FontFace::get_face_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFace", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFace", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_font_face_get_face_name" pango_font_face_get_face_name :: Ptr FontFace -> -- _obj : TInterface "Pango" "FontFace" IO CString fontFaceGetFaceName :: (MonadIO m, FontFaceK a) => a -> -- _obj m T.Text fontFaceGetFaceName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_face_get_face_name _obj' checkUnexpectedReturnNULL "pango_font_face_get_face_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FontFace::is_synthesized -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFace", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFace", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_font_face_is_synthesized" pango_font_face_is_synthesized :: Ptr FontFace -> -- _obj : TInterface "Pango" "FontFace" IO CInt fontFaceIsSynthesized :: (MonadIO m, FontFaceK a) => a -> -- _obj m Bool fontFaceIsSynthesized _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_face_is_synthesized _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FontFace::list_sizes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFace", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sizes", argType = TCArray False (-1) 2 (TBasicType TInt32), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "n_sizes", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_sizes", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFace", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_face_list_sizes" pango_font_face_list_sizes :: Ptr FontFace -> -- _obj : TInterface "Pango" "FontFace" Ptr (Ptr Int32) -> -- sizes : TCArray False (-1) 2 (TBasicType TInt32) Ptr Int32 -> -- n_sizes : TBasicType TInt32 IO () fontFaceListSizes :: (MonadIO m, FontFaceK a) => a -> -- _obj m ([Int32]) fontFaceListSizes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj sizes <- allocMem :: IO (Ptr (Ptr Int32)) n_sizes <- allocMem :: IO (Ptr Int32) pango_font_face_list_sizes _obj' sizes n_sizes n_sizes' <- peek n_sizes sizes' <- peek sizes sizes'' <- (unpackStorableArrayWithLength n_sizes') sizes' freeMem sizes' touchManagedPtr _obj freeMem sizes freeMem n_sizes return sizes'' -- object FontFamily newtype FontFamily = FontFamily (ForeignPtr FontFamily) noFontFamily :: Maybe FontFamily noFontFamily = Nothing foreign import ccall "pango_font_family_get_type" c_pango_font_family_get_type :: IO GType type instance ParentTypes FontFamily = '[GObject.Object] instance GObject FontFamily where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_font_family_get_type class GObject o => FontFamilyK o instance (GObject o, IsDescendantOf FontFamily o) => FontFamilyK o toFontFamily :: FontFamilyK o => o -> IO FontFamily toFontFamily = unsafeCastTo FontFamily -- method FontFamily::get_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_font_family_get_name" pango_font_family_get_name :: Ptr FontFamily -> -- _obj : TInterface "Pango" "FontFamily" IO CString fontFamilyGetName :: (MonadIO m, FontFamilyK a) => a -> -- _obj m T.Text fontFamilyGetName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_family_get_name _obj' checkUnexpectedReturnNULL "pango_font_family_get_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FontFamily::is_monospace -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_font_family_is_monospace" pango_font_family_is_monospace :: Ptr FontFamily -> -- _obj : TInterface "Pango" "FontFamily" IO CInt fontFamilyIsMonospace :: (MonadIO m, FontFamilyK a) => a -> -- _obj m Bool fontFamilyIsMonospace _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_family_is_monospace _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method FontFamily::list_faces -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "faces", argType = TCArray False (-1) 2 (TInterface "Pango" "FontFace"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferContainer},Arg {argName = "n_faces", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_faces", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontFamily", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_family_list_faces" pango_font_family_list_faces :: Ptr FontFamily -> -- _obj : TInterface "Pango" "FontFamily" Ptr (Ptr (Ptr FontFace)) -> -- faces : TCArray False (-1) 2 (TInterface "Pango" "FontFace") Ptr Int32 -> -- n_faces : TBasicType TInt32 IO () fontFamilyListFaces :: (MonadIO m, FontFamilyK a) => a -> -- _obj m ([FontFace]) fontFamilyListFaces _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj faces <- allocMem :: IO (Ptr (Ptr (Ptr FontFace))) n_faces <- allocMem :: IO (Ptr Int32) pango_font_family_list_faces _obj' faces n_faces n_faces' <- peek n_faces faces' <- peek faces faces'' <- (unpackPtrArrayWithLength n_faces') faces' faces''' <- mapM (newObject FontFace) faces'' freeMem faces' touchManagedPtr _obj freeMem faces freeMem n_faces return faces''' -- object FontMap newtype FontMap = FontMap (ForeignPtr FontMap) noFontMap :: Maybe FontMap noFontMap = Nothing foreign import ccall "pango_font_map_get_type" c_pango_font_map_get_type :: IO GType type instance ParentTypes FontMap = '[GObject.Object] instance GObject FontMap where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_font_map_get_type class GObject o => FontMapK o instance (GObject o, IsDescendantOf FontMap o) => FontMapK o toFontMap :: FontMapK o => o -> IO FontMap toFontMap = unsafeCastTo FontMap -- method FontMap::changed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_map_changed" pango_font_map_changed :: Ptr FontMap -> -- _obj : TInterface "Pango" "FontMap" IO () fontMapChanged :: (MonadIO m, FontMapK a) => a -> -- _obj m () fontMapChanged _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_font_map_changed _obj' touchManagedPtr _obj return () -- method FontMap::create_context -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Context" -- throws : False -- Skip return : False foreign import ccall "pango_font_map_create_context" pango_font_map_create_context :: Ptr FontMap -> -- _obj : TInterface "Pango" "FontMap" IO (Ptr Context) fontMapCreateContext :: (MonadIO m, FontMapK a) => a -> -- _obj m Context fontMapCreateContext _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_map_create_context _obj' checkUnexpectedReturnNULL "pango_font_map_create_context" result result' <- (wrapObject Context) result touchManagedPtr _obj return result' -- method FontMap::get_serial -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_map_get_serial" pango_font_map_get_serial :: Ptr FontMap -> -- _obj : TInterface "Pango" "FontMap" IO Word32 fontMapGetSerial :: (MonadIO m, FontMapK a) => a -> -- _obj m Word32 fontMapGetSerial _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_map_get_serial _obj' touchManagedPtr _obj return result -- method FontMap::get_shape_engine_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_font_map_get_shape_engine_type" pango_font_map_get_shape_engine_type :: Ptr FontMap -> -- _obj : TInterface "Pango" "FontMap" IO CString fontMapGetShapeEngineType :: (MonadIO m, FontMapK a) => a -> -- _obj m T.Text fontMapGetShapeEngineType _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_font_map_get_shape_engine_type _obj' checkUnexpectedReturnNULL "pango_font_map_get_shape_engine_type" result result' <- cstringToText result touchManagedPtr _obj return result' -- method FontMap::list_families -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "families", argType = TCArray False (-1) 2 (TInterface "Pango" "FontFamily"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferContainer},Arg {argName = "n_families", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_families", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_map_list_families" pango_font_map_list_families :: Ptr FontMap -> -- _obj : TInterface "Pango" "FontMap" Ptr (Ptr (Ptr FontFamily)) -> -- families : TCArray False (-1) 2 (TInterface "Pango" "FontFamily") Ptr Int32 -> -- n_families : TBasicType TInt32 IO () fontMapListFamilies :: (MonadIO m, FontMapK a) => a -> -- _obj m ([FontFamily]) fontMapListFamilies _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj families <- allocMem :: IO (Ptr (Ptr (Ptr FontFamily))) n_families <- allocMem :: IO (Ptr Int32) pango_font_map_list_families _obj' families n_families n_families' <- peek n_families families' <- peek families families'' <- (unpackPtrArrayWithLength n_families') families' families''' <- mapM (newObject FontFamily) families'' freeMem families' touchManagedPtr _obj freeMem families freeMem n_families return families''' -- method FontMap::load_font -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Font" -- throws : False -- Skip return : False foreign import ccall "pango_font_map_load_font" pango_font_map_load_font :: Ptr FontMap -> -- _obj : TInterface "Pango" "FontMap" Ptr Context -> -- context : TInterface "Pango" "Context" Ptr FontDescription -> -- desc : TInterface "Pango" "FontDescription" IO (Ptr Font) fontMapLoadFont :: (MonadIO m, FontMapK a, ContextK b) => a -> -- _obj b -> -- context FontDescription -> -- desc m Font fontMapLoadFont _obj context desc = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let context' = unsafeManagedPtrCastPtr context let desc' = unsafeManagedPtrGetPtr desc result <- pango_font_map_load_font _obj' context' desc' checkUnexpectedReturnNULL "pango_font_map_load_font" result result' <- (wrapObject Font) result touchManagedPtr _obj touchManagedPtr context touchManagedPtr desc return result' -- method FontMap::load_fontset -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMap", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Fontset" -- throws : False -- Skip return : False foreign import ccall "pango_font_map_load_fontset" pango_font_map_load_fontset :: Ptr FontMap -> -- _obj : TInterface "Pango" "FontMap" Ptr Context -> -- context : TInterface "Pango" "Context" Ptr FontDescription -> -- desc : TInterface "Pango" "FontDescription" Ptr Language -> -- language : TInterface "Pango" "Language" IO (Ptr Fontset) fontMapLoadFontset :: (MonadIO m, FontMapK a, ContextK b) => a -> -- _obj b -> -- context FontDescription -> -- desc Language -> -- language m Fontset fontMapLoadFontset _obj context desc language = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let context' = unsafeManagedPtrCastPtr context let desc' = unsafeManagedPtrGetPtr desc let language' = unsafeManagedPtrGetPtr language result <- pango_font_map_load_fontset _obj' context' desc' language' checkUnexpectedReturnNULL "pango_font_map_load_fontset" result result' <- (wrapObject Fontset) result touchManagedPtr _obj touchManagedPtr context touchManagedPtr desc touchManagedPtr language return result' -- Flags FontMask data FontMask = FontMaskFamily | FontMaskStyle | FontMaskVariant | FontMaskWeight | FontMaskStretch | FontMaskSize | FontMaskGravity | AnotherFontMask Int deriving (Show, Eq) instance Enum FontMask where fromEnum FontMaskFamily = 1 fromEnum FontMaskStyle = 2 fromEnum FontMaskVariant = 4 fromEnum FontMaskWeight = 8 fromEnum FontMaskStretch = 16 fromEnum FontMaskSize = 32 fromEnum FontMaskGravity = 64 fromEnum (AnotherFontMask k) = k toEnum 1 = FontMaskFamily toEnum 2 = FontMaskStyle toEnum 4 = FontMaskVariant toEnum 8 = FontMaskWeight toEnum 16 = FontMaskStretch toEnum 32 = FontMaskSize toEnum 64 = FontMaskGravity toEnum k = AnotherFontMask k foreign import ccall "pango_font_mask_get_type" c_pango_font_mask_get_type :: IO GType instance BoxedEnum FontMask where boxedEnumType _ = c_pango_font_mask_get_type instance IsGFlag FontMask -- struct FontMetrics newtype FontMetrics = FontMetrics (ForeignPtr FontMetrics) noFontMetrics :: Maybe FontMetrics noFontMetrics = Nothing foreign import ccall "pango_font_metrics_get_type" c_pango_font_metrics_get_type :: IO GType instance BoxedObject FontMetrics where boxedType _ = c_pango_font_metrics_get_type fontMetricsReadRefCount :: FontMetrics -> IO Word32 fontMetricsReadRefCount s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val fontMetricsReadAscent :: FontMetrics -> IO Int32 fontMetricsReadAscent s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Int32 return val fontMetricsReadDescent :: FontMetrics -> IO Int32 fontMetricsReadDescent s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int32 return val fontMetricsReadApproximateCharWidth :: FontMetrics -> IO Int32 fontMetricsReadApproximateCharWidth s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Int32 return val fontMetricsReadApproximateDigitWidth :: FontMetrics -> IO Int32 fontMetricsReadApproximateDigitWidth s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Int32 return val fontMetricsReadUnderlinePosition :: FontMetrics -> IO Int32 fontMetricsReadUnderlinePosition s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Int32 return val fontMetricsReadUnderlineThickness :: FontMetrics -> IO Int32 fontMetricsReadUnderlineThickness s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Int32 return val fontMetricsReadStrikethroughPosition :: FontMetrics -> IO Int32 fontMetricsReadStrikethroughPosition s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 28) :: IO Int32 return val fontMetricsReadStrikethroughThickness :: FontMetrics -> IO Int32 fontMetricsReadStrikethroughThickness s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO Int32 return val -- method FontMetrics::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Pango" "FontMetrics" -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_new" pango_font_metrics_new :: IO (Ptr FontMetrics) fontMetricsNew :: (MonadIO m) => m FontMetrics fontMetricsNew = liftIO $ do result <- pango_font_metrics_new checkUnexpectedReturnNULL "pango_font_metrics_new" result result' <- (wrapBoxed FontMetrics) result return result' -- method FontMetrics::get_approximate_char_width -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_get_approximate_char_width" pango_font_metrics_get_approximate_char_width :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO Int32 fontMetricsGetApproximateCharWidth :: (MonadIO m) => FontMetrics -> -- _obj m Int32 fontMetricsGetApproximateCharWidth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_get_approximate_char_width _obj' touchManagedPtr _obj return result -- method FontMetrics::get_approximate_digit_width -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_get_approximate_digit_width" pango_font_metrics_get_approximate_digit_width :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO Int32 fontMetricsGetApproximateDigitWidth :: (MonadIO m) => FontMetrics -> -- _obj m Int32 fontMetricsGetApproximateDigitWidth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_get_approximate_digit_width _obj' touchManagedPtr _obj return result -- method FontMetrics::get_ascent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_get_ascent" pango_font_metrics_get_ascent :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO Int32 fontMetricsGetAscent :: (MonadIO m) => FontMetrics -> -- _obj m Int32 fontMetricsGetAscent _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_get_ascent _obj' touchManagedPtr _obj return result -- method FontMetrics::get_descent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_get_descent" pango_font_metrics_get_descent :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO Int32 fontMetricsGetDescent :: (MonadIO m) => FontMetrics -> -- _obj m Int32 fontMetricsGetDescent _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_get_descent _obj' touchManagedPtr _obj return result -- method FontMetrics::get_strikethrough_position -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_get_strikethrough_position" pango_font_metrics_get_strikethrough_position :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO Int32 fontMetricsGetStrikethroughPosition :: (MonadIO m) => FontMetrics -> -- _obj m Int32 fontMetricsGetStrikethroughPosition _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_get_strikethrough_position _obj' touchManagedPtr _obj return result -- method FontMetrics::get_strikethrough_thickness -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_get_strikethrough_thickness" pango_font_metrics_get_strikethrough_thickness :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO Int32 fontMetricsGetStrikethroughThickness :: (MonadIO m) => FontMetrics -> -- _obj m Int32 fontMetricsGetStrikethroughThickness _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_get_strikethrough_thickness _obj' touchManagedPtr _obj return result -- method FontMetrics::get_underline_position -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_get_underline_position" pango_font_metrics_get_underline_position :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO Int32 fontMetricsGetUnderlinePosition :: (MonadIO m) => FontMetrics -> -- _obj m Int32 fontMetricsGetUnderlinePosition _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_get_underline_position _obj' touchManagedPtr _obj return result -- method FontMetrics::get_underline_thickness -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_get_underline_thickness" pango_font_metrics_get_underline_thickness :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO Int32 fontMetricsGetUnderlineThickness :: (MonadIO m) => FontMetrics -> -- _obj m Int32 fontMetricsGetUnderlineThickness _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_get_underline_thickness _obj' touchManagedPtr _obj return result -- method FontMetrics::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontMetrics" -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_ref" pango_font_metrics_ref :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO (Ptr FontMetrics) fontMetricsRef :: (MonadIO m) => FontMetrics -> -- _obj m FontMetrics fontMetricsRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_font_metrics_ref _obj' checkUnexpectedReturnNULL "pango_font_metrics_ref" result result' <- (wrapBoxed FontMetrics) result touchManagedPtr _obj return result' -- method FontMetrics::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontMetrics", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_font_metrics_unref" pango_font_metrics_unref :: Ptr FontMetrics -> -- _obj : TInterface "Pango" "FontMetrics" IO () fontMetricsUnref :: (MonadIO m) => FontMetrics -> -- _obj m () fontMetricsUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_font_metrics_unref _obj' touchManagedPtr _obj return () -- object Fontset newtype Fontset = Fontset (ForeignPtr Fontset) noFontset :: Maybe Fontset noFontset = Nothing foreign import ccall "pango_fontset_get_type" c_pango_fontset_get_type :: IO GType type instance ParentTypes Fontset = '[GObject.Object] instance GObject Fontset where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_fontset_get_type class GObject o => FontsetK o instance (GObject o, IsDescendantOf Fontset o) => FontsetK o toFontset :: FontsetK o => o -> IO Fontset toFontset = unsafeCastTo Fontset -- method Fontset::foreach -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Fontset", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Pango" "FontsetForeachFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Fontset", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Pango" "FontsetForeachFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_fontset_foreach" pango_fontset_foreach :: Ptr Fontset -> -- _obj : TInterface "Pango" "Fontset" FunPtr FontsetForeachFuncC -> -- func : TInterface "Pango" "FontsetForeachFunc" Ptr () -> -- data : TBasicType TVoid IO () fontsetForeach :: (MonadIO m, FontsetK a) => a -> -- _obj FontsetForeachFunc -> -- func m () fontsetForeach _obj func = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj func' <- mkFontsetForeachFunc (fontsetForeachFuncWrapper Nothing func) let data_ = nullPtr pango_fontset_foreach _obj' func' data_ safeFreeFunPtr $ castFunPtrToPtr func' touchManagedPtr _obj return () -- method Fontset::get_font -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Fontset", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Fontset", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Font" -- throws : False -- Skip return : False foreign import ccall "pango_fontset_get_font" pango_fontset_get_font :: Ptr Fontset -> -- _obj : TInterface "Pango" "Fontset" Word32 -> -- wc : TBasicType TUInt32 IO (Ptr Font) fontsetGetFont :: (MonadIO m, FontsetK a) => a -> -- _obj Word32 -> -- wc m Font fontsetGetFont _obj wc = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_fontset_get_font _obj' wc checkUnexpectedReturnNULL "pango_fontset_get_font" result result' <- (wrapObject Font) result touchManagedPtr _obj return result' -- method Fontset::get_metrics -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Fontset", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Fontset", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontMetrics" -- throws : False -- Skip return : False foreign import ccall "pango_fontset_get_metrics" pango_fontset_get_metrics :: Ptr Fontset -> -- _obj : TInterface "Pango" "Fontset" IO (Ptr FontMetrics) fontsetGetMetrics :: (MonadIO m, FontsetK a) => a -> -- _obj m FontMetrics fontsetGetMetrics _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_fontset_get_metrics _obj' checkUnexpectedReturnNULL "pango_fontset_get_metrics" result result' <- (wrapBoxed FontMetrics) result touchManagedPtr _obj return result' -- callback FontsetForeachFunc fontsetForeachFuncClosure :: FontsetForeachFunc -> IO Closure fontsetForeachFuncClosure cb = newCClosure =<< mkFontsetForeachFunc wrapped where wrapped = fontsetForeachFuncWrapper Nothing cb type FontsetForeachFuncC = Ptr Fontset -> Ptr Font -> Ptr () -> IO CInt foreign import ccall "wrapper" mkFontsetForeachFunc :: FontsetForeachFuncC -> IO (FunPtr FontsetForeachFuncC) type FontsetForeachFunc = Fontset -> Font -> IO Bool noFontsetForeachFunc :: Maybe FontsetForeachFunc noFontsetForeachFunc = Nothing fontsetForeachFuncWrapper :: Maybe (Ptr (FunPtr (FontsetForeachFuncC))) -> FontsetForeachFunc -> Ptr Fontset -> Ptr Font -> Ptr () -> IO CInt fontsetForeachFuncWrapper funptrptr _cb fontset font _ = do fontset' <- (newObject Fontset) fontset font' <- (newObject Font) font result <- _cb fontset' font' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- object FontsetSimple newtype FontsetSimple = FontsetSimple (ForeignPtr FontsetSimple) noFontsetSimple :: Maybe FontsetSimple noFontsetSimple = Nothing foreign import ccall "pango_fontset_simple_get_type" c_pango_fontset_simple_get_type :: IO GType type instance ParentTypes FontsetSimple = '[Fontset, GObject.Object] instance GObject FontsetSimple where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_fontset_simple_get_type class GObject o => FontsetSimpleK o instance (GObject o, IsDescendantOf FontsetSimple o) => FontsetSimpleK o toFontsetSimple :: FontsetSimpleK o => o -> IO FontsetSimple toFontsetSimple = unsafeCastTo FontsetSimple -- method FontsetSimple::new -- method type : Constructor -- Args : [Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontsetSimple" -- throws : False -- Skip return : False foreign import ccall "pango_fontset_simple_new" pango_fontset_simple_new :: Ptr Language -> -- language : TInterface "Pango" "Language" IO (Ptr FontsetSimple) fontsetSimpleNew :: (MonadIO m) => Language -> -- language m FontsetSimple fontsetSimpleNew language = liftIO $ do let language' = unsafeManagedPtrGetPtr language result <- pango_fontset_simple_new language' checkUnexpectedReturnNULL "pango_fontset_simple_new" result result' <- (wrapObject FontsetSimple) result touchManagedPtr language return result' -- method FontsetSimple::append -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontsetSimple", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontsetSimple", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_fontset_simple_append" pango_fontset_simple_append :: Ptr FontsetSimple -> -- _obj : TInterface "Pango" "FontsetSimple" Ptr Font -> -- font : TInterface "Pango" "Font" IO () fontsetSimpleAppend :: (MonadIO m, FontsetSimpleK a, FontK b) => a -> -- _obj b -> -- font m () fontsetSimpleAppend _obj font = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let font' = unsafeManagedPtrCastPtr font pango_fontset_simple_append _obj' font' touchManagedPtr _obj touchManagedPtr font return () -- method FontsetSimple::size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "FontsetSimple", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "FontsetSimple", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_fontset_simple_size" pango_fontset_simple_size :: Ptr FontsetSimple -> -- _obj : TInterface "Pango" "FontsetSimple" IO Int32 fontsetSimpleSize :: (MonadIO m, FontsetSimpleK a) => a -> -- _obj m Int32 fontsetSimpleSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_fontset_simple_size _obj' touchManagedPtr _obj return result -- struct GlyphGeometry newtype GlyphGeometry = GlyphGeometry (ForeignPtr GlyphGeometry) noGlyphGeometry :: Maybe GlyphGeometry noGlyphGeometry = Nothing glyphGeometryReadWidth :: GlyphGeometry -> IO Int32 glyphGeometryReadWidth s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val glyphGeometryReadXOffset :: GlyphGeometry -> IO Int32 glyphGeometryReadXOffset s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Int32 return val glyphGeometryReadYOffset :: GlyphGeometry -> IO Int32 glyphGeometryReadYOffset s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int32 return val -- struct GlyphInfo newtype GlyphInfo = GlyphInfo (ForeignPtr GlyphInfo) noGlyphInfo :: Maybe GlyphInfo noGlyphInfo = Nothing glyphInfoReadGlyph :: GlyphInfo -> IO Word32 glyphInfoReadGlyph s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val glyphInfoReadGeometry :: GlyphInfo -> IO GlyphGeometry glyphInfoReadGeometry s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO (Ptr GlyphGeometry) val' <- (newPtr 12 GlyphGeometry) val return val' glyphInfoReadAttr :: GlyphInfo -> IO GlyphVisAttr glyphInfoReadAttr s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr GlyphVisAttr) val' <- (newPtr 4 GlyphVisAttr) val return val' -- struct GlyphItem newtype GlyphItem = GlyphItem (ForeignPtr GlyphItem) noGlyphItem :: Maybe GlyphItem noGlyphItem = Nothing foreign import ccall "pango_glyph_item_get_type" c_pango_glyph_item_get_type :: IO GType instance BoxedObject GlyphItem where boxedType _ = c_pango_glyph_item_get_type glyphItemReadItem :: GlyphItem -> IO Item glyphItemReadItem s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Item) val' <- (newBoxed Item) val return val' glyphItemReadGlyphs :: GlyphItem -> IO GlyphString glyphItemReadGlyphs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr GlyphString) val' <- (newBoxed GlyphString) val return val' -- method GlyphItem::apply_attrs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "list", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TInterface "Pango" "GlyphItem") -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_apply_attrs" pango_glyph_item_apply_attrs :: Ptr GlyphItem -> -- _obj : TInterface "Pango" "GlyphItem" CString -> -- text : TBasicType TUTF8 Ptr AttrList -> -- list : TInterface "Pango" "AttrList" IO (Ptr (GSList (Ptr GlyphItem))) glyphItemApplyAttrs :: (MonadIO m) => GlyphItem -> -- _obj T.Text -> -- text AttrList -> -- list m [GlyphItem] glyphItemApplyAttrs _obj text list = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text let list' = unsafeManagedPtrGetPtr list result <- pango_glyph_item_apply_attrs _obj' text' list' checkUnexpectedReturnNULL "pango_glyph_item_apply_attrs" result result' <- unpackGSList result result'' <- mapM (wrapBoxed GlyphItem) result' g_slist_free result touchManagedPtr _obj touchManagedPtr list freeMem text' return result'' -- method GlyphItem::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "GlyphItem" -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_copy" pango_glyph_item_copy :: Ptr GlyphItem -> -- _obj : TInterface "Pango" "GlyphItem" IO (Ptr GlyphItem) glyphItemCopy :: (MonadIO m) => GlyphItem -> -- _obj m GlyphItem glyphItemCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_glyph_item_copy _obj' checkUnexpectedReturnNULL "pango_glyph_item_copy" result result' <- (wrapBoxed GlyphItem) result touchManagedPtr _obj return result' -- method GlyphItem::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_free" pango_glyph_item_free :: Ptr GlyphItem -> -- _obj : TInterface "Pango" "GlyphItem" IO () glyphItemFree :: (MonadIO m) => GlyphItem -> -- _obj m () glyphItemFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_glyph_item_free _obj' touchManagedPtr _obj return () -- method GlyphItem::get_logical_widths -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_widths", argType = TCArray False (-1) (-1) (TBasicType TInt32), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_widths", argType = TCArray False (-1) (-1) (TBasicType TInt32), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_get_logical_widths" pango_glyph_item_get_logical_widths :: Ptr GlyphItem -> -- _obj : TInterface "Pango" "GlyphItem" CString -> -- text : TBasicType TUTF8 Ptr Int32 -> -- logical_widths : TCArray False (-1) (-1) (TBasicType TInt32) IO () glyphItemGetLogicalWidths :: (MonadIO m) => GlyphItem -> -- _obj T.Text -> -- text Ptr Int32 -> -- logical_widths m () glyphItemGetLogicalWidths _obj text logical_widths = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text pango_glyph_item_get_logical_widths _obj' text' logical_widths touchManagedPtr _obj freeMem text' return () -- method GlyphItem::letter_space -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "log_attrs", argType = TCArray False (-1) (-1) (TInterface "Pango" "LogAttr"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "letter_spacing", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "log_attrs", argType = TCArray False (-1) (-1) (TInterface "Pango" "LogAttr"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "letter_spacing", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_letter_space" pango_glyph_item_letter_space :: Ptr GlyphItem -> -- _obj : TInterface "Pango" "GlyphItem" CString -> -- text : TBasicType TUTF8 Ptr (Ptr LogAttr) -> -- log_attrs : TCArray False (-1) (-1) (TInterface "Pango" "LogAttr") Int32 -> -- letter_spacing : TBasicType TInt32 IO () glyphItemLetterSpace :: (MonadIO m) => GlyphItem -> -- _obj T.Text -> -- text Ptr (Ptr LogAttr) -> -- log_attrs Int32 -> -- letter_spacing m () glyphItemLetterSpace _obj text log_attrs letter_spacing = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text pango_glyph_item_letter_space _obj' text' log_attrs letter_spacing touchManagedPtr _obj freeMem text' return () -- method GlyphItem::split -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "split_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "split_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "GlyphItem" -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_split" pango_glyph_item_split :: Ptr GlyphItem -> -- _obj : TInterface "Pango" "GlyphItem" CString -> -- text : TBasicType TUTF8 Int32 -> -- split_index : TBasicType TInt32 IO (Ptr GlyphItem) glyphItemSplit :: (MonadIO m) => GlyphItem -> -- _obj T.Text -> -- text Int32 -> -- split_index m GlyphItem glyphItemSplit _obj text split_index = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text result <- pango_glyph_item_split _obj' text' split_index checkUnexpectedReturnNULL "pango_glyph_item_split" result result' <- (wrapBoxed GlyphItem) result touchManagedPtr _obj freeMem text' return result' -- struct GlyphItemIter newtype GlyphItemIter = GlyphItemIter (ForeignPtr GlyphItemIter) noGlyphItemIter :: Maybe GlyphItemIter noGlyphItemIter = Nothing foreign import ccall "pango_glyph_item_iter_get_type" c_pango_glyph_item_iter_get_type :: IO GType instance BoxedObject GlyphItemIter where boxedType _ = c_pango_glyph_item_iter_get_type glyphItemIterReadGlyphItem :: GlyphItemIter -> IO GlyphItem glyphItemIterReadGlyphItem s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr GlyphItem) val' <- (newBoxed GlyphItem) val return val' glyphItemIterReadText :: GlyphItemIter -> IO T.Text glyphItemIterReadText s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' glyphItemIterReadStartGlyph :: GlyphItemIter -> IO Int32 glyphItemIterReadStartGlyph s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Int32 return val glyphItemIterReadStartIndex :: GlyphItemIter -> IO Int32 glyphItemIterReadStartIndex s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Int32 return val glyphItemIterReadStartChar :: GlyphItemIter -> IO Int32 glyphItemIterReadStartChar s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Int32 return val glyphItemIterReadEndGlyph :: GlyphItemIter -> IO Int32 glyphItemIterReadEndGlyph s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 28) :: IO Int32 return val glyphItemIterReadEndIndex :: GlyphItemIter -> IO Int32 glyphItemIterReadEndIndex s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO Int32 return val glyphItemIterReadEndChar :: GlyphItemIter -> IO Int32 glyphItemIterReadEndChar s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 36) :: IO Int32 return val -- method GlyphItemIter::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "GlyphItemIter" -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_iter_copy" pango_glyph_item_iter_copy :: Ptr GlyphItemIter -> -- _obj : TInterface "Pango" "GlyphItemIter" IO (Ptr GlyphItemIter) glyphItemIterCopy :: (MonadIO m) => GlyphItemIter -> -- _obj m GlyphItemIter glyphItemIterCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_glyph_item_iter_copy _obj' checkUnexpectedReturnNULL "pango_glyph_item_iter_copy" result result' <- (wrapBoxed GlyphItemIter) result touchManagedPtr _obj return result' -- method GlyphItemIter::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_iter_free" pango_glyph_item_iter_free :: Ptr GlyphItemIter -> -- _obj : TInterface "Pango" "GlyphItemIter" IO () glyphItemIterFree :: (MonadIO m) => GlyphItemIter -> -- _obj m () glyphItemIterFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_glyph_item_iter_free _obj' touchManagedPtr _obj return () -- method GlyphItemIter::init_end -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph_item", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph_item", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_iter_init_end" pango_glyph_item_iter_init_end :: Ptr GlyphItemIter -> -- _obj : TInterface "Pango" "GlyphItemIter" Ptr GlyphItem -> -- glyph_item : TInterface "Pango" "GlyphItem" CString -> -- text : TBasicType TUTF8 IO CInt glyphItemIterInitEnd :: (MonadIO m) => GlyphItemIter -> -- _obj GlyphItem -> -- glyph_item T.Text -> -- text m Bool glyphItemIterInitEnd _obj glyph_item text = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let glyph_item' = unsafeManagedPtrGetPtr glyph_item text' <- textToCString text result <- pango_glyph_item_iter_init_end _obj' glyph_item' text' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr glyph_item freeMem text' return result' -- method GlyphItemIter::init_start -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph_item", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph_item", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_iter_init_start" pango_glyph_item_iter_init_start :: Ptr GlyphItemIter -> -- _obj : TInterface "Pango" "GlyphItemIter" Ptr GlyphItem -> -- glyph_item : TInterface "Pango" "GlyphItem" CString -> -- text : TBasicType TUTF8 IO CInt glyphItemIterInitStart :: (MonadIO m) => GlyphItemIter -> -- _obj GlyphItem -> -- glyph_item T.Text -> -- text m Bool glyphItemIterInitStart _obj glyph_item text = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let glyph_item' = unsafeManagedPtrGetPtr glyph_item text' <- textToCString text result <- pango_glyph_item_iter_init_start _obj' glyph_item' text' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr glyph_item freeMem text' return result' -- method GlyphItemIter::next_cluster -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_iter_next_cluster" pango_glyph_item_iter_next_cluster :: Ptr GlyphItemIter -> -- _obj : TInterface "Pango" "GlyphItemIter" IO CInt glyphItemIterNextCluster :: (MonadIO m) => GlyphItemIter -> -- _obj m Bool glyphItemIterNextCluster _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_glyph_item_iter_next_cluster _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method GlyphItemIter::prev_cluster -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphItemIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_glyph_item_iter_prev_cluster" pango_glyph_item_iter_prev_cluster :: Ptr GlyphItemIter -> -- _obj : TInterface "Pango" "GlyphItemIter" IO CInt glyphItemIterPrevCluster :: (MonadIO m) => GlyphItemIter -> -- _obj m Bool glyphItemIterPrevCluster _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_glyph_item_iter_prev_cluster _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- struct GlyphString newtype GlyphString = GlyphString (ForeignPtr GlyphString) noGlyphString :: Maybe GlyphString noGlyphString = Nothing foreign import ccall "pango_glyph_string_get_type" c_pango_glyph_string_get_type :: IO GType instance BoxedObject GlyphString where boxedType _ = c_pango_glyph_string_get_type glyphStringReadNumGlyphs :: GlyphString -> IO Int32 glyphStringReadNumGlyphs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val glyphStringReadGlyphs :: GlyphString -> IO GlyphInfo glyphStringReadGlyphs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr GlyphInfo) val' <- (newPtr 20 GlyphInfo) val return val' glyphStringReadLogClusters :: GlyphString -> IO Int32 glyphStringReadLogClusters s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Int32 return val -- method GlyphString::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Pango" "GlyphString" -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_new" pango_glyph_string_new :: IO (Ptr GlyphString) glyphStringNew :: (MonadIO m) => m GlyphString glyphStringNew = liftIO $ do result <- pango_glyph_string_new checkUnexpectedReturnNULL "pango_glyph_string_new" result result' <- (wrapBoxed GlyphString) result return result' -- method GlyphString::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "GlyphString" -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_copy" pango_glyph_string_copy :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" IO (Ptr GlyphString) glyphStringCopy :: (MonadIO m) => GlyphString -> -- _obj m GlyphString glyphStringCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_glyph_string_copy _obj' checkUnexpectedReturnNULL "pango_glyph_string_copy" result result' <- (wrapBoxed GlyphString) result touchManagedPtr _obj return result' -- method GlyphString::extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_extents" pango_glyph_string_extents :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" Ptr Font -> -- font : TInterface "Pango" "Font" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () glyphStringExtents :: (MonadIO m, FontK a) => GlyphString -> -- _obj a -> -- font m (Rectangle,Rectangle) glyphStringExtents _obj font = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let font' = unsafeManagedPtrCastPtr font ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_glyph_string_extents _obj' font' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj touchManagedPtr font return (ink_rect', logical_rect') -- method GlyphString::extents_range -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_extents_range" pango_glyph_string_extents_range :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" Int32 -> -- start : TBasicType TInt32 Int32 -> -- end : TBasicType TInt32 Ptr Font -> -- font : TInterface "Pango" "Font" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () glyphStringExtentsRange :: (MonadIO m, FontK a) => GlyphString -> -- _obj Int32 -> -- start Int32 -> -- end a -> -- font m (Rectangle,Rectangle) glyphStringExtentsRange _obj start end font = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let font' = unsafeManagedPtrCastPtr font ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_glyph_string_extents_range _obj' start end font' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj touchManagedPtr font return (ink_rect', logical_rect') -- method GlyphString::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_free" pango_glyph_string_free :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" IO () glyphStringFree :: (MonadIO m) => GlyphString -> -- _obj m () glyphStringFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_glyph_string_free _obj' touchManagedPtr _obj return () -- method GlyphString::get_logical_widths -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "embedding_level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_widths", argType = TCArray False (-1) (-1) (TBasicType TInt32), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "embedding_level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_widths", argType = TCArray False (-1) (-1) (TBasicType TInt32), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_get_logical_widths" pango_glyph_string_get_logical_widths :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 Int32 -> -- embedding_level : TBasicType TInt32 Ptr Int32 -> -- logical_widths : TCArray False (-1) (-1) (TBasicType TInt32) IO () glyphStringGetLogicalWidths :: (MonadIO m) => GlyphString -> -- _obj T.Text -> -- text Int32 -> -- length Int32 -> -- embedding_level Ptr Int32 -> -- logical_widths m () glyphStringGetLogicalWidths _obj text length_ embedding_level logical_widths = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text pango_glyph_string_get_logical_widths _obj' text' length_ embedding_level logical_widths touchManagedPtr _obj freeMem text' return () -- method GlyphString::get_width -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_get_width" pango_glyph_string_get_width :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" IO Int32 glyphStringGetWidth :: (MonadIO m) => GlyphString -> -- _obj m Int32 glyphStringGetWidth _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_glyph_string_get_width _obj' touchManagedPtr _obj return result -- method GlyphString::index_to_x -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trailing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x_pos", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trailing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_index_to_x" pango_glyph_string_index_to_x :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 Ptr Analysis -> -- analysis : TInterface "Pango" "Analysis" Int32 -> -- index_ : TBasicType TInt32 CInt -> -- trailing : TBasicType TBoolean Ptr Int32 -> -- x_pos : TBasicType TInt32 IO () glyphStringIndexToX :: (MonadIO m) => GlyphString -> -- _obj T.Text -> -- text Int32 -> -- length Analysis -> -- analysis Int32 -> -- index_ Bool -> -- trailing m (Int32) glyphStringIndexToX _obj text length_ analysis index_ trailing = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text let analysis' = unsafeManagedPtrGetPtr analysis let trailing' = (fromIntegral . fromEnum) trailing x_pos <- allocMem :: IO (Ptr Int32) pango_glyph_string_index_to_x _obj' text' length_ analysis' index_ trailing' x_pos x_pos' <- peek x_pos touchManagedPtr _obj touchManagedPtr analysis freeMem text' freeMem x_pos return x_pos' -- method GlyphString::set_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_set_size" pango_glyph_string_set_size :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" Int32 -> -- new_len : TBasicType TInt32 IO () glyphStringSetSize :: (MonadIO m) => GlyphString -> -- _obj Int32 -> -- new_len m () glyphStringSetSize _obj new_len = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_glyph_string_set_size _obj' new_len touchManagedPtr _obj return () -- method GlyphString::x_to_index -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x_pos", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "trailing", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x_pos", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_glyph_string_x_to_index" pango_glyph_string_x_to_index :: Ptr GlyphString -> -- _obj : TInterface "Pango" "GlyphString" CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 Ptr Analysis -> -- analysis : TInterface "Pango" "Analysis" Int32 -> -- x_pos : TBasicType TInt32 Ptr Int32 -> -- index_ : TBasicType TInt32 Ptr Int32 -> -- trailing : TBasicType TInt32 IO () glyphStringXToIndex :: (MonadIO m) => GlyphString -> -- _obj T.Text -> -- text Int32 -> -- length Analysis -> -- analysis Int32 -> -- x_pos m (Int32,Int32) glyphStringXToIndex _obj text length_ analysis x_pos = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj text' <- textToCString text let analysis' = unsafeManagedPtrGetPtr analysis index_ <- allocMem :: IO (Ptr Int32) trailing <- allocMem :: IO (Ptr Int32) pango_glyph_string_x_to_index _obj' text' length_ analysis' x_pos index_ trailing index_' <- peek index_ trailing' <- peek trailing touchManagedPtr _obj touchManagedPtr analysis freeMem text' freeMem index_ freeMem trailing return (index_', trailing') -- struct GlyphVisAttr newtype GlyphVisAttr = GlyphVisAttr (ForeignPtr GlyphVisAttr) noGlyphVisAttr :: Maybe GlyphVisAttr noGlyphVisAttr = Nothing glyphVisAttrReadIsClusterStart :: GlyphVisAttr -> IO Word32 glyphVisAttrReadIsClusterStart s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val -- Enum Gravity data Gravity = GravitySouth | GravityEast | GravityNorth | GravityWest | GravityAuto | AnotherGravity Int deriving (Show, Eq) instance Enum Gravity where fromEnum GravitySouth = 0 fromEnum GravityEast = 1 fromEnum GravityNorth = 2 fromEnum GravityWest = 3 fromEnum GravityAuto = 4 fromEnum (AnotherGravity k) = k toEnum 0 = GravitySouth toEnum 1 = GravityEast toEnum 2 = GravityNorth toEnum 3 = GravityWest toEnum 4 = GravityAuto toEnum k = AnotherGravity k foreign import ccall "pango_gravity_get_type" c_pango_gravity_get_type :: IO GType instance BoxedEnum Gravity where boxedEnumType _ = c_pango_gravity_get_type -- Enum GravityHint data GravityHint = GravityHintNatural | GravityHintStrong | GravityHintLine | AnotherGravityHint Int deriving (Show, Eq) instance Enum GravityHint where fromEnum GravityHintNatural = 0 fromEnum GravityHintStrong = 1 fromEnum GravityHintLine = 2 fromEnum (AnotherGravityHint k) = k toEnum 0 = GravityHintNatural toEnum 1 = GravityHintStrong toEnum 2 = GravityHintLine toEnum k = AnotherGravityHint k foreign import ccall "pango_gravity_hint_get_type" c_pango_gravity_hint_get_type :: IO GType instance BoxedEnum GravityHint where boxedEnumType _ = c_pango_gravity_hint_get_type -- struct IncludedModule newtype IncludedModule = IncludedModule (ForeignPtr IncludedModule) noIncludedModule :: Maybe IncludedModule noIncludedModule = Nothing -- XXX Skipped getter for "IncludedModule:list" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IncludedModule:init" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "IncludedModule:exit" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- struct Item newtype Item = Item (ForeignPtr Item) noItem :: Maybe Item noItem = Nothing foreign import ccall "pango_item_get_type" c_pango_item_get_type :: IO GType instance BoxedObject Item where boxedType _ = c_pango_item_get_type itemReadOffset :: Item -> IO Int32 itemReadOffset s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val itemReadLength :: Item -> IO Int32 itemReadLength s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Int32 return val itemReadNumChars :: Item -> IO Int32 itemReadNumChars s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int32 return val itemReadAnalysis :: Item -> IO Analysis itemReadAnalysis s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Analysis) val' <- (newPtr 48 Analysis) val return val' -- method Item::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Pango" "Item" -- throws : False -- Skip return : False foreign import ccall "pango_item_new" pango_item_new :: IO (Ptr Item) itemNew :: (MonadIO m) => m Item itemNew = liftIO $ do result <- pango_item_new checkUnexpectedReturnNULL "pango_item_new" result result' <- (wrapBoxed Item) result return result' -- method Item::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Item", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Item", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Item" -- throws : False -- Skip return : False foreign import ccall "pango_item_copy" pango_item_copy :: Ptr Item -> -- _obj : TInterface "Pango" "Item" IO (Ptr Item) itemCopy :: (MonadIO m) => Item -> -- _obj m Item itemCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_item_copy _obj' checkUnexpectedReturnNULL "pango_item_copy" result result' <- (wrapBoxed Item) result touchManagedPtr _obj return result' -- method Item::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Item", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Item", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_item_free" pango_item_free :: Ptr Item -> -- _obj : TInterface "Pango" "Item" IO () itemFree :: (MonadIO m) => Item -> -- _obj m () itemFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_item_free _obj' touchManagedPtr _obj return () -- method Item::split -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Item", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "split_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "split_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Item", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "split_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "split_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Item" -- throws : False -- Skip return : False foreign import ccall "pango_item_split" pango_item_split :: Ptr Item -> -- _obj : TInterface "Pango" "Item" Int32 -> -- split_index : TBasicType TInt32 Int32 -> -- split_offset : TBasicType TInt32 IO (Ptr Item) itemSplit :: (MonadIO m) => Item -> -- _obj Int32 -> -- split_index Int32 -> -- split_offset m Item itemSplit _obj split_index split_offset = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_item_split _obj' split_index split_offset checkUnexpectedReturnNULL "pango_item_split" result result' <- (wrapBoxed Item) result touchManagedPtr _obj return result' -- struct Language newtype Language = Language (ForeignPtr Language) noLanguage :: Maybe Language noLanguage = Nothing foreign import ccall "pango_language_get_type" c_pango_language_get_type :: IO GType instance BoxedObject Language where boxedType _ = c_pango_language_get_type -- method Language::get_sample_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_language_get_sample_string" pango_language_get_sample_string :: Ptr Language -> -- _obj : TInterface "Pango" "Language" IO CString languageGetSampleString :: (MonadIO m) => Language -> -- _obj m T.Text languageGetSampleString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_language_get_sample_string _obj' checkUnexpectedReturnNULL "pango_language_get_sample_string" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Language::get_scripts -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "num_scripts", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "num_scripts", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TInterface "Pango" "Script") -- throws : False -- Skip return : False foreign import ccall "pango_language_get_scripts" pango_language_get_scripts :: Ptr Language -> -- _obj : TInterface "Pango" "Language" Ptr Int32 -> -- num_scripts : TBasicType TInt32 IO (Ptr CUInt) languageGetScripts :: (MonadIO m) => Language -> -- _obj m [Script] languageGetScripts _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj num_scripts <- allocMem :: IO (Ptr Int32) result <- pango_language_get_scripts _obj' num_scripts num_scripts' <- peek num_scripts checkUnexpectedReturnNULL "pango_language_get_scripts" result result' <- (unpackStorableArrayWithLength num_scripts') result let result'' = map (toEnum . fromIntegral) result' touchManagedPtr _obj freeMem num_scripts return result'' -- method Language::includes_script -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_language_includes_script" pango_language_includes_script :: Ptr Language -> -- _obj : TInterface "Pango" "Language" CUInt -> -- script : TInterface "Pango" "Script" IO CInt languageIncludesScript :: (MonadIO m) => Language -> -- _obj Script -> -- script m Bool languageIncludesScript _obj script = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let script' = (fromIntegral . fromEnum) script result <- pango_language_includes_script _obj' script' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Language::matches -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "range_list", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "range_list", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_language_matches" pango_language_matches :: Ptr Language -> -- _obj : TInterface "Pango" "Language" CString -> -- range_list : TBasicType TUTF8 IO CInt languageMatches :: (MonadIO m) => Language -> -- _obj T.Text -> -- range_list m Bool languageMatches _obj range_list = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj range_list' <- textToCString range_list result <- pango_language_matches _obj' range_list' let result' = (/= 0) result touchManagedPtr _obj freeMem range_list' return result' -- method Language::to_string -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_language_to_string" pango_language_to_string :: Ptr Language -> -- _obj : TInterface "Pango" "Language" IO CString languageToString :: (MonadIO m) => Language -> -- _obj m T.Text languageToString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_language_to_string _obj' checkUnexpectedReturnNULL "pango_language_to_string" result result' <- cstringToText result touchManagedPtr _obj return result' -- object Layout newtype Layout = Layout (ForeignPtr Layout) noLayout :: Maybe Layout noLayout = Nothing foreign import ccall "pango_layout_get_type" c_pango_layout_get_type :: IO GType type instance ParentTypes Layout = '[GObject.Object] instance GObject Layout where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_layout_get_type class GObject o => LayoutK o instance (GObject o, IsDescendantOf Layout o) => LayoutK o toLayout :: LayoutK o => o -> IO Layout toLayout = unsafeCastTo Layout -- method Layout::new -- method type : Constructor -- Args : [Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Layout" -- throws : False -- Skip return : False foreign import ccall "pango_layout_new" pango_layout_new :: Ptr Context -> -- context : TInterface "Pango" "Context" IO (Ptr Layout) layoutNew :: (MonadIO m, ContextK a) => a -> -- context m Layout layoutNew context = liftIO $ do let context' = unsafeManagedPtrCastPtr context result <- pango_layout_new context' checkUnexpectedReturnNULL "pango_layout_new" result result' <- (wrapObject Layout) result touchManagedPtr context return result' -- method Layout::context_changed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_context_changed" pango_layout_context_changed :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO () layoutContextChanged :: (MonadIO m, LayoutK a) => a -> -- _obj m () layoutContextChanged _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_layout_context_changed _obj' touchManagedPtr _obj return () -- method Layout::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Layout" -- throws : False -- Skip return : False foreign import ccall "pango_layout_copy" pango_layout_copy :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO (Ptr Layout) layoutCopy :: (MonadIO m, LayoutK a) => a -> -- _obj m Layout layoutCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_copy _obj' checkUnexpectedReturnNULL "pango_layout_copy" result result' <- (wrapObject Layout) result touchManagedPtr _obj return result' -- method Layout::get_alignment -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Alignment" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_alignment" pango_layout_get_alignment :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CUInt layoutGetAlignment :: (MonadIO m, LayoutK a) => a -> -- _obj m Alignment layoutGetAlignment _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_alignment _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Layout::get_attributes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "AttrList" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_attributes" pango_layout_get_attributes :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO (Ptr AttrList) layoutGetAttributes :: (MonadIO m, LayoutK a) => a -> -- _obj m AttrList layoutGetAttributes _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_attributes _obj' checkUnexpectedReturnNULL "pango_layout_get_attributes" result result' <- (newBoxed AttrList) result touchManagedPtr _obj return result' -- method Layout::get_auto_dir -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_auto_dir" pango_layout_get_auto_dir :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CInt layoutGetAutoDir :: (MonadIO m, LayoutK a) => a -> -- _obj m Bool layoutGetAutoDir _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_auto_dir _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Layout::get_baseline -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_baseline" pango_layout_get_baseline :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Int32 layoutGetBaseline :: (MonadIO m, LayoutK a) => a -> -- _obj m Int32 layoutGetBaseline _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_baseline _obj' touchManagedPtr _obj return result -- method Layout::get_character_count -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_character_count" pango_layout_get_character_count :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Int32 layoutGetCharacterCount :: (MonadIO m, LayoutK a) => a -> -- _obj m Int32 layoutGetCharacterCount _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_character_count _obj' touchManagedPtr _obj return result -- method Layout::get_context -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Context" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_context" pango_layout_get_context :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO (Ptr Context) layoutGetContext :: (MonadIO m, LayoutK a) => a -> -- _obj m Context layoutGetContext _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_context _obj' checkUnexpectedReturnNULL "pango_layout_get_context" result result' <- (newObject Context) result touchManagedPtr _obj return result' -- method Layout::get_cursor_pos -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "strong_pos", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "weak_pos", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_cursor_pos" pango_layout_get_cursor_pos :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- index_ : TBasicType TInt32 Ptr Rectangle -> -- strong_pos : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- weak_pos : TInterface "Pango" "Rectangle" IO () layoutGetCursorPos :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- index_ m (Rectangle,Rectangle) layoutGetCursorPos _obj index_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj strong_pos <- callocBytes 16 :: IO (Ptr Rectangle) weak_pos <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_get_cursor_pos _obj' index_ strong_pos weak_pos strong_pos' <- (wrapPtr Rectangle) strong_pos weak_pos' <- (wrapPtr Rectangle) weak_pos touchManagedPtr _obj return (strong_pos', weak_pos') -- method Layout::get_ellipsize -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "EllipsizeMode" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_ellipsize" pango_layout_get_ellipsize :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CUInt layoutGetEllipsize :: (MonadIO m, LayoutK a) => a -> -- _obj m EllipsizeMode layoutGetEllipsize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_ellipsize _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Layout::get_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_extents" pango_layout_get_extents :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutGetExtents :: (MonadIO m, LayoutK a) => a -> -- _obj m (Rectangle,Rectangle) layoutGetExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_get_extents _obj' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method Layout::get_font_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_font_description" pango_layout_get_font_description :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO (Ptr FontDescription) layoutGetFontDescription :: (MonadIO m, LayoutK a) => a -> -- _obj m FontDescription layoutGetFontDescription _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_font_description _obj' checkUnexpectedReturnNULL "pango_layout_get_font_description" result result' <- (newBoxed FontDescription) result touchManagedPtr _obj return result' -- method Layout::get_height -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_height" pango_layout_get_height :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Int32 layoutGetHeight :: (MonadIO m, LayoutK a) => a -> -- _obj m Int32 layoutGetHeight _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_height _obj' touchManagedPtr _obj return result -- method Layout::get_indent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_indent" pango_layout_get_indent :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Int32 layoutGetIndent :: (MonadIO m, LayoutK a) => a -> -- _obj m Int32 layoutGetIndent _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_indent _obj' touchManagedPtr _obj return result -- method Layout::get_iter -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "LayoutIter" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_iter" pango_layout_get_iter :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO (Ptr LayoutIter) layoutGetIter :: (MonadIO m, LayoutK a) => a -> -- _obj m LayoutIter layoutGetIter _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_iter _obj' checkUnexpectedReturnNULL "pango_layout_get_iter" result result' <- (wrapBoxed LayoutIter) result touchManagedPtr _obj return result' -- method Layout::get_justify -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_justify" pango_layout_get_justify :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CInt layoutGetJustify :: (MonadIO m, LayoutK a) => a -> -- _obj m Bool layoutGetJustify _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_justify _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Layout::get_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "LayoutLine" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_line" pango_layout_get_line :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- line : TBasicType TInt32 IO (Ptr LayoutLine) layoutGetLine :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- line m LayoutLine layoutGetLine _obj line = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_line _obj' line checkUnexpectedReturnNULL "pango_layout_get_line" result result' <- (newBoxed LayoutLine) result touchManagedPtr _obj return result' -- method Layout::get_line_count -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_line_count" pango_layout_get_line_count :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Int32 layoutGetLineCount :: (MonadIO m, LayoutK a) => a -> -- _obj m Int32 layoutGetLineCount _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_line_count _obj' touchManagedPtr _obj return result -- method Layout::get_line_readonly -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "LayoutLine" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_line_readonly" pango_layout_get_line_readonly :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- line : TBasicType TInt32 IO (Ptr LayoutLine) layoutGetLineReadonly :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- line m LayoutLine layoutGetLineReadonly _obj line = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_line_readonly _obj' line checkUnexpectedReturnNULL "pango_layout_get_line_readonly" result result' <- (newBoxed LayoutLine) result touchManagedPtr _obj return result' -- method Layout::get_lines -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TInterface "Pango" "LayoutLine") -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_lines" pango_layout_get_lines :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO (Ptr (GSList (Ptr LayoutLine))) layoutGetLines :: (MonadIO m, LayoutK a) => a -> -- _obj m [LayoutLine] layoutGetLines _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_lines _obj' checkUnexpectedReturnNULL "pango_layout_get_lines" result result' <- unpackGSList result result'' <- mapM (newBoxed LayoutLine) result' touchManagedPtr _obj return result'' -- method Layout::get_lines_readonly -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGSList (TInterface "Pango" "LayoutLine") -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_lines_readonly" pango_layout_get_lines_readonly :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO (Ptr (GSList (Ptr LayoutLine))) layoutGetLinesReadonly :: (MonadIO m, LayoutK a) => a -> -- _obj m [LayoutLine] layoutGetLinesReadonly _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_lines_readonly _obj' checkUnexpectedReturnNULL "pango_layout_get_lines_readonly" result result' <- unpackGSList result result'' <- mapM (newBoxed LayoutLine) result' touchManagedPtr _obj return result'' -- method Layout::get_log_attrs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TCArray False (-1) 2 (TInterface "Pango" "LogAttr"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferContainer},Arg {argName = "n_attrs", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_attrs", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_log_attrs" pango_layout_get_log_attrs :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr (Ptr LogAttr) -> -- attrs : TCArray False (-1) 2 (TInterface "Pango" "LogAttr") Ptr Int32 -> -- n_attrs : TBasicType TInt32 IO () layoutGetLogAttrs :: (MonadIO m, LayoutK a) => a -> -- _obj m ([LogAttr]) layoutGetLogAttrs _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj attrs <- allocMem :: IO (Ptr (Ptr LogAttr)) n_attrs <- allocMem :: IO (Ptr Int32) pango_layout_get_log_attrs _obj' attrs n_attrs n_attrs' <- peek n_attrs attrs' <- peek attrs attrs'' <- (unpackBlockArrayWithLength 52 n_attrs') attrs' attrs''' <- mapM (newPtr 52 LogAttr) attrs'' freeMem attrs' touchManagedPtr _obj freeMem attrs freeMem n_attrs return attrs''' -- method Layout::get_log_attrs_readonly -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_attrs", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_attrs", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TInterface "Pango" "LogAttr") -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_log_attrs_readonly" pango_layout_get_log_attrs_readonly :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr Int32 -> -- n_attrs : TBasicType TInt32 IO (Ptr LogAttr) layoutGetLogAttrsReadonly :: (MonadIO m, LayoutK a) => a -> -- _obj m [LogAttr] layoutGetLogAttrsReadonly _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj n_attrs <- allocMem :: IO (Ptr Int32) result <- pango_layout_get_log_attrs_readonly _obj' n_attrs n_attrs' <- peek n_attrs checkUnexpectedReturnNULL "pango_layout_get_log_attrs_readonly" result result' <- (unpackBlockArrayWithLength 52 n_attrs') result result'' <- mapM (newPtr 52 LogAttr) result' touchManagedPtr _obj freeMem n_attrs return result'' -- method Layout::get_pixel_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_pixel_extents" pango_layout_get_pixel_extents :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutGetPixelExtents :: (MonadIO m, LayoutK a) => a -> -- _obj m (Rectangle,Rectangle) layoutGetPixelExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_get_pixel_extents _obj' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method Layout::get_pixel_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_pixel_size" pango_layout_get_pixel_size :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr Int32 -> -- width : TBasicType TInt32 Ptr Int32 -> -- height : TBasicType TInt32 IO () layoutGetPixelSize :: (MonadIO m, LayoutK a) => a -> -- _obj m (Int32,Int32) layoutGetPixelSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj width <- allocMem :: IO (Ptr Int32) height <- allocMem :: IO (Ptr Int32) pango_layout_get_pixel_size _obj' width height width' <- peek width height' <- peek height touchManagedPtr _obj freeMem width freeMem height return (width', height') -- method Layout::get_serial -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_serial" pango_layout_get_serial :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Word32 layoutGetSerial :: (MonadIO m, LayoutK a) => a -> -- _obj m Word32 layoutGetSerial _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_serial _obj' touchManagedPtr _obj return result -- method Layout::get_single_paragraph_mode -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_single_paragraph_mode" pango_layout_get_single_paragraph_mode :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CInt layoutGetSingleParagraphMode :: (MonadIO m, LayoutK a) => a -> -- _obj m Bool layoutGetSingleParagraphMode _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_single_paragraph_mode _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Layout::get_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_size" pango_layout_get_size :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr Int32 -> -- width : TBasicType TInt32 Ptr Int32 -> -- height : TBasicType TInt32 IO () layoutGetSize :: (MonadIO m, LayoutK a) => a -> -- _obj m (Int32,Int32) layoutGetSize _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj width <- allocMem :: IO (Ptr Int32) height <- allocMem :: IO (Ptr Int32) pango_layout_get_size _obj' width height width' <- peek width height' <- peek height touchManagedPtr _obj freeMem width freeMem height return (width', height') -- method Layout::get_spacing -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_spacing" pango_layout_get_spacing :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Int32 layoutGetSpacing :: (MonadIO m, LayoutK a) => a -> -- _obj m Int32 layoutGetSpacing _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_spacing _obj' touchManagedPtr _obj return result -- method Layout::get_tabs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "TabArray" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_tabs" pango_layout_get_tabs :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO (Ptr TabArray) layoutGetTabs :: (MonadIO m, LayoutK a) => a -> -- _obj m TabArray layoutGetTabs _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_tabs _obj' checkUnexpectedReturnNULL "pango_layout_get_tabs" result result' <- (wrapBoxed TabArray) result touchManagedPtr _obj return result' -- method Layout::get_text -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_text" pango_layout_get_text :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CString layoutGetText :: (MonadIO m, LayoutK a) => a -> -- _obj m T.Text layoutGetText _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_text _obj' checkUnexpectedReturnNULL "pango_layout_get_text" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Layout::get_unknown_glyphs_count -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_unknown_glyphs_count" pango_layout_get_unknown_glyphs_count :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Int32 layoutGetUnknownGlyphsCount :: (MonadIO m, LayoutK a) => a -> -- _obj m Int32 layoutGetUnknownGlyphsCount _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_unknown_glyphs_count _obj' touchManagedPtr _obj return result -- method Layout::get_width -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_width" pango_layout_get_width :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO Int32 layoutGetWidth :: (MonadIO m, LayoutK a) => a -> -- _obj m Int32 layoutGetWidth _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_width _obj' touchManagedPtr _obj return result -- method Layout::get_wrap -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "WrapMode" -- throws : False -- Skip return : False foreign import ccall "pango_layout_get_wrap" pango_layout_get_wrap :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CUInt layoutGetWrap :: (MonadIO m, LayoutK a) => a -> -- _obj m WrapMode layoutGetWrap _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_get_wrap _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Layout::index_to_line_x -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trailing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "x_pos", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trailing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_index_to_line_x" pango_layout_index_to_line_x :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- index_ : TBasicType TInt32 CInt -> -- trailing : TBasicType TBoolean Ptr Int32 -> -- line : TBasicType TInt32 Ptr Int32 -> -- x_pos : TBasicType TInt32 IO () layoutIndexToLineX :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- index_ Bool -> -- trailing m (Int32,Int32) layoutIndexToLineX _obj index_ trailing = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let trailing' = (fromIntegral . fromEnum) trailing line <- allocMem :: IO (Ptr Int32) x_pos <- allocMem :: IO (Ptr Int32) pango_layout_index_to_line_x _obj' index_ trailing' line x_pos line' <- peek line x_pos' <- peek x_pos touchManagedPtr _obj freeMem line freeMem x_pos return (line', x_pos') -- method Layout::index_to_pos -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_index_to_pos" pango_layout_index_to_pos :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- index_ : TBasicType TInt32 Ptr Rectangle -> -- pos : TInterface "Pango" "Rectangle" IO () layoutIndexToPos :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- index_ m (Rectangle) layoutIndexToPos _obj index_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pos <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_index_to_pos _obj' index_ pos pos' <- (wrapPtr Rectangle) pos touchManagedPtr _obj return pos' -- method Layout::is_ellipsized -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_is_ellipsized" pango_layout_is_ellipsized :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CInt layoutIsEllipsized :: (MonadIO m, LayoutK a) => a -> -- _obj m Bool layoutIsEllipsized _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_is_ellipsized _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Layout::is_wrapped -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_is_wrapped" pango_layout_is_wrapped :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" IO CInt layoutIsWrapped :: (MonadIO m, LayoutK a) => a -> -- _obj m Bool layoutIsWrapped _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_layout_is_wrapped _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Layout::move_cursor_visually -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "strong", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_trailing", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "direction", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_index", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "new_trailing", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "strong", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_trailing", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "direction", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_move_cursor_visually" pango_layout_move_cursor_visually :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CInt -> -- strong : TBasicType TBoolean Int32 -> -- old_index : TBasicType TInt32 Int32 -> -- old_trailing : TBasicType TInt32 Int32 -> -- direction : TBasicType TInt32 Ptr Int32 -> -- new_index : TBasicType TInt32 Ptr Int32 -> -- new_trailing : TBasicType TInt32 IO () layoutMoveCursorVisually :: (MonadIO m, LayoutK a) => a -> -- _obj Bool -> -- strong Int32 -> -- old_index Int32 -> -- old_trailing Int32 -> -- direction m (Int32,Int32) layoutMoveCursorVisually _obj strong old_index old_trailing direction = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let strong' = (fromIntegral . fromEnum) strong new_index <- allocMem :: IO (Ptr Int32) new_trailing <- allocMem :: IO (Ptr Int32) pango_layout_move_cursor_visually _obj' strong' old_index old_trailing direction new_index new_trailing new_index' <- peek new_index new_trailing' <- peek new_trailing touchManagedPtr _obj freeMem new_index freeMem new_trailing return (new_index', new_trailing') -- method Layout::set_alignment -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "alignment", argType = TInterface "Pango" "Alignment", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "alignment", argType = TInterface "Pango" "Alignment", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_alignment" pango_layout_set_alignment :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CUInt -> -- alignment : TInterface "Pango" "Alignment" IO () layoutSetAlignment :: (MonadIO m, LayoutK a) => a -> -- _obj Alignment -> -- alignment m () layoutSetAlignment _obj alignment = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let alignment' = (fromIntegral . fromEnum) alignment pango_layout_set_alignment _obj' alignment' touchManagedPtr _obj return () -- method Layout::set_attributes -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_attributes" pango_layout_set_attributes :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr AttrList -> -- attrs : TInterface "Pango" "AttrList" IO () layoutSetAttributes :: (MonadIO m, LayoutK a) => a -> -- _obj Maybe (AttrList) -> -- attrs m () layoutSetAttributes _obj attrs = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeAttrs <- case attrs of Nothing -> return nullPtr Just jAttrs -> do let jAttrs' = unsafeManagedPtrGetPtr jAttrs return jAttrs' pango_layout_set_attributes _obj' maybeAttrs touchManagedPtr _obj whenJust attrs touchManagedPtr return () -- method Layout::set_auto_dir -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "auto_dir", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "auto_dir", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_auto_dir" pango_layout_set_auto_dir :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CInt -> -- auto_dir : TBasicType TBoolean IO () layoutSetAutoDir :: (MonadIO m, LayoutK a) => a -> -- _obj Bool -> -- auto_dir m () layoutSetAutoDir _obj auto_dir = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let auto_dir' = (fromIntegral . fromEnum) auto_dir pango_layout_set_auto_dir _obj' auto_dir' touchManagedPtr _obj return () -- method Layout::set_ellipsize -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ellipsize", argType = TInterface "Pango" "EllipsizeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ellipsize", argType = TInterface "Pango" "EllipsizeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_ellipsize" pango_layout_set_ellipsize :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CUInt -> -- ellipsize : TInterface "Pango" "EllipsizeMode" IO () layoutSetEllipsize :: (MonadIO m, LayoutK a) => a -> -- _obj EllipsizeMode -> -- ellipsize m () layoutSetEllipsize _obj ellipsize = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let ellipsize' = (fromIntegral . fromEnum) ellipsize pango_layout_set_ellipsize _obj' ellipsize' touchManagedPtr _obj return () -- method Layout::set_font_description -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_font_description" pango_layout_set_font_description :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr FontDescription -> -- desc : TInterface "Pango" "FontDescription" IO () layoutSetFontDescription :: (MonadIO m, LayoutK a) => a -> -- _obj Maybe (FontDescription) -> -- desc m () layoutSetFontDescription _obj desc = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeDesc <- case desc of Nothing -> return nullPtr Just jDesc -> do let jDesc' = unsafeManagedPtrGetPtr jDesc return jDesc' pango_layout_set_font_description _obj' maybeDesc touchManagedPtr _obj whenJust desc touchManagedPtr return () -- method Layout::set_height -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_height" pango_layout_set_height :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- height : TBasicType TInt32 IO () layoutSetHeight :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- height m () layoutSetHeight _obj height = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_layout_set_height _obj' height touchManagedPtr _obj return () -- method Layout::set_indent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "indent", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "indent", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_indent" pango_layout_set_indent :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- indent : TBasicType TInt32 IO () layoutSetIndent :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- indent m () layoutSetIndent _obj indent = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_layout_set_indent _obj' indent touchManagedPtr _obj return () -- method Layout::set_justify -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "justify", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "justify", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_justify" pango_layout_set_justify :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CInt -> -- justify : TBasicType TBoolean IO () layoutSetJustify :: (MonadIO m, LayoutK a) => a -> -- _obj Bool -> -- justify m () layoutSetJustify _obj justify = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let justify' = (fromIntegral . fromEnum) justify pango_layout_set_justify _obj' justify' touchManagedPtr _obj return () -- method Layout::set_markup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_markup" pango_layout_set_markup :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CString -> -- markup : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 IO () layoutSetMarkup :: (MonadIO m, LayoutK a) => a -> -- _obj T.Text -> -- markup Int32 -> -- length m () layoutSetMarkup _obj markup length_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj markup' <- textToCString markup pango_layout_set_markup _obj' markup' length_ touchManagedPtr _obj freeMem markup' return () -- method Layout::set_markup_with_accel -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_marker", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_char", argType = TBasicType TUniChar, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_marker", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_markup_with_accel" pango_layout_set_markup_with_accel :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CString -> -- markup : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 CInt -> -- accel_marker : TBasicType TUniChar Ptr CInt -> -- accel_char : TBasicType TUniChar IO () layoutSetMarkupWithAccel :: (MonadIO m, LayoutK a) => a -> -- _obj T.Text -> -- markup Int32 -> -- length Char -> -- accel_marker m (Char) layoutSetMarkupWithAccel _obj markup length_ accel_marker = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj markup' <- textToCString markup let accel_marker' = (fromIntegral . ord) accel_marker accel_char <- allocMem :: IO (Ptr CInt) pango_layout_set_markup_with_accel _obj' markup' length_ accel_marker' accel_char accel_char' <- peek accel_char let accel_char'' = (chr . fromIntegral) accel_char' touchManagedPtr _obj freeMem markup' freeMem accel_char return accel_char'' -- method Layout::set_single_paragraph_mode -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_single_paragraph_mode" pango_layout_set_single_paragraph_mode :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CInt -> -- setting : TBasicType TBoolean IO () layoutSetSingleParagraphMode :: (MonadIO m, LayoutK a) => a -> -- _obj Bool -> -- setting m () layoutSetSingleParagraphMode _obj setting = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let setting' = (fromIntegral . fromEnum) setting pango_layout_set_single_paragraph_mode _obj' setting' touchManagedPtr _obj return () -- method Layout::set_spacing -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "spacing", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "spacing", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_spacing" pango_layout_set_spacing :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- spacing : TBasicType TInt32 IO () layoutSetSpacing :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- spacing m () layoutSetSpacing _obj spacing = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_layout_set_spacing _obj' spacing touchManagedPtr _obj return () -- method Layout::set_tabs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tabs", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tabs", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_tabs" pango_layout_set_tabs :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Ptr TabArray -> -- tabs : TInterface "Pango" "TabArray" IO () layoutSetTabs :: (MonadIO m, LayoutK a) => a -> -- _obj Maybe (TabArray) -> -- tabs m () layoutSetTabs _obj tabs = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeTabs <- case tabs of Nothing -> return nullPtr Just jTabs -> do let jTabs' = unsafeManagedPtrGetPtr jTabs return jTabs' pango_layout_set_tabs _obj' maybeTabs touchManagedPtr _obj whenJust tabs touchManagedPtr return () -- method Layout::set_text -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_text" pango_layout_set_text :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 IO () layoutSetText :: (MonadIO m, LayoutK a) => a -> -- _obj T.Text -> -- text Int32 -> -- length m () layoutSetText _obj text length_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj text' <- textToCString text pango_layout_set_text _obj' text' length_ touchManagedPtr _obj freeMem text' return () -- method Layout::set_width -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_width" pango_layout_set_width :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- width : TBasicType TInt32 IO () layoutSetWidth :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- width m () layoutSetWidth _obj width = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_layout_set_width _obj' width touchManagedPtr _obj return () -- method Layout::set_wrap -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wrap", argType = TInterface "Pango" "WrapMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wrap", argType = TInterface "Pango" "WrapMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_set_wrap" pango_layout_set_wrap :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" CUInt -> -- wrap : TInterface "Pango" "WrapMode" IO () layoutSetWrap :: (MonadIO m, LayoutK a) => a -> -- _obj WrapMode -> -- wrap m () layoutSetWrap _obj wrap = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let wrap' = (fromIntegral . fromEnum) wrap pango_layout_set_wrap _obj' wrap' touchManagedPtr _obj return () -- method Layout::xy_to_index -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "trailing", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_xy_to_index" pango_layout_xy_to_index :: Ptr Layout -> -- _obj : TInterface "Pango" "Layout" Int32 -> -- x : TBasicType TInt32 Int32 -> -- y : TBasicType TInt32 Ptr Int32 -> -- index_ : TBasicType TInt32 Ptr Int32 -> -- trailing : TBasicType TInt32 IO CInt layoutXyToIndex :: (MonadIO m, LayoutK a) => a -> -- _obj Int32 -> -- x Int32 -> -- y m (Bool,Int32,Int32) layoutXyToIndex _obj x y = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj index_ <- allocMem :: IO (Ptr Int32) trailing <- allocMem :: IO (Ptr Int32) result <- pango_layout_xy_to_index _obj' x y index_ trailing let result' = (/= 0) result index_' <- peek index_ trailing' <- peek trailing touchManagedPtr _obj freeMem index_ freeMem trailing return (result', index_', trailing') -- struct LayoutIter newtype LayoutIter = LayoutIter (ForeignPtr LayoutIter) noLayoutIter :: Maybe LayoutIter noLayoutIter = Nothing foreign import ccall "pango_layout_iter_get_type" c_pango_layout_iter_get_type :: IO GType instance BoxedObject LayoutIter where boxedType _ = c_pango_layout_iter_get_type -- method LayoutIter::at_last_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_at_last_line" pango_layout_iter_at_last_line :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO CInt layoutIterAtLastLine :: (MonadIO m) => LayoutIter -> -- _obj m Bool layoutIterAtLastLine _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_at_last_line _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method LayoutIter::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "LayoutIter" -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_copy" pango_layout_iter_copy :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO (Ptr LayoutIter) layoutIterCopy :: (MonadIO m) => LayoutIter -> -- _obj m LayoutIter layoutIterCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_copy _obj' checkUnexpectedReturnNULL "pango_layout_iter_copy" result result' <- (wrapBoxed LayoutIter) result touchManagedPtr _obj return result' -- method LayoutIter::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_free" pango_layout_iter_free :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO () layoutIterFree :: (MonadIO m) => LayoutIter -> -- _obj m () layoutIterFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_layout_iter_free _obj' touchManagedPtr _obj return () -- method LayoutIter::get_baseline -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_baseline" pango_layout_iter_get_baseline :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO Int32 layoutIterGetBaseline :: (MonadIO m) => LayoutIter -> -- _obj m Int32 layoutIterGetBaseline _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_get_baseline _obj' touchManagedPtr _obj return result -- method LayoutIter::get_char_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_char_extents" pango_layout_iter_get_char_extents :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutIterGetCharExtents :: (MonadIO m) => LayoutIter -> -- _obj m (Rectangle) layoutIterGetCharExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_iter_get_char_extents _obj' logical_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return logical_rect' -- method LayoutIter::get_cluster_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_cluster_extents" pango_layout_iter_get_cluster_extents :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutIterGetClusterExtents :: (MonadIO m) => LayoutIter -> -- _obj m (Rectangle,Rectangle) layoutIterGetClusterExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_iter_get_cluster_extents _obj' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method LayoutIter::get_index -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_index" pango_layout_iter_get_index :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO Int32 layoutIterGetIndex :: (MonadIO m) => LayoutIter -> -- _obj m Int32 layoutIterGetIndex _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_get_index _obj' touchManagedPtr _obj return result -- method LayoutIter::get_layout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Layout" -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_layout" pango_layout_iter_get_layout :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO (Ptr Layout) layoutIterGetLayout :: (MonadIO m) => LayoutIter -> -- _obj m Layout layoutIterGetLayout _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_get_layout _obj' checkUnexpectedReturnNULL "pango_layout_iter_get_layout" result result' <- (newObject Layout) result touchManagedPtr _obj return result' -- method LayoutIter::get_layout_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_layout_extents" pango_layout_iter_get_layout_extents :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutIterGetLayoutExtents :: (MonadIO m) => LayoutIter -> -- _obj m (Rectangle,Rectangle) layoutIterGetLayoutExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_iter_get_layout_extents _obj' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method LayoutIter::get_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "LayoutLine" -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_line" pango_layout_iter_get_line :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO (Ptr LayoutLine) layoutIterGetLine :: (MonadIO m) => LayoutIter -> -- _obj m LayoutLine layoutIterGetLine _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_get_line _obj' checkUnexpectedReturnNULL "pango_layout_iter_get_line" result result' <- (wrapBoxed LayoutLine) result touchManagedPtr _obj return result' -- method LayoutIter::get_line_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_line_extents" pango_layout_iter_get_line_extents :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutIterGetLineExtents :: (MonadIO m) => LayoutIter -> -- _obj m (Rectangle,Rectangle) layoutIterGetLineExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_iter_get_line_extents _obj' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method LayoutIter::get_line_readonly -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "LayoutLine" -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_line_readonly" pango_layout_iter_get_line_readonly :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO (Ptr LayoutLine) layoutIterGetLineReadonly :: (MonadIO m) => LayoutIter -> -- _obj m LayoutLine layoutIterGetLineReadonly _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_get_line_readonly _obj' checkUnexpectedReturnNULL "pango_layout_iter_get_line_readonly" result result' <- (newBoxed LayoutLine) result touchManagedPtr _obj return result' -- method LayoutIter::get_line_yrange -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y0_", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y1_", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_line_yrange" pango_layout_iter_get_line_yrange :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" Ptr Int32 -> -- y0_ : TBasicType TInt32 Ptr Int32 -> -- y1_ : TBasicType TInt32 IO () layoutIterGetLineYrange :: (MonadIO m) => LayoutIter -> -- _obj m (Int32,Int32) layoutIterGetLineYrange _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj y0_ <- allocMem :: IO (Ptr Int32) y1_ <- allocMem :: IO (Ptr Int32) pango_layout_iter_get_line_yrange _obj' y0_ y1_ y0_' <- peek y0_ y1_' <- peek y1_ touchManagedPtr _obj freeMem y0_ freeMem y1_ return (y0_', y1_') -- method LayoutIter::get_run -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "GlyphItem" -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_run" pango_layout_iter_get_run :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO (Ptr GlyphItem) layoutIterGetRun :: (MonadIO m) => LayoutIter -> -- _obj m GlyphItem layoutIterGetRun _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_get_run _obj' checkUnexpectedReturnNULL "pango_layout_iter_get_run" result result' <- (newBoxed GlyphItem) result touchManagedPtr _obj return result' -- method LayoutIter::get_run_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_run_extents" pango_layout_iter_get_run_extents :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutIterGetRunExtents :: (MonadIO m) => LayoutIter -> -- _obj m (Rectangle,Rectangle) layoutIterGetRunExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_iter_get_run_extents _obj' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method LayoutIter::get_run_readonly -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "GlyphItem" -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_get_run_readonly" pango_layout_iter_get_run_readonly :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO (Ptr GlyphItem) layoutIterGetRunReadonly :: (MonadIO m) => LayoutIter -> -- _obj m GlyphItem layoutIterGetRunReadonly _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_get_run_readonly _obj' checkUnexpectedReturnNULL "pango_layout_iter_get_run_readonly" result result' <- (newBoxed GlyphItem) result touchManagedPtr _obj return result' -- method LayoutIter::next_char -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_next_char" pango_layout_iter_next_char :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO CInt layoutIterNextChar :: (MonadIO m) => LayoutIter -> -- _obj m Bool layoutIterNextChar _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_next_char _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method LayoutIter::next_cluster -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_next_cluster" pango_layout_iter_next_cluster :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO CInt layoutIterNextCluster :: (MonadIO m) => LayoutIter -> -- _obj m Bool layoutIterNextCluster _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_next_cluster _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method LayoutIter::next_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_next_line" pango_layout_iter_next_line :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO CInt layoutIterNextLine :: (MonadIO m) => LayoutIter -> -- _obj m Bool layoutIterNextLine _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_next_line _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method LayoutIter::next_run -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_iter_next_run" pango_layout_iter_next_run :: Ptr LayoutIter -> -- _obj : TInterface "Pango" "LayoutIter" IO CInt layoutIterNextRun :: (MonadIO m) => LayoutIter -> -- _obj m Bool layoutIterNextRun _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_iter_next_run _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- struct LayoutLine newtype LayoutLine = LayoutLine (ForeignPtr LayoutLine) noLayoutLine :: Maybe LayoutLine noLayoutLine = Nothing foreign import ccall "pango_layout_line_get_type" c_pango_layout_line_get_type :: IO GType instance BoxedObject LayoutLine where boxedType _ = c_pango_layout_line_get_type layoutLineReadLayout :: LayoutLine -> IO Layout layoutLineReadLayout s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Layout) val' <- (newObject Layout) val return val' layoutLineReadStartIndex :: LayoutLine -> IO Int32 layoutLineReadStartIndex s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int32 return val layoutLineReadLength :: LayoutLine -> IO Int32 layoutLineReadLength s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Int32 return val layoutLineReadRuns :: LayoutLine -> IO ([Ptr ()]) layoutLineReadRuns s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr (GSList (Ptr ()))) val' <- unpackGSList val return val' layoutLineReadIsParagraphStart :: LayoutLine -> IO Word32 layoutLineReadIsParagraphStart s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Word32 return val layoutLineReadResolvedDir :: LayoutLine -> IO Word32 layoutLineReadResolvedDir s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 28) :: IO Word32 return val -- method LayoutLine::get_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_line_get_extents" pango_layout_line_get_extents :: Ptr LayoutLine -> -- _obj : TInterface "Pango" "LayoutLine" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutLineGetExtents :: (MonadIO m) => LayoutLine -> -- _obj m (Rectangle,Rectangle) layoutLineGetExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_line_get_extents _obj' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method LayoutLine::get_pixel_extents -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ink_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "logical_rect", argType = TInterface "Pango" "Rectangle", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_line_get_pixel_extents" pango_layout_line_get_pixel_extents :: Ptr LayoutLine -> -- _obj : TInterface "Pango" "LayoutLine" Ptr Rectangle -> -- ink_rect : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- logical_rect : TInterface "Pango" "Rectangle" IO () layoutLineGetPixelExtents :: (MonadIO m) => LayoutLine -> -- _obj m (Rectangle,Rectangle) layoutLineGetPixelExtents _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ink_rect <- callocBytes 16 :: IO (Ptr Rectangle) logical_rect <- callocBytes 16 :: IO (Ptr Rectangle) pango_layout_line_get_pixel_extents _obj' ink_rect logical_rect ink_rect' <- (wrapPtr Rectangle) ink_rect logical_rect' <- (wrapPtr Rectangle) logical_rect touchManagedPtr _obj return (ink_rect', logical_rect') -- method LayoutLine::get_x_ranges -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ranges", argType = TCArray False (-1) 4 (TBasicType TInt32), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "n_ranges", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_ranges", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_line_get_x_ranges" pango_layout_line_get_x_ranges :: Ptr LayoutLine -> -- _obj : TInterface "Pango" "LayoutLine" Int32 -> -- start_index : TBasicType TInt32 Int32 -> -- end_index : TBasicType TInt32 Ptr (Ptr Int32) -> -- ranges : TCArray False (-1) 4 (TBasicType TInt32) Ptr Int32 -> -- n_ranges : TBasicType TInt32 IO () layoutLineGetXRanges :: (MonadIO m) => LayoutLine -> -- _obj Int32 -> -- start_index Int32 -> -- end_index m ([Int32]) layoutLineGetXRanges _obj start_index end_index = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj ranges <- allocMem :: IO (Ptr (Ptr Int32)) n_ranges <- allocMem :: IO (Ptr Int32) pango_layout_line_get_x_ranges _obj' start_index end_index ranges n_ranges n_ranges' <- peek n_ranges ranges' <- peek ranges ranges'' <- (unpackStorableArrayWithLength n_ranges') ranges' freeMem ranges' touchManagedPtr _obj freeMem ranges freeMem n_ranges return ranges'' -- method LayoutLine::index_to_x -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trailing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x_pos", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "trailing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_line_index_to_x" pango_layout_line_index_to_x :: Ptr LayoutLine -> -- _obj : TInterface "Pango" "LayoutLine" Int32 -> -- index_ : TBasicType TInt32 CInt -> -- trailing : TBasicType TBoolean Ptr Int32 -> -- x_pos : TBasicType TInt32 IO () layoutLineIndexToX :: (MonadIO m) => LayoutLine -> -- _obj Int32 -> -- index_ Bool -> -- trailing m (Int32) layoutLineIndexToX _obj index_ trailing = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let trailing' = (fromIntegral . fromEnum) trailing x_pos <- allocMem :: IO (Ptr Int32) pango_layout_line_index_to_x _obj' index_ trailing' x_pos x_pos' <- peek x_pos touchManagedPtr _obj freeMem x_pos return x_pos' -- method LayoutLine::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "LayoutLine" -- throws : False -- Skip return : False foreign import ccall "pango_layout_line_ref" pango_layout_line_ref :: Ptr LayoutLine -> -- _obj : TInterface "Pango" "LayoutLine" IO (Ptr LayoutLine) layoutLineRef :: (MonadIO m) => LayoutLine -> -- _obj m LayoutLine layoutLineRef _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_layout_line_ref _obj' checkUnexpectedReturnNULL "pango_layout_line_ref" result result' <- (wrapBoxed LayoutLine) result touchManagedPtr _obj return result' -- method LayoutLine::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_layout_line_unref" pango_layout_line_unref :: Ptr LayoutLine -> -- _obj : TInterface "Pango" "LayoutLine" IO () layoutLineUnref :: (MonadIO m) => LayoutLine -> -- _obj m () layoutLineUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_layout_line_unref _obj' touchManagedPtr _obj return () -- method LayoutLine::x_to_index -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x_pos", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "trailing", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x_pos", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_layout_line_x_to_index" pango_layout_line_x_to_index :: Ptr LayoutLine -> -- _obj : TInterface "Pango" "LayoutLine" Int32 -> -- x_pos : TBasicType TInt32 Ptr Int32 -> -- index_ : TBasicType TInt32 Ptr Int32 -> -- trailing : TBasicType TInt32 IO CInt layoutLineXToIndex :: (MonadIO m) => LayoutLine -> -- _obj Int32 -> -- x_pos m (Bool,Int32,Int32) layoutLineXToIndex _obj x_pos = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj index_ <- allocMem :: IO (Ptr Int32) trailing <- allocMem :: IO (Ptr Int32) result <- pango_layout_line_x_to_index _obj' x_pos index_ trailing let result' = (/= 0) result index_' <- peek index_ trailing' <- peek trailing touchManagedPtr _obj freeMem index_ freeMem trailing return (result', index_', trailing') -- struct LogAttr newtype LogAttr = LogAttr (ForeignPtr LogAttr) noLogAttr :: Maybe LogAttr noLogAttr = Nothing logAttrReadIsLineBreak :: LogAttr -> IO Word32 logAttrReadIsLineBreak s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val logAttrReadIsMandatoryBreak :: LogAttr -> IO Word32 logAttrReadIsMandatoryBreak s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word32 return val logAttrReadIsCharBreak :: LogAttr -> IO Word32 logAttrReadIsCharBreak s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val logAttrReadIsWhite :: LogAttr -> IO Word32 logAttrReadIsWhite s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Word32 return val logAttrReadIsCursorPosition :: LogAttr -> IO Word32 logAttrReadIsCursorPosition s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word32 return val logAttrReadIsWordStart :: LogAttr -> IO Word32 logAttrReadIsWordStart s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Word32 return val logAttrReadIsWordEnd :: LogAttr -> IO Word32 logAttrReadIsWordEnd s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Word32 return val logAttrReadIsSentenceBoundary :: LogAttr -> IO Word32 logAttrReadIsSentenceBoundary s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 28) :: IO Word32 return val logAttrReadIsSentenceStart :: LogAttr -> IO Word32 logAttrReadIsSentenceStart s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO Word32 return val logAttrReadIsSentenceEnd :: LogAttr -> IO Word32 logAttrReadIsSentenceEnd s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 36) :: IO Word32 return val logAttrReadBackspaceDeletesCharacter :: LogAttr -> IO Word32 logAttrReadBackspaceDeletesCharacter s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO Word32 return val logAttrReadIsExpandableSpace :: LogAttr -> IO Word32 logAttrReadIsExpandableSpace s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 44) :: IO Word32 return val logAttrReadIsWordBoundary :: LogAttr -> IO Word32 logAttrReadIsWordBoundary s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO Word32 return val -- struct Map newtype Map = Map (ForeignPtr Map) noMap :: Maybe Map noMap = Nothing -- struct MapEntry newtype MapEntry = MapEntry (ForeignPtr MapEntry) noMapEntry :: Maybe MapEntry noMapEntry = Nothing -- struct Matrix newtype Matrix = Matrix (ForeignPtr Matrix) noMatrix :: Maybe Matrix noMatrix = Nothing foreign import ccall "pango_matrix_get_type" c_pango_matrix_get_type :: IO GType instance BoxedObject Matrix where boxedType _ = c_pango_matrix_get_type matrixReadXx :: Matrix -> IO Double matrixReadXx s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CDouble let val' = realToFrac val return val' matrixReadXy :: Matrix -> IO Double matrixReadXy s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CDouble let val' = realToFrac val return val' matrixReadYx :: Matrix -> IO Double matrixReadYx s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CDouble let val' = realToFrac val return val' matrixReadYy :: Matrix -> IO Double matrixReadYy s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO CDouble let val' = realToFrac val return val' matrixReadX0 :: Matrix -> IO Double matrixReadX0 s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO CDouble let val' = realToFrac val return val' matrixReadY0 :: Matrix -> IO Double matrixReadY0 s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO CDouble let val' = realToFrac val return val' -- method Matrix::concat -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_matrix", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_matrix", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_matrix_concat" pango_matrix_concat :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" Ptr Matrix -> -- new_matrix : TInterface "Pango" "Matrix" IO () matrixConcat :: (MonadIO m) => Matrix -> -- _obj Matrix -> -- new_matrix m () matrixConcat _obj new_matrix = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let new_matrix' = unsafeManagedPtrGetPtr new_matrix pango_matrix_concat _obj' new_matrix' touchManagedPtr _obj touchManagedPtr new_matrix return () -- method Matrix::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Matrix" -- throws : False -- Skip return : False foreign import ccall "pango_matrix_copy" pango_matrix_copy :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" IO (Ptr Matrix) matrixCopy :: (MonadIO m) => Matrix -> -- _obj m Matrix matrixCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_matrix_copy _obj' checkUnexpectedReturnNULL "pango_matrix_copy" result result' <- (wrapBoxed Matrix) result touchManagedPtr _obj return result' -- method Matrix::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_matrix_free" pango_matrix_free :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" IO () matrixFree :: (MonadIO m) => Matrix -> -- _obj m () matrixFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_matrix_free _obj' touchManagedPtr _obj return () -- method Matrix::get_font_scale_factor -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "pango_matrix_get_font_scale_factor" pango_matrix_get_font_scale_factor :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" IO CDouble matrixGetFontScaleFactor :: (MonadIO m) => Matrix -> -- _obj m Double matrixGetFontScaleFactor _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_matrix_get_font_scale_factor _obj' let result' = realToFrac result touchManagedPtr _obj return result' -- method Matrix::rotate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "degrees", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "degrees", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_matrix_rotate" pango_matrix_rotate :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" CDouble -> -- degrees : TBasicType TDouble IO () matrixRotate :: (MonadIO m) => Matrix -> -- _obj Double -> -- degrees m () matrixRotate _obj degrees = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let degrees' = realToFrac degrees pango_matrix_rotate _obj' degrees' touchManagedPtr _obj return () -- method Matrix::scale -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scale_x", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scale_y", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scale_x", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scale_y", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_matrix_scale" pango_matrix_scale :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" CDouble -> -- scale_x : TBasicType TDouble CDouble -> -- scale_y : TBasicType TDouble IO () matrixScale :: (MonadIO m) => Matrix -> -- _obj Double -> -- scale_x Double -> -- scale_y m () matrixScale _obj scale_x scale_y = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let scale_x' = realToFrac scale_x let scale_y' = realToFrac scale_y pango_matrix_scale _obj' scale_x' scale_y' touchManagedPtr _obj return () -- method Matrix::transform_distance -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dx", argType = TBasicType TDouble, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "dy", argType = TBasicType TDouble, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dx", argType = TBasicType TDouble, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "dy", argType = TBasicType TDouble, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_matrix_transform_distance" pango_matrix_transform_distance :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" Ptr CDouble -> -- dx : TBasicType TDouble Ptr CDouble -> -- dy : TBasicType TDouble IO () matrixTransformDistance :: (MonadIO m) => Matrix -> -- _obj Double -> -- dx Double -> -- dy m (Double,Double) matrixTransformDistance _obj dx dy = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let dx' = realToFrac dx dx'' <- allocMem :: IO (Ptr CDouble) poke dx'' dx' let dy' = realToFrac dy dy'' <- allocMem :: IO (Ptr CDouble) poke dy'' dy' pango_matrix_transform_distance _obj' dx'' dy'' dx''' <- peek dx'' let dx'''' = realToFrac dx''' dy''' <- peek dy'' let dy'''' = realToFrac dy''' touchManagedPtr _obj freeMem dx'' freeMem dy'' return (dx'''', dy'''') -- XXX Could not generate method Matrix::transform_pixel_rectangle -- Error was : Not implemented: "Nullable inout structs not supported" -- method Matrix::transform_point -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TDouble, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TDouble, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TDouble, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TDouble, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_matrix_transform_point" pango_matrix_transform_point :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" Ptr CDouble -> -- x : TBasicType TDouble Ptr CDouble -> -- y : TBasicType TDouble IO () matrixTransformPoint :: (MonadIO m) => Matrix -> -- _obj Double -> -- x Double -> -- y m (Double,Double) matrixTransformPoint _obj x y = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let x' = realToFrac x x'' <- allocMem :: IO (Ptr CDouble) poke x'' x' let y' = realToFrac y y'' <- allocMem :: IO (Ptr CDouble) poke y'' y' pango_matrix_transform_point _obj' x'' y'' x''' <- peek x'' let x'''' = realToFrac x''' y''' <- peek y'' let y'''' = realToFrac y''' touchManagedPtr _obj freeMem x'' freeMem y'' return (x'''', y'''') -- XXX Could not generate method Matrix::transform_rectangle -- Error was : Not implemented: "Nullable inout structs not supported" -- method Matrix::translate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tx", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ty", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tx", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "ty", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_matrix_translate" pango_matrix_translate :: Ptr Matrix -> -- _obj : TInterface "Pango" "Matrix" CDouble -> -- tx : TBasicType TDouble CDouble -> -- ty : TBasicType TDouble IO () matrixTranslate :: (MonadIO m) => Matrix -> -- _obj Double -> -- tx Double -> -- ty m () matrixTranslate _obj tx ty = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let tx' = realToFrac tx let ty' = realToFrac ty pango_matrix_translate _obj' tx' ty' touchManagedPtr _obj return () -- struct Rectangle newtype Rectangle = Rectangle (ForeignPtr Rectangle) noRectangle :: Maybe Rectangle noRectangle = Nothing rectangleReadX :: Rectangle -> IO Int32 rectangleReadX s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val rectangleReadY :: Rectangle -> IO Int32 rectangleReadY s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Int32 return val rectangleReadWidth :: Rectangle -> IO Int32 rectangleReadWidth s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int32 return val rectangleReadHeight :: Rectangle -> IO Int32 rectangleReadHeight s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Int32 return val -- Enum RenderPart data RenderPart = RenderPartForeground | RenderPartBackground | RenderPartUnderline | RenderPartStrikethrough | AnotherRenderPart Int deriving (Show, Eq) instance Enum RenderPart where fromEnum RenderPartForeground = 0 fromEnum RenderPartBackground = 1 fromEnum RenderPartUnderline = 2 fromEnum RenderPartStrikethrough = 3 fromEnum (AnotherRenderPart k) = k toEnum 0 = RenderPartForeground toEnum 1 = RenderPartBackground toEnum 2 = RenderPartUnderline toEnum 3 = RenderPartStrikethrough toEnum k = AnotherRenderPart k foreign import ccall "pango_render_part_get_type" c_pango_render_part_get_type :: IO GType instance BoxedEnum RenderPart where boxedEnumType _ = c_pango_render_part_get_type -- object Renderer newtype Renderer = Renderer (ForeignPtr Renderer) noRenderer :: Maybe Renderer noRenderer = Nothing foreign import ccall "pango_renderer_get_type" c_pango_renderer_get_type :: IO GType type instance ParentTypes Renderer = '[GObject.Object] instance GObject Renderer where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_pango_renderer_get_type class GObject o => RendererK o instance (GObject o, IsDescendantOf Renderer o) => RendererK o toRenderer :: RendererK o => o -> IO Renderer toRenderer = unsafeCastTo Renderer -- method Renderer::activate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_activate" pango_renderer_activate :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" IO () rendererActivate :: (MonadIO m, RendererK a) => a -> -- _obj m () rendererActivate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_renderer_activate _obj' touchManagedPtr _obj return () -- method Renderer::deactivate -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_deactivate" pango_renderer_deactivate :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" IO () rendererDeactivate :: (MonadIO m, RendererK a) => a -> -- _obj m () rendererDeactivate _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_renderer_deactivate _obj' touchManagedPtr _obj return () -- method Renderer::draw_error_underline -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_draw_error_underline" pango_renderer_draw_error_underline :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" Int32 -> -- x : TBasicType TInt32 Int32 -> -- y : TBasicType TInt32 Int32 -> -- width : TBasicType TInt32 Int32 -> -- height : TBasicType TInt32 IO () rendererDrawErrorUnderline :: (MonadIO m, RendererK a) => a -> -- _obj Int32 -> -- x Int32 -> -- y Int32 -> -- width Int32 -> -- height m () rendererDrawErrorUnderline _obj x y width height = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj pango_renderer_draw_error_underline _obj' x y width height touchManagedPtr _obj return () -- method Renderer::draw_glyph -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_draw_glyph" pango_renderer_draw_glyph :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" Ptr Font -> -- font : TInterface "Pango" "Font" Word32 -> -- glyph : TBasicType TUInt32 CDouble -> -- x : TBasicType TDouble CDouble -> -- y : TBasicType TDouble IO () rendererDrawGlyph :: (MonadIO m, RendererK a, FontK b) => a -> -- _obj b -> -- font Word32 -> -- glyph Double -> -- x Double -> -- y m () rendererDrawGlyph _obj font glyph x y = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let font' = unsafeManagedPtrCastPtr font let x' = realToFrac x let y' = realToFrac y pango_renderer_draw_glyph _obj' font' glyph x' y' touchManagedPtr _obj touchManagedPtr font return () -- method Renderer::draw_glyph_item -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph_item", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyph_item", argType = TInterface "Pango" "GlyphItem", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_draw_glyph_item" pango_renderer_draw_glyph_item :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" CString -> -- text : TBasicType TUTF8 Ptr GlyphItem -> -- glyph_item : TInterface "Pango" "GlyphItem" Int32 -> -- x : TBasicType TInt32 Int32 -> -- y : TBasicType TInt32 IO () rendererDrawGlyphItem :: (MonadIO m, RendererK a) => a -> -- _obj Maybe (T.Text) -> -- text GlyphItem -> -- glyph_item Int32 -> -- x Int32 -> -- y m () rendererDrawGlyphItem _obj text glyph_item x y = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeText <- case text of Nothing -> return nullPtr Just jText -> do jText' <- textToCString jText return jText' let glyph_item' = unsafeManagedPtrGetPtr glyph_item pango_renderer_draw_glyph_item _obj' maybeText glyph_item' x y touchManagedPtr _obj touchManagedPtr glyph_item freeMem maybeText return () -- method Renderer::draw_glyphs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyphs", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font", argType = TInterface "Pango" "Font", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyphs", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_draw_glyphs" pango_renderer_draw_glyphs :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" Ptr Font -> -- font : TInterface "Pango" "Font" Ptr GlyphString -> -- glyphs : TInterface "Pango" "GlyphString" Int32 -> -- x : TBasicType TInt32 Int32 -> -- y : TBasicType TInt32 IO () rendererDrawGlyphs :: (MonadIO m, RendererK a, FontK b) => a -> -- _obj b -> -- font GlyphString -> -- glyphs Int32 -> -- x Int32 -> -- y m () rendererDrawGlyphs _obj font glyphs x y = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let font' = unsafeManagedPtrCastPtr font let glyphs' = unsafeManagedPtrGetPtr glyphs pango_renderer_draw_glyphs _obj' font' glyphs' x y touchManagedPtr _obj touchManagedPtr font touchManagedPtr glyphs return () -- method Renderer::draw_layout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "layout", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "layout", argType = TInterface "Pango" "Layout", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_draw_layout" pango_renderer_draw_layout :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" Ptr Layout -> -- layout : TInterface "Pango" "Layout" Int32 -> -- x : TBasicType TInt32 Int32 -> -- y : TBasicType TInt32 IO () rendererDrawLayout :: (MonadIO m, RendererK a, LayoutK b) => a -> -- _obj b -> -- layout Int32 -> -- x Int32 -> -- y m () rendererDrawLayout _obj layout x y = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let layout' = unsafeManagedPtrCastPtr layout pango_renderer_draw_layout _obj' layout' x y touchManagedPtr _obj touchManagedPtr layout return () -- method Renderer::draw_layout_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "line", argType = TInterface "Pango" "LayoutLine", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_draw_layout_line" pango_renderer_draw_layout_line :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" Ptr LayoutLine -> -- line : TInterface "Pango" "LayoutLine" Int32 -> -- x : TBasicType TInt32 Int32 -> -- y : TBasicType TInt32 IO () rendererDrawLayoutLine :: (MonadIO m, RendererK a) => a -> -- _obj LayoutLine -> -- line Int32 -> -- x Int32 -> -- y m () rendererDrawLayoutLine _obj line x y = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let line' = unsafeManagedPtrGetPtr line pango_renderer_draw_layout_line _obj' line' x y touchManagedPtr _obj touchManagedPtr line return () -- method Renderer::draw_rectangle -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "height", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_draw_rectangle" pango_renderer_draw_rectangle :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" CUInt -> -- part : TInterface "Pango" "RenderPart" Int32 -> -- x : TBasicType TInt32 Int32 -> -- y : TBasicType TInt32 Int32 -> -- width : TBasicType TInt32 Int32 -> -- height : TBasicType TInt32 IO () rendererDrawRectangle :: (MonadIO m, RendererK a) => a -> -- _obj RenderPart -> -- part Int32 -> -- x Int32 -> -- y Int32 -> -- width Int32 -> -- height m () rendererDrawRectangle _obj part x y width height = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let part' = (fromIntegral . fromEnum) part pango_renderer_draw_rectangle _obj' part' x y width height touchManagedPtr _obj return () -- method Renderer::draw_trapezoid -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y1_", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x11", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x21", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y2", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x12", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x22", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y1_", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x11", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x21", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y2", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x12", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x22", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_draw_trapezoid" pango_renderer_draw_trapezoid :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" CUInt -> -- part : TInterface "Pango" "RenderPart" CDouble -> -- y1_ : TBasicType TDouble CDouble -> -- x11 : TBasicType TDouble CDouble -> -- x21 : TBasicType TDouble CDouble -> -- y2 : TBasicType TDouble CDouble -> -- x12 : TBasicType TDouble CDouble -> -- x22 : TBasicType TDouble IO () rendererDrawTrapezoid :: (MonadIO m, RendererK a) => a -> -- _obj RenderPart -> -- part Double -> -- y1_ Double -> -- x11 Double -> -- x21 Double -> -- y2 Double -> -- x12 Double -> -- x22 m () rendererDrawTrapezoid _obj part y1_ x11 x21 y2 x12 x22 = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let part' = (fromIntegral . fromEnum) part let y1_' = realToFrac y1_ let x11' = realToFrac x11 let x21' = realToFrac x21 let y2' = realToFrac y2 let x12' = realToFrac x12 let x22' = realToFrac x22 pango_renderer_draw_trapezoid _obj' part' y1_' x11' x21' y2' x12' x22' touchManagedPtr _obj return () -- method Renderer::get_color -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Color" -- throws : False -- Skip return : False foreign import ccall "pango_renderer_get_color" pango_renderer_get_color :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" CUInt -> -- part : TInterface "Pango" "RenderPart" IO (Ptr Color) rendererGetColor :: (MonadIO m, RendererK a) => a -> -- _obj RenderPart -> -- part m Color rendererGetColor _obj part = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let part' = (fromIntegral . fromEnum) part result <- pango_renderer_get_color _obj' part' checkUnexpectedReturnNULL "pango_renderer_get_color" result result' <- (newBoxed Color) result touchManagedPtr _obj return result' -- method Renderer::get_layout -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Layout" -- throws : False -- Skip return : False foreign import ccall "pango_renderer_get_layout" pango_renderer_get_layout :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" IO (Ptr Layout) rendererGetLayout :: (MonadIO m, RendererK a) => a -> -- _obj m Layout rendererGetLayout _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_renderer_get_layout _obj' checkUnexpectedReturnNULL "pango_renderer_get_layout" result result' <- (newObject Layout) result touchManagedPtr _obj return result' -- method Renderer::get_layout_line -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "LayoutLine" -- throws : False -- Skip return : False foreign import ccall "pango_renderer_get_layout_line" pango_renderer_get_layout_line :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" IO (Ptr LayoutLine) rendererGetLayoutLine :: (MonadIO m, RendererK a) => a -> -- _obj m LayoutLine rendererGetLayoutLine _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_renderer_get_layout_line _obj' checkUnexpectedReturnNULL "pango_renderer_get_layout_line" result result' <- (newBoxed LayoutLine) result touchManagedPtr _obj return result' -- method Renderer::get_matrix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Matrix" -- throws : False -- Skip return : False foreign import ccall "pango_renderer_get_matrix" pango_renderer_get_matrix :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" IO (Ptr Matrix) rendererGetMatrix :: (MonadIO m, RendererK a) => a -> -- _obj m Matrix rendererGetMatrix _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- pango_renderer_get_matrix _obj' checkUnexpectedReturnNULL "pango_renderer_get_matrix" result result' <- (newBoxed Matrix) result touchManagedPtr _obj return result' -- method Renderer::part_changed -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_part_changed" pango_renderer_part_changed :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" CUInt -> -- part : TInterface "Pango" "RenderPart" IO () rendererPartChanged :: (MonadIO m, RendererK a) => a -> -- _obj RenderPart -> -- part m () rendererPartChanged _obj part = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let part' = (fromIntegral . fromEnum) part pango_renderer_part_changed _obj' part' touchManagedPtr _obj return () -- method Renderer::set_color -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "color", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "part", argType = TInterface "Pango" "RenderPart", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "color", argType = TInterface "Pango" "Color", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_set_color" pango_renderer_set_color :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" CUInt -> -- part : TInterface "Pango" "RenderPart" Ptr Color -> -- color : TInterface "Pango" "Color" IO () rendererSetColor :: (MonadIO m, RendererK a) => a -> -- _obj RenderPart -> -- part Maybe (Color) -> -- color m () rendererSetColor _obj part color = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let part' = (fromIntegral . fromEnum) part maybeColor <- case color of Nothing -> return nullPtr Just jColor -> do let jColor' = unsafeManagedPtrGetPtr jColor return jColor' pango_renderer_set_color _obj' part' maybeColor touchManagedPtr _obj whenJust color touchManagedPtr return () -- method Renderer::set_matrix -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "matrix", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "Renderer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "matrix", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_renderer_set_matrix" pango_renderer_set_matrix :: Ptr Renderer -> -- _obj : TInterface "Pango" "Renderer" Ptr Matrix -> -- matrix : TInterface "Pango" "Matrix" IO () rendererSetMatrix :: (MonadIO m, RendererK a) => a -> -- _obj Maybe (Matrix) -> -- matrix m () rendererSetMatrix _obj matrix = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeMatrix <- case matrix of Nothing -> return nullPtr Just jMatrix -> do let jMatrix' = unsafeManagedPtrGetPtr jMatrix return jMatrix' pango_renderer_set_matrix _obj' maybeMatrix touchManagedPtr _obj whenJust matrix touchManagedPtr return () -- Enum Script data Script = ScriptInvalidCode | ScriptCommon | ScriptInherited | ScriptArabic | ScriptArmenian | ScriptBengali | ScriptBopomofo | ScriptCherokee | ScriptCoptic | ScriptCyrillic | ScriptDeseret | ScriptDevanagari | ScriptEthiopic | ScriptGeorgian | ScriptGothic | ScriptGreek | ScriptGujarati | ScriptGurmukhi | ScriptHan | ScriptHangul | ScriptHebrew | ScriptHiragana | ScriptKannada | ScriptKatakana | ScriptKhmer | ScriptLao | ScriptLatin | ScriptMalayalam | ScriptMongolian | ScriptMyanmar | ScriptOgham | ScriptOldItalic | ScriptOriya | ScriptRunic | ScriptSinhala | ScriptSyriac | ScriptTamil | ScriptTelugu | ScriptThaana | ScriptThai | ScriptTibetan | ScriptCanadianAboriginal | ScriptYi | ScriptTagalog | ScriptHanunoo | ScriptBuhid | ScriptTagbanwa | ScriptBraille | ScriptCypriot | ScriptLimbu | ScriptOsmanya | ScriptShavian | ScriptLinearB | ScriptTaiLe | ScriptUgaritic | ScriptNewTaiLue | ScriptBuginese | ScriptGlagolitic | ScriptTifinagh | ScriptSylotiNagri | ScriptOldPersian | ScriptKharoshthi | ScriptUnknown | ScriptBalinese | ScriptCuneiform | ScriptPhoenician | ScriptPhagsPa | ScriptNko | ScriptKayahLi | ScriptLepcha | ScriptRejang | ScriptSundanese | ScriptSaurashtra | ScriptCham | ScriptOlChiki | ScriptVai | ScriptCarian | ScriptLycian | ScriptLydian | ScriptBatak | ScriptBrahmi | ScriptMandaic | ScriptChakma | ScriptMeroiticCursive | ScriptMeroiticHieroglyphs | ScriptMiao | ScriptSharada | ScriptSoraSompeng | ScriptTakri | AnotherScript Int deriving (Show, Eq) instance Enum Script where fromEnum ScriptInvalidCode = -1 fromEnum ScriptCommon = 0 fromEnum ScriptInherited = 1 fromEnum ScriptArabic = 2 fromEnum ScriptArmenian = 3 fromEnum ScriptBengali = 4 fromEnum ScriptBopomofo = 5 fromEnum ScriptCherokee = 6 fromEnum ScriptCoptic = 7 fromEnum ScriptCyrillic = 8 fromEnum ScriptDeseret = 9 fromEnum ScriptDevanagari = 10 fromEnum ScriptEthiopic = 11 fromEnum ScriptGeorgian = 12 fromEnum ScriptGothic = 13 fromEnum ScriptGreek = 14 fromEnum ScriptGujarati = 15 fromEnum ScriptGurmukhi = 16 fromEnum ScriptHan = 17 fromEnum ScriptHangul = 18 fromEnum ScriptHebrew = 19 fromEnum ScriptHiragana = 20 fromEnum ScriptKannada = 21 fromEnum ScriptKatakana = 22 fromEnum ScriptKhmer = 23 fromEnum ScriptLao = 24 fromEnum ScriptLatin = 25 fromEnum ScriptMalayalam = 26 fromEnum ScriptMongolian = 27 fromEnum ScriptMyanmar = 28 fromEnum ScriptOgham = 29 fromEnum ScriptOldItalic = 30 fromEnum ScriptOriya = 31 fromEnum ScriptRunic = 32 fromEnum ScriptSinhala = 33 fromEnum ScriptSyriac = 34 fromEnum ScriptTamil = 35 fromEnum ScriptTelugu = 36 fromEnum ScriptThaana = 37 fromEnum ScriptThai = 38 fromEnum ScriptTibetan = 39 fromEnum ScriptCanadianAboriginal = 40 fromEnum ScriptYi = 41 fromEnum ScriptTagalog = 42 fromEnum ScriptHanunoo = 43 fromEnum ScriptBuhid = 44 fromEnum ScriptTagbanwa = 45 fromEnum ScriptBraille = 46 fromEnum ScriptCypriot = 47 fromEnum ScriptLimbu = 48 fromEnum ScriptOsmanya = 49 fromEnum ScriptShavian = 50 fromEnum ScriptLinearB = 51 fromEnum ScriptTaiLe = 52 fromEnum ScriptUgaritic = 53 fromEnum ScriptNewTaiLue = 54 fromEnum ScriptBuginese = 55 fromEnum ScriptGlagolitic = 56 fromEnum ScriptTifinagh = 57 fromEnum ScriptSylotiNagri = 58 fromEnum ScriptOldPersian = 59 fromEnum ScriptKharoshthi = 60 fromEnum ScriptUnknown = 61 fromEnum ScriptBalinese = 62 fromEnum ScriptCuneiform = 63 fromEnum ScriptPhoenician = 64 fromEnum ScriptPhagsPa = 65 fromEnum ScriptNko = 66 fromEnum ScriptKayahLi = 67 fromEnum ScriptLepcha = 68 fromEnum ScriptRejang = 69 fromEnum ScriptSundanese = 70 fromEnum ScriptSaurashtra = 71 fromEnum ScriptCham = 72 fromEnum ScriptOlChiki = 73 fromEnum ScriptVai = 74 fromEnum ScriptCarian = 75 fromEnum ScriptLycian = 76 fromEnum ScriptLydian = 77 fromEnum ScriptBatak = 78 fromEnum ScriptBrahmi = 79 fromEnum ScriptMandaic = 80 fromEnum ScriptChakma = 81 fromEnum ScriptMeroiticCursive = 82 fromEnum ScriptMeroiticHieroglyphs = 83 fromEnum ScriptMiao = 84 fromEnum ScriptSharada = 85 fromEnum ScriptSoraSompeng = 86 fromEnum ScriptTakri = 87 fromEnum (AnotherScript k) = k toEnum -1 = ScriptInvalidCode toEnum 0 = ScriptCommon toEnum 1 = ScriptInherited toEnum 2 = ScriptArabic toEnum 3 = ScriptArmenian toEnum 4 = ScriptBengali toEnum 5 = ScriptBopomofo toEnum 6 = ScriptCherokee toEnum 7 = ScriptCoptic toEnum 8 = ScriptCyrillic toEnum 9 = ScriptDeseret toEnum 10 = ScriptDevanagari toEnum 11 = ScriptEthiopic toEnum 12 = ScriptGeorgian toEnum 13 = ScriptGothic toEnum 14 = ScriptGreek toEnum 15 = ScriptGujarati toEnum 16 = ScriptGurmukhi toEnum 17 = ScriptHan toEnum 18 = ScriptHangul toEnum 19 = ScriptHebrew toEnum 20 = ScriptHiragana toEnum 21 = ScriptKannada toEnum 22 = ScriptKatakana toEnum 23 = ScriptKhmer toEnum 24 = ScriptLao toEnum 25 = ScriptLatin toEnum 26 = ScriptMalayalam toEnum 27 = ScriptMongolian toEnum 28 = ScriptMyanmar toEnum 29 = ScriptOgham toEnum 30 = ScriptOldItalic toEnum 31 = ScriptOriya toEnum 32 = ScriptRunic toEnum 33 = ScriptSinhala toEnum 34 = ScriptSyriac toEnum 35 = ScriptTamil toEnum 36 = ScriptTelugu toEnum 37 = ScriptThaana toEnum 38 = ScriptThai toEnum 39 = ScriptTibetan toEnum 40 = ScriptCanadianAboriginal toEnum 41 = ScriptYi toEnum 42 = ScriptTagalog toEnum 43 = ScriptHanunoo toEnum 44 = ScriptBuhid toEnum 45 = ScriptTagbanwa toEnum 46 = ScriptBraille toEnum 47 = ScriptCypriot toEnum 48 = ScriptLimbu toEnum 49 = ScriptOsmanya toEnum 50 = ScriptShavian toEnum 51 = ScriptLinearB toEnum 52 = ScriptTaiLe toEnum 53 = ScriptUgaritic toEnum 54 = ScriptNewTaiLue toEnum 55 = ScriptBuginese toEnum 56 = ScriptGlagolitic toEnum 57 = ScriptTifinagh toEnum 58 = ScriptSylotiNagri toEnum 59 = ScriptOldPersian toEnum 60 = ScriptKharoshthi toEnum 61 = ScriptUnknown toEnum 62 = ScriptBalinese toEnum 63 = ScriptCuneiform toEnum 64 = ScriptPhoenician toEnum 65 = ScriptPhagsPa toEnum 66 = ScriptNko toEnum 67 = ScriptKayahLi toEnum 68 = ScriptLepcha toEnum 69 = ScriptRejang toEnum 70 = ScriptSundanese toEnum 71 = ScriptSaurashtra toEnum 72 = ScriptCham toEnum 73 = ScriptOlChiki toEnum 74 = ScriptVai toEnum 75 = ScriptCarian toEnum 76 = ScriptLycian toEnum 77 = ScriptLydian toEnum 78 = ScriptBatak toEnum 79 = ScriptBrahmi toEnum 80 = ScriptMandaic toEnum 81 = ScriptChakma toEnum 82 = ScriptMeroiticCursive toEnum 83 = ScriptMeroiticHieroglyphs toEnum 84 = ScriptMiao toEnum 85 = ScriptSharada toEnum 86 = ScriptSoraSompeng toEnum 87 = ScriptTakri toEnum k = AnotherScript k foreign import ccall "pango_script_get_type" c_pango_script_get_type :: IO GType instance BoxedEnum Script where boxedEnumType _ = c_pango_script_get_type -- struct ScriptForLang newtype ScriptForLang = ScriptForLang (ForeignPtr ScriptForLang) noScriptForLang :: Maybe ScriptForLang noScriptForLang = Nothing -- XXX Skipped getter for "ScriptForLang:lang" :: Not implemented: "Don't know how to unpack C array of type TCArray False 7 (-1) (TBasicType TInt8)" -- XXX Skipped getter for "ScriptForLang:scripts" :: Not implemented: "Don't know how to unpack C array of type TCArray False 3 (-1) (TInterface \"Pango\" \"Script\")" -- struct ScriptIter newtype ScriptIter = ScriptIter (ForeignPtr ScriptIter) noScriptIter :: Maybe ScriptIter noScriptIter = Nothing -- method ScriptIter::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "ScriptIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "ScriptIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_script_iter_free" pango_script_iter_free :: Ptr ScriptIter -> -- _obj : TInterface "Pango" "ScriptIter" IO () scriptIterFree :: (MonadIO m) => ScriptIter -> -- _obj m () scriptIterFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_script_iter_free _obj' touchManagedPtr _obj return () -- method ScriptIter::get_range -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "ScriptIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "ScriptIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_script_iter_get_range" pango_script_iter_get_range :: Ptr ScriptIter -> -- _obj : TInterface "Pango" "ScriptIter" Ptr CString -> -- start : TBasicType TUTF8 Ptr CString -> -- end : TBasicType TUTF8 Ptr CUInt -> -- script : TInterface "Pango" "Script" IO () scriptIterGetRange :: (MonadIO m) => ScriptIter -> -- _obj m (T.Text,T.Text,Script) scriptIterGetRange _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj start <- allocMem :: IO (Ptr CString) end <- allocMem :: IO (Ptr CString) script <- allocMem :: IO (Ptr CUInt) pango_script_iter_get_range _obj' start end script start' <- peek start start'' <- cstringToText start' freeMem start' end' <- peek end end'' <- cstringToText end' freeMem end' script' <- peek script let script'' = (toEnum . fromIntegral) script' touchManagedPtr _obj freeMem start freeMem end freeMem script return (start'', end'', script'') -- method ScriptIter::next -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "ScriptIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "ScriptIter", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_script_iter_next" pango_script_iter_next :: Ptr ScriptIter -> -- _obj : TInterface "Pango" "ScriptIter" IO CInt scriptIterNext :: (MonadIO m) => ScriptIter -> -- _obj m Bool scriptIterNext _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_script_iter_next _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- Enum Stretch data Stretch = StretchUltraCondensed | StretchExtraCondensed | StretchCondensed | StretchSemiCondensed | StretchNormal | StretchSemiExpanded | StretchExpanded | StretchExtraExpanded | StretchUltraExpanded | AnotherStretch Int deriving (Show, Eq) instance Enum Stretch where fromEnum StretchUltraCondensed = 0 fromEnum StretchExtraCondensed = 1 fromEnum StretchCondensed = 2 fromEnum StretchSemiCondensed = 3 fromEnum StretchNormal = 4 fromEnum StretchSemiExpanded = 5 fromEnum StretchExpanded = 6 fromEnum StretchExtraExpanded = 7 fromEnum StretchUltraExpanded = 8 fromEnum (AnotherStretch k) = k toEnum 0 = StretchUltraCondensed toEnum 1 = StretchExtraCondensed toEnum 2 = StretchCondensed toEnum 3 = StretchSemiCondensed toEnum 4 = StretchNormal toEnum 5 = StretchSemiExpanded toEnum 6 = StretchExpanded toEnum 7 = StretchExtraExpanded toEnum 8 = StretchUltraExpanded toEnum k = AnotherStretch k foreign import ccall "pango_stretch_get_type" c_pango_stretch_get_type :: IO GType instance BoxedEnum Stretch where boxedEnumType _ = c_pango_stretch_get_type -- Enum Style data Style = StyleNormal | StyleOblique | StyleItalic | AnotherStyle Int deriving (Show, Eq) instance Enum Style where fromEnum StyleNormal = 0 fromEnum StyleOblique = 1 fromEnum StyleItalic = 2 fromEnum (AnotherStyle k) = k toEnum 0 = StyleNormal toEnum 1 = StyleOblique toEnum 2 = StyleItalic toEnum k = AnotherStyle k foreign import ccall "pango_style_get_type" c_pango_style_get_type :: IO GType instance BoxedEnum Style where boxedEnumType _ = c_pango_style_get_type -- Enum TabAlign data TabAlign = TabAlignLeft | AnotherTabAlign Int deriving (Show, Eq) instance Enum TabAlign where fromEnum TabAlignLeft = 0 fromEnum (AnotherTabAlign k) = k toEnum 0 = TabAlignLeft toEnum k = AnotherTabAlign k foreign import ccall "pango_tab_align_get_type" c_pango_tab_align_get_type :: IO GType instance BoxedEnum TabAlign where boxedEnumType _ = c_pango_tab_align_get_type -- struct TabArray newtype TabArray = TabArray (ForeignPtr TabArray) noTabArray :: Maybe TabArray noTabArray = Nothing foreign import ccall "pango_tab_array_get_type" c_pango_tab_array_get_type :: IO GType instance BoxedObject TabArray where boxedType _ = c_pango_tab_array_get_type -- method TabArray::new -- method type : Constructor -- Args : [Arg {argName = "initial_size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "positions_in_pixels", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "initial_size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "positions_in_pixels", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "TabArray" -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_new" pango_tab_array_new :: Int32 -> -- initial_size : TBasicType TInt32 CInt -> -- positions_in_pixels : TBasicType TBoolean IO (Ptr TabArray) tabArrayNew :: (MonadIO m) => Int32 -> -- initial_size Bool -> -- positions_in_pixels m TabArray tabArrayNew initial_size positions_in_pixels = liftIO $ do let positions_in_pixels' = (fromIntegral . fromEnum) positions_in_pixels result <- pango_tab_array_new initial_size positions_in_pixels' checkUnexpectedReturnNULL "pango_tab_array_new" result result' <- (wrapBoxed TabArray) result return result' -- method TabArray::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "TabArray" -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_copy" pango_tab_array_copy :: Ptr TabArray -> -- _obj : TInterface "Pango" "TabArray" IO (Ptr TabArray) tabArrayCopy :: (MonadIO m) => TabArray -> -- _obj m TabArray tabArrayCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_tab_array_copy _obj' checkUnexpectedReturnNULL "pango_tab_array_copy" result result' <- (wrapBoxed TabArray) result touchManagedPtr _obj return result' -- method TabArray::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_free" pango_tab_array_free :: Ptr TabArray -> -- _obj : TInterface "Pango" "TabArray" IO () tabArrayFree :: (MonadIO m) => TabArray -> -- _obj m () tabArrayFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_tab_array_free _obj' touchManagedPtr _obj return () -- method TabArray::get_positions_in_pixels -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_get_positions_in_pixels" pango_tab_array_get_positions_in_pixels :: Ptr TabArray -> -- _obj : TInterface "Pango" "TabArray" IO CInt tabArrayGetPositionsInPixels :: (MonadIO m) => TabArray -> -- _obj m Bool tabArrayGetPositionsInPixels _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_tab_array_get_positions_in_pixels _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method TabArray::get_size -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_get_size" pango_tab_array_get_size :: Ptr TabArray -> -- _obj : TInterface "Pango" "TabArray" IO Int32 tabArrayGetSize :: (MonadIO m) => TabArray -> -- _obj m Int32 tabArrayGetSize _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- pango_tab_array_get_size _obj' touchManagedPtr _obj return result -- method TabArray::get_tab -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "alignment", argType = TInterface "Pango" "TabAlign", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "location", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_get_tab" pango_tab_array_get_tab :: Ptr TabArray -> -- _obj : TInterface "Pango" "TabArray" Int32 -> -- tab_index : TBasicType TInt32 Ptr CUInt -> -- alignment : TInterface "Pango" "TabAlign" Ptr Int32 -> -- location : TBasicType TInt32 IO () tabArrayGetTab :: (MonadIO m) => TabArray -> -- _obj Int32 -> -- tab_index m (TabAlign,Int32) tabArrayGetTab _obj tab_index = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj alignment <- allocMem :: IO (Ptr CUInt) location <- allocMem :: IO (Ptr Int32) pango_tab_array_get_tab _obj' tab_index alignment location alignment' <- peek alignment let alignment'' = (toEnum . fromIntegral) alignment' location' <- peek location touchManagedPtr _obj freeMem alignment freeMem location return (alignment'', location') -- method TabArray::get_tabs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "alignments", argType = TInterface "Pango" "TabAlign", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "locations", argType = TCArray False (-1) (-1) (TBasicType TInt32), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_get_tabs" pango_tab_array_get_tabs :: Ptr TabArray -> -- _obj : TInterface "Pango" "TabArray" Ptr CUInt -> -- alignments : TInterface "Pango" "TabAlign" Ptr (Ptr Int32) -> -- locations : TCArray False (-1) (-1) (TBasicType TInt32) IO () tabArrayGetTabs :: (MonadIO m) => TabArray -> -- _obj m (TabAlign,(Ptr Int32)) tabArrayGetTabs _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj alignments <- allocMem :: IO (Ptr CUInt) locations <- allocMem :: IO (Ptr (Ptr Int32)) pango_tab_array_get_tabs _obj' alignments locations alignments' <- peek alignments let alignments'' = (toEnum . fromIntegral) alignments' locations' <- peek locations touchManagedPtr _obj freeMem alignments freeMem locations return (alignments'', locations') -- method TabArray::resize -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "new_size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_resize" pango_tab_array_resize :: Ptr TabArray -> -- _obj : TInterface "Pango" "TabArray" Int32 -> -- new_size : TBasicType TInt32 IO () tabArrayResize :: (MonadIO m) => TabArray -> -- _obj Int32 -> -- new_size m () tabArrayResize _obj new_size = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj pango_tab_array_resize _obj' new_size touchManagedPtr _obj return () -- method TabArray::set_tab -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "alignment", argType = TInterface "Pango" "TabAlign", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Pango" "TabArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "alignment", argType = TInterface "Pango" "TabAlign", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "location", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_tab_array_set_tab" pango_tab_array_set_tab :: Ptr TabArray -> -- _obj : TInterface "Pango" "TabArray" Int32 -> -- tab_index : TBasicType TInt32 CUInt -> -- alignment : TInterface "Pango" "TabAlign" Int32 -> -- location : TBasicType TInt32 IO () tabArraySetTab :: (MonadIO m) => TabArray -> -- _obj Int32 -> -- tab_index TabAlign -> -- alignment Int32 -> -- location m () tabArraySetTab _obj tab_index alignment location = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let alignment' = (fromIntegral . fromEnum) alignment pango_tab_array_set_tab _obj' tab_index alignment' location touchManagedPtr _obj return () -- Enum Underline data Underline = UnderlineNone | UnderlineSingle | UnderlineDouble | UnderlineLow | UnderlineError | AnotherUnderline Int deriving (Show, Eq) instance Enum Underline where fromEnum UnderlineNone = 0 fromEnum UnderlineSingle = 1 fromEnum UnderlineDouble = 2 fromEnum UnderlineLow = 3 fromEnum UnderlineError = 4 fromEnum (AnotherUnderline k) = k toEnum 0 = UnderlineNone toEnum 1 = UnderlineSingle toEnum 2 = UnderlineDouble toEnum 3 = UnderlineLow toEnum 4 = UnderlineError toEnum k = AnotherUnderline k foreign import ccall "pango_underline_get_type" c_pango_underline_get_type :: IO GType instance BoxedEnum Underline where boxedEnumType _ = c_pango_underline_get_type -- Enum Variant data Variant = VariantNormal | VariantSmallCaps | AnotherVariant Int deriving (Show, Eq) instance Enum Variant where fromEnum VariantNormal = 0 fromEnum VariantSmallCaps = 1 fromEnum (AnotherVariant k) = k toEnum 0 = VariantNormal toEnum 1 = VariantSmallCaps toEnum k = AnotherVariant k foreign import ccall "pango_variant_get_type" c_pango_variant_get_type :: IO GType instance BoxedEnum Variant where boxedEnumType _ = c_pango_variant_get_type -- Enum Weight data Weight = WeightThin | WeightUltralight | WeightLight | WeightSemilight | WeightBook | WeightNormal | WeightMedium | WeightSemibold | WeightBold | WeightUltrabold | WeightHeavy | WeightUltraheavy | AnotherWeight Int deriving (Show, Eq) instance Enum Weight where fromEnum WeightThin = 100 fromEnum WeightUltralight = 200 fromEnum WeightLight = 300 fromEnum WeightSemilight = 350 fromEnum WeightBook = 380 fromEnum WeightNormal = 400 fromEnum WeightMedium = 500 fromEnum WeightSemibold = 600 fromEnum WeightBold = 700 fromEnum WeightUltrabold = 800 fromEnum WeightHeavy = 900 fromEnum WeightUltraheavy = 1000 fromEnum (AnotherWeight k) = k toEnum 100 = WeightThin toEnum 200 = WeightUltralight toEnum 300 = WeightLight toEnum 350 = WeightSemilight toEnum 380 = WeightBook toEnum 400 = WeightNormal toEnum 500 = WeightMedium toEnum 600 = WeightSemibold toEnum 700 = WeightBold toEnum 800 = WeightUltrabold toEnum 900 = WeightHeavy toEnum 1000 = WeightUltraheavy toEnum k = AnotherWeight k foreign import ccall "pango_weight_get_type" c_pango_weight_get_type :: IO GType instance BoxedEnum Weight where boxedEnumType _ = c_pango_weight_get_type -- Enum WrapMode data WrapMode = WrapModeWord | WrapModeChar | WrapModeWordChar | AnotherWrapMode Int deriving (Show, Eq) instance Enum WrapMode where fromEnum WrapModeWord = 0 fromEnum WrapModeChar = 1 fromEnum WrapModeWordChar = 2 fromEnum (AnotherWrapMode k) = k toEnum 0 = WrapModeWord toEnum 1 = WrapModeChar toEnum 2 = WrapModeWordChar toEnum k = AnotherWrapMode k foreign import ccall "pango_wrap_mode_get_type" c_pango_wrap_mode_get_type :: IO GType instance BoxedEnum WrapMode where boxedEnumType _ = c_pango_wrap_mode_get_type -- constant _ANALYSIS_FLAG_CENTERED_BASELINE _ANALYSIS_FLAG_CENTERED_BASELINE :: Int32 _ANALYSIS_FLAG_CENTERED_BASELINE = 1 -- constant _ANALYSIS_FLAG_IS_ELLIPSIS _ANALYSIS_FLAG_IS_ELLIPSIS :: Int32 _ANALYSIS_FLAG_IS_ELLIPSIS = 2 -- constant _ATTR_INDEX_FROM_TEXT_BEGINNING _ATTR_INDEX_FROM_TEXT_BEGINNING :: Int32 _ATTR_INDEX_FROM_TEXT_BEGINNING = 0 -- constant _ENGINE_TYPE_LANG _ENGINE_TYPE_LANG :: T.Text _ENGINE_TYPE_LANG = "PangoEngineLang" -- constant _ENGINE_TYPE_SHAPE _ENGINE_TYPE_SHAPE :: T.Text _ENGINE_TYPE_SHAPE = "PangoEngineShape" -- constant _GLYPH_EMPTY _GLYPH_EMPTY :: Word32 _GLYPH_EMPTY = 268435455 -- constant _GLYPH_INVALID_INPUT _GLYPH_INVALID_INPUT :: Word32 _GLYPH_INVALID_INPUT = 4294967295 -- constant _GLYPH_UNKNOWN_FLAG _GLYPH_UNKNOWN_FLAG :: Word32 _GLYPH_UNKNOWN_FLAG = 268435456 -- constant _RENDER_TYPE_NONE _RENDER_TYPE_NONE :: T.Text _RENDER_TYPE_NONE = "PangoRenderNone" -- constant _SCALE _SCALE :: Int32 _SCALE = 1024 -- constant _UNKNOWN_GLYPH_HEIGHT _UNKNOWN_GLYPH_HEIGHT :: Int32 _UNKNOWN_GLYPH_HEIGHT = 14 -- constant _UNKNOWN_GLYPH_WIDTH _UNKNOWN_GLYPH_WIDTH :: Int32 _UNKNOWN_GLYPH_WIDTH = 10 -- function pango_attr_type_get_name -- Args : [Arg {argName = "type", argType = TInterface "Pango" "AttrType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TInterface "Pango" "AttrType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_attr_type_get_name" pango_attr_type_get_name :: CUInt -> -- type : TInterface "Pango" "AttrType" IO CString attrTypeGetName :: (MonadIO m) => AttrType -> -- type m T.Text attrTypeGetName type_ = liftIO $ do let type_' = (fromIntegral . fromEnum) type_ result <- pango_attr_type_get_name type_' checkUnexpectedReturnNULL "pango_attr_type_get_name" result result' <- cstringToText result return result' -- function pango_attr_type_register -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "AttrType" -- throws : False -- Skip return : False foreign import ccall "pango_attr_type_register" pango_attr_type_register :: CString -> -- name : TBasicType TUTF8 IO CUInt attrTypeRegister :: (MonadIO m) => T.Text -> -- name m AttrType attrTypeRegister name = liftIO $ do name' <- textToCString name result <- pango_attr_type_register name' let result' = (toEnum . fromIntegral) result freeMem name' return result' -- function pango_bidi_type_for_unichar -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "BidiType" -- throws : False -- Skip return : False foreign import ccall "pango_bidi_type_for_unichar" pango_bidi_type_for_unichar :: CInt -> -- ch : TBasicType TUniChar IO CUInt bidiTypeForUnichar :: (MonadIO m) => Char -> -- ch m BidiType bidiTypeForUnichar ch = liftIO $ do let ch' = (fromIntegral . ord) ch result <- pango_bidi_type_for_unichar ch' let result' = (toEnum . fromIntegral) result return result' -- function pango_break -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TCArray False (-1) 4 (TInterface "Pango" "LogAttr"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "attrs_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TCArray False (-1) 4 (TInterface "Pango" "LogAttr"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_break" pango_break :: CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 Ptr Analysis -> -- analysis : TInterface "Pango" "Analysis" Ptr LogAttr -> -- attrs : TCArray False (-1) 4 (TInterface "Pango" "LogAttr") Int32 -> -- attrs_len : TBasicType TInt32 IO () break :: (MonadIO m) => T.Text -> -- text Int32 -> -- length Analysis -> -- analysis [LogAttr] -> -- attrs m () break text length_ analysis attrs = liftIO $ do let attrs_len = fromIntegral $ length attrs text' <- textToCString text let analysis' = unsafeManagedPtrGetPtr analysis let attrs' = map unsafeManagedPtrGetPtr attrs attrs'' <- packBlockArray 52 attrs' pango_break text' length_ analysis' attrs'' attrs_len touchManagedPtr analysis mapM_ touchManagedPtr attrs freeMem text' freeMem attrs'' return () -- function pango_config_key_get -- Args : [Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_config_key_get" pango_config_key_get :: CString -> -- key : TBasicType TUTF8 IO CString configKeyGet :: (MonadIO m) => T.Text -> -- key m T.Text configKeyGet key = liftIO $ do key' <- textToCString key result <- pango_config_key_get key' checkUnexpectedReturnNULL "pango_config_key_get" result result' <- cstringToText result freeMem result freeMem key' return result' -- function pango_config_key_get_system -- Args : [Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_config_key_get_system" pango_config_key_get_system :: CString -> -- key : TBasicType TUTF8 IO CString configKeyGetSystem :: (MonadIO m) => T.Text -> -- key m T.Text configKeyGetSystem key = liftIO $ do key' <- textToCString key result <- pango_config_key_get_system key' checkUnexpectedReturnNULL "pango_config_key_get_system" result result' <- cstringToText result freeMem result freeMem key' return result' -- function pango_default_break -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "LogAttr", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "LogAttr", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_default_break" pango_default_break :: CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 Ptr Analysis -> -- analysis : TInterface "Pango" "Analysis" Ptr LogAttr -> -- attrs : TInterface "Pango" "LogAttr" Int32 -> -- attrs_len : TBasicType TInt32 IO () defaultBreak :: (MonadIO m) => T.Text -> -- text Int32 -> -- length Analysis -> -- analysis LogAttr -> -- attrs Int32 -> -- attrs_len m () defaultBreak text length_ analysis attrs attrs_len = liftIO $ do text' <- textToCString text let analysis' = unsafeManagedPtrGetPtr analysis let attrs' = unsafeManagedPtrGetPtr attrs pango_default_break text' length_ analysis' attrs' attrs_len touchManagedPtr analysis touchManagedPtr attrs freeMem text' return () -- function pango_extents_to_pixels -- Args : [Arg {argName = "inclusive", argType = TInterface "Pango" "Rectangle", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nearest", argType = TInterface "Pango" "Rectangle", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "inclusive", argType = TInterface "Pango" "Rectangle", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nearest", argType = TInterface "Pango" "Rectangle", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_extents_to_pixels" pango_extents_to_pixels :: Ptr Rectangle -> -- inclusive : TInterface "Pango" "Rectangle" Ptr Rectangle -> -- nearest : TInterface "Pango" "Rectangle" IO () extentsToPixels :: (MonadIO m) => Maybe (Rectangle) -> -- inclusive Maybe (Rectangle) -> -- nearest m () extentsToPixels inclusive nearest = liftIO $ do maybeInclusive <- case inclusive of Nothing -> return nullPtr Just jInclusive -> do let jInclusive' = unsafeManagedPtrGetPtr jInclusive return jInclusive' maybeNearest <- case nearest of Nothing -> return nullPtr Just jNearest -> do let jNearest' = unsafeManagedPtrGetPtr jNearest return jNearest' pango_extents_to_pixels maybeInclusive maybeNearest whenJust inclusive touchManagedPtr whenJust nearest touchManagedPtr return () -- function pango_find_base_dir -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Direction" -- throws : False -- Skip return : False foreign import ccall "pango_find_base_dir" pango_find_base_dir :: CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 IO CUInt findBaseDir :: (MonadIO m) => T.Text -> -- text Int32 -> -- length m Direction findBaseDir text length_ = liftIO $ do text' <- textToCString text result <- pango_find_base_dir text' length_ let result' = (toEnum . fromIntegral) result freeMem text' return result' -- function pango_find_paragraph_boundary -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "paragraph_delimiter_index", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "next_paragraph_start", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_find_paragraph_boundary" pango_find_paragraph_boundary :: CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 Ptr Int32 -> -- paragraph_delimiter_index : TBasicType TInt32 Ptr Int32 -> -- next_paragraph_start : TBasicType TInt32 IO () findParagraphBoundary :: (MonadIO m) => T.Text -> -- text Int32 -> -- length m (Int32,Int32) findParagraphBoundary text length_ = liftIO $ do text' <- textToCString text paragraph_delimiter_index <- allocMem :: IO (Ptr Int32) next_paragraph_start <- allocMem :: IO (Ptr Int32) pango_find_paragraph_boundary text' length_ paragraph_delimiter_index next_paragraph_start paragraph_delimiter_index' <- peek paragraph_delimiter_index next_paragraph_start' <- peek next_paragraph_start freeMem text' freeMem paragraph_delimiter_index freeMem next_paragraph_start return (paragraph_delimiter_index', next_paragraph_start') -- function pango_font_description_from_string -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "FontDescription" -- throws : False -- Skip return : False foreign import ccall "pango_font_description_from_string" pango_font_description_from_string :: CString -> -- str : TBasicType TUTF8 IO (Ptr FontDescription) fontDescriptionFromString :: (MonadIO m) => T.Text -> -- str m FontDescription fontDescriptionFromString str = liftIO $ do str' <- textToCString str result <- pango_font_description_from_string str' checkUnexpectedReturnNULL "pango_font_description_from_string" result result' <- (wrapBoxed FontDescription) result freeMem str' return result' -- function pango_get_lib_subdirectory -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_get_lib_subdirectory" pango_get_lib_subdirectory :: IO CString getLibSubdirectory :: (MonadIO m) => m T.Text getLibSubdirectory = liftIO $ do result <- pango_get_lib_subdirectory checkUnexpectedReturnNULL "pango_get_lib_subdirectory" result result' <- cstringToText result return result' -- function pango_get_log_attrs -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "log_attrs", argType = TCArray False (-1) 5 (TInterface "Pango" "LogAttr"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "attrs_len", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "level", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "language", argType = TInterface "Pango" "Language", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "log_attrs", argType = TCArray False (-1) 5 (TInterface "Pango" "LogAttr"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_get_log_attrs" pango_get_log_attrs :: CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 Int32 -> -- level : TBasicType TInt32 Ptr Language -> -- language : TInterface "Pango" "Language" Ptr LogAttr -> -- log_attrs : TCArray False (-1) 5 (TInterface "Pango" "LogAttr") Int32 -> -- attrs_len : TBasicType TInt32 IO () getLogAttrs :: (MonadIO m) => T.Text -> -- text Int32 -> -- length Int32 -> -- level Language -> -- language [LogAttr] -> -- log_attrs m () getLogAttrs text length_ level language log_attrs = liftIO $ do let attrs_len = fromIntegral $ length log_attrs text' <- textToCString text let language' = unsafeManagedPtrGetPtr language let log_attrs' = map unsafeManagedPtrGetPtr log_attrs log_attrs'' <- packBlockArray 52 log_attrs' pango_get_log_attrs text' length_ level language' log_attrs'' attrs_len touchManagedPtr language mapM_ touchManagedPtr log_attrs freeMem text' freeMem log_attrs'' return () -- function pango_get_mirror_char -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mirrored_ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mirrored_ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_get_mirror_char" pango_get_mirror_char :: CInt -> -- ch : TBasicType TUniChar CInt -> -- mirrored_ch : TBasicType TUniChar IO CInt getMirrorChar :: (MonadIO m) => Char -> -- ch Char -> -- mirrored_ch m Bool getMirrorChar ch mirrored_ch = liftIO $ do let ch' = (fromIntegral . ord) ch let mirrored_ch' = (fromIntegral . ord) mirrored_ch result <- pango_get_mirror_char ch' mirrored_ch' let result' = (/= 0) result return result' -- function pango_get_sysconf_subdirectory -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_get_sysconf_subdirectory" pango_get_sysconf_subdirectory :: IO CString getSysconfSubdirectory :: (MonadIO m) => m T.Text getSysconfSubdirectory = liftIO $ do result <- pango_get_sysconf_subdirectory checkUnexpectedReturnNULL "pango_get_sysconf_subdirectory" result result' <- cstringToText result return result' -- function pango_gravity_get_for_matrix -- Args : [Arg {argName = "matrix", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "matrix", argType = TInterface "Pango" "Matrix", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Gravity" -- throws : False -- Skip return : False foreign import ccall "pango_gravity_get_for_matrix" pango_gravity_get_for_matrix :: Ptr Matrix -> -- matrix : TInterface "Pango" "Matrix" IO CUInt gravityGetForMatrix :: (MonadIO m) => Matrix -> -- matrix m Gravity gravityGetForMatrix matrix = liftIO $ do let matrix' = unsafeManagedPtrGetPtr matrix result <- pango_gravity_get_for_matrix matrix' let result' = (toEnum . fromIntegral) result touchManagedPtr matrix return result' -- function pango_gravity_get_for_script -- Args : [Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base_gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TInterface "Pango" "GravityHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base_gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TInterface "Pango" "GravityHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Gravity" -- throws : False -- Skip return : False foreign import ccall "pango_gravity_get_for_script" pango_gravity_get_for_script :: CUInt -> -- script : TInterface "Pango" "Script" CUInt -> -- base_gravity : TInterface "Pango" "Gravity" CUInt -> -- hint : TInterface "Pango" "GravityHint" IO CUInt gravityGetForScript :: (MonadIO m) => Script -> -- script Gravity -> -- base_gravity GravityHint -> -- hint m Gravity gravityGetForScript script base_gravity hint = liftIO $ do let script' = (fromIntegral . fromEnum) script let base_gravity' = (fromIntegral . fromEnum) base_gravity let hint' = (fromIntegral . fromEnum) hint result <- pango_gravity_get_for_script script' base_gravity' hint' let result' = (toEnum . fromIntegral) result return result' -- function pango_gravity_get_for_script_and_width -- Args : [Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wide", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base_gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TInterface "Pango" "GravityHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wide", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base_gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TInterface "Pango" "GravityHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Gravity" -- throws : False -- Skip return : False foreign import ccall "pango_gravity_get_for_script_and_width" pango_gravity_get_for_script_and_width :: CUInt -> -- script : TInterface "Pango" "Script" CInt -> -- wide : TBasicType TBoolean CUInt -> -- base_gravity : TInterface "Pango" "Gravity" CUInt -> -- hint : TInterface "Pango" "GravityHint" IO CUInt gravityGetForScriptAndWidth :: (MonadIO m) => Script -> -- script Bool -> -- wide Gravity -> -- base_gravity GravityHint -> -- hint m Gravity gravityGetForScriptAndWidth script wide base_gravity hint = liftIO $ do let script' = (fromIntegral . fromEnum) script let wide' = (fromIntegral . fromEnum) wide let base_gravity' = (fromIntegral . fromEnum) base_gravity let hint' = (fromIntegral . fromEnum) hint result <- pango_gravity_get_for_script_and_width script' wide' base_gravity' hint' let result' = (toEnum . fromIntegral) result return result' -- function pango_gravity_to_rotation -- Args : [Arg {argName = "gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "gravity", argType = TInterface "Pango" "Gravity", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "pango_gravity_to_rotation" pango_gravity_to_rotation :: CUInt -> -- gravity : TInterface "Pango" "Gravity" IO CDouble gravityToRotation :: (MonadIO m) => Gravity -> -- gravity m Double gravityToRotation gravity = liftIO $ do let gravity' = (fromIntegral . fromEnum) gravity result <- pango_gravity_to_rotation gravity' let result' = realToFrac result return result' -- function pango_is_zero_width -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_is_zero_width" pango_is_zero_width :: CInt -> -- ch : TBasicType TUniChar IO CInt isZeroWidth :: (MonadIO m) => Char -> -- ch m Bool isZeroWidth ch = liftIO $ do let ch' = (fromIntegral . ord) ch result <- pango_is_zero_width ch' let result' = (/= 0) result return result' -- function pango_itemize -- Args : [Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cached_iter", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cached_iter", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Pango" "Item") -- throws : False -- Skip return : False foreign import ccall "pango_itemize" pango_itemize :: Ptr Context -> -- context : TInterface "Pango" "Context" CString -> -- text : TBasicType TUTF8 Int32 -> -- start_index : TBasicType TInt32 Int32 -> -- length : TBasicType TInt32 Ptr AttrList -> -- attrs : TInterface "Pango" "AttrList" Ptr AttrIterator -> -- cached_iter : TInterface "Pango" "AttrIterator" IO (Ptr (GList (Ptr Item))) itemize :: (MonadIO m, ContextK a) => a -> -- context T.Text -> -- text Int32 -> -- start_index Int32 -> -- length AttrList -> -- attrs Maybe (AttrIterator) -> -- cached_iter m [Item] itemize context text start_index length_ attrs cached_iter = liftIO $ do let context' = unsafeManagedPtrCastPtr context text' <- textToCString text let attrs' = unsafeManagedPtrGetPtr attrs maybeCached_iter <- case cached_iter of Nothing -> return nullPtr Just jCached_iter -> do let jCached_iter' = unsafeManagedPtrGetPtr jCached_iter return jCached_iter' result <- pango_itemize context' text' start_index length_ attrs' maybeCached_iter checkUnexpectedReturnNULL "pango_itemize" result result' <- unpackGList result result'' <- mapM (wrapBoxed Item) result' g_list_free result touchManagedPtr context touchManagedPtr attrs whenJust cached_iter touchManagedPtr freeMem text' return result'' -- function pango_itemize_with_base_dir -- Args : [Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base_dir", argType = TInterface "Pango" "Direction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cached_iter", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "context", argType = TInterface "Pango" "Context", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "base_dir", argType = TInterface "Pango" "Direction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_index", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cached_iter", argType = TInterface "Pango" "AttrIterator", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Pango" "Item") -- throws : False -- Skip return : False foreign import ccall "pango_itemize_with_base_dir" pango_itemize_with_base_dir :: Ptr Context -> -- context : TInterface "Pango" "Context" CUInt -> -- base_dir : TInterface "Pango" "Direction" CString -> -- text : TBasicType TUTF8 Int32 -> -- start_index : TBasicType TInt32 Int32 -> -- length : TBasicType TInt32 Ptr AttrList -> -- attrs : TInterface "Pango" "AttrList" Ptr AttrIterator -> -- cached_iter : TInterface "Pango" "AttrIterator" IO (Ptr (GList (Ptr Item))) itemizeWithBaseDir :: (MonadIO m, ContextK a) => a -> -- context Direction -> -- base_dir T.Text -> -- text Int32 -> -- start_index Int32 -> -- length AttrList -> -- attrs Maybe (AttrIterator) -> -- cached_iter m [Item] itemizeWithBaseDir context base_dir text start_index length_ attrs cached_iter = liftIO $ do let context' = unsafeManagedPtrCastPtr context let base_dir' = (fromIntegral . fromEnum) base_dir text' <- textToCString text let attrs' = unsafeManagedPtrGetPtr attrs maybeCached_iter <- case cached_iter of Nothing -> return nullPtr Just jCached_iter -> do let jCached_iter' = unsafeManagedPtrGetPtr jCached_iter return jCached_iter' result <- pango_itemize_with_base_dir context' base_dir' text' start_index length_ attrs' maybeCached_iter checkUnexpectedReturnNULL "pango_itemize_with_base_dir" result result' <- unpackGList result result'' <- mapM (wrapBoxed Item) result' g_list_free result touchManagedPtr context touchManagedPtr attrs whenJust cached_iter touchManagedPtr freeMem text' return result'' -- function pango_language_from_string -- Args : [Arg {argName = "language", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "language", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Language" -- throws : False -- Skip return : False foreign import ccall "pango_language_from_string" pango_language_from_string :: CString -> -- language : TBasicType TUTF8 IO (Ptr Language) languageFromString :: (MonadIO m) => Maybe (T.Text) -> -- language m Language languageFromString language = liftIO $ do maybeLanguage <- case language of Nothing -> return nullPtr Just jLanguage -> do jLanguage' <- textToCString jLanguage return jLanguage' result <- pango_language_from_string maybeLanguage checkUnexpectedReturnNULL "pango_language_from_string" result result' <- (newBoxed Language) result freeMem maybeLanguage return result' -- function pango_language_get_default -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Pango" "Language" -- throws : False -- Skip return : False foreign import ccall "pango_language_get_default" pango_language_get_default :: IO (Ptr Language) languageGetDefault :: (MonadIO m) => m Language languageGetDefault = liftIO $ do result <- pango_language_get_default checkUnexpectedReturnNULL "pango_language_get_default" result result' <- (newBoxed Language) result return result' -- function pango_log2vis_get_embedding_levels -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pbase_dir", argType = TInterface "Pango" "Direction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pbase_dir", argType = TInterface "Pango" "Direction", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt8 -- throws : False -- Skip return : False foreign import ccall "pango_log2vis_get_embedding_levels" pango_log2vis_get_embedding_levels :: CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 CUInt -> -- pbase_dir : TInterface "Pango" "Direction" IO Word8 log2visGetEmbeddingLevels :: (MonadIO m) => T.Text -> -- text Int32 -> -- length Direction -> -- pbase_dir m Word8 log2visGetEmbeddingLevels text length_ pbase_dir = liftIO $ do text' <- textToCString text let pbase_dir' = (fromIntegral . fromEnum) pbase_dir result <- pango_log2vis_get_embedding_levels text' length_ pbase_dir' freeMem text' return result -- function pango_lookup_aliases -- Args : [Arg {argName = "fontname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "families", argType = TCArray False (-1) 2 (TBasicType TUTF8), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "n_families", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_families", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "fontname", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_lookup_aliases" pango_lookup_aliases :: CString -> -- fontname : TBasicType TUTF8 Ptr (Ptr CString) -> -- families : TCArray False (-1) 2 (TBasicType TUTF8) Ptr Int32 -> -- n_families : TBasicType TInt32 IO () {-# DEPRECATED lookupAliases ["(Since version 1.32)","This function is not thread-safe."]#-} lookupAliases :: (MonadIO m) => T.Text -> -- fontname m ([T.Text]) lookupAliases fontname = liftIO $ do fontname' <- textToCString fontname families <- allocMem :: IO (Ptr (Ptr CString)) n_families <- allocMem :: IO (Ptr Int32) pango_lookup_aliases fontname' families n_families n_families' <- peek n_families families' <- peek families families'' <- (unpackUTF8CArrayWithLength n_families') families' (mapCArrayWithLength n_families') freeMem families' freeMem families' freeMem fontname' freeMem families freeMem n_families return families'' -- function pango_markup_parser_finish -- Args : [Arg {argName = "context", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_list", argType = TInterface "Pango" "AttrList", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "accel_char", argType = TBasicType TUniChar, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "context", argType = TInterface "GLib" "MarkupParseContext", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "pango_markup_parser_finish" pango_markup_parser_finish :: Ptr GLib.MarkupParseContext -> -- context : TInterface "GLib" "MarkupParseContext" Ptr (Ptr AttrList) -> -- attr_list : TInterface "Pango" "AttrList" Ptr CString -> -- text : TBasicType TUTF8 Ptr CInt -> -- accel_char : TBasicType TUniChar Ptr (Ptr GError) -> -- error IO CInt markupParserFinish :: (MonadIO m) => GLib.MarkupParseContext -> -- context m (AttrList,T.Text,Char) markupParserFinish context = liftIO $ do let context' = unsafeManagedPtrGetPtr context attr_list <- allocMem :: IO (Ptr (Ptr AttrList)) text <- allocMem :: IO (Ptr CString) accel_char <- allocMem :: IO (Ptr CInt) onException (do _ <- propagateGError $ pango_markup_parser_finish context' attr_list text accel_char attr_list' <- peek attr_list attr_list'' <- (wrapBoxed AttrList) attr_list' text' <- peek text text'' <- cstringToText text' freeMem text' accel_char' <- peek accel_char let accel_char'' = (chr . fromIntegral) accel_char' touchManagedPtr context freeMem attr_list freeMem text freeMem accel_char return (attr_list'', text'', accel_char'') ) (do freeMem attr_list freeMem text freeMem accel_char ) -- function pango_markup_parser_new -- Args : [Arg {argName = "accel_marker", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "accel_marker", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GLib" "MarkupParseContext" -- throws : False -- Skip return : False foreign import ccall "pango_markup_parser_new" pango_markup_parser_new :: CInt -> -- accel_marker : TBasicType TUniChar IO (Ptr GLib.MarkupParseContext) markupParserNew :: (MonadIO m) => Char -> -- accel_marker m GLib.MarkupParseContext markupParserNew accel_marker = liftIO $ do let accel_marker' = (fromIntegral . ord) accel_marker result <- pango_markup_parser_new accel_marker' checkUnexpectedReturnNULL "pango_markup_parser_new" result result' <- (newBoxed GLib.MarkupParseContext) result return result' -- function pango_module_register -- Args : [Arg {argName = "module", argType = TInterface "Pango" "IncludedModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "module", argType = TInterface "Pango" "IncludedModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_module_register" pango_module_register :: Ptr IncludedModule -> -- module : TInterface "Pango" "IncludedModule" IO () moduleRegister :: (MonadIO m) => IncludedModule -> -- module m () moduleRegister module_ = liftIO $ do let module_' = unsafeManagedPtrGetPtr module_ pango_module_register module_' touchManagedPtr module_ return () -- function pango_parse_enum -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "possible_values", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_parse_enum" pango_parse_enum :: CGType -> -- type : TBasicType TGType CString -> -- str : TBasicType TUTF8 Ptr Int32 -> -- value : TBasicType TInt32 CInt -> -- warn : TBasicType TBoolean Ptr CString -> -- possible_values : TBasicType TUTF8 IO CInt parseEnum :: (MonadIO m) => GType -> -- type Maybe (T.Text) -> -- str Bool -> -- warn m (Bool,Int32,T.Text) parseEnum type_ str warn = liftIO $ do let type_' = gtypeToCGType type_ maybeStr <- case str of Nothing -> return nullPtr Just jStr -> do jStr' <- textToCString jStr return jStr' value <- allocMem :: IO (Ptr Int32) let warn' = (fromIntegral . fromEnum) warn possible_values <- allocMem :: IO (Ptr CString) result <- pango_parse_enum type_' maybeStr value warn' possible_values let result' = (/= 0) result value' <- peek value possible_values' <- peek possible_values possible_values'' <- cstringToText possible_values' freeMem possible_values' freeMem maybeStr freeMem value freeMem possible_values return (result', value', possible_values'') -- function pango_parse_markup -- Args : [Arg {argName = "markup_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_marker", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attr_list", argType = TInterface "Pango" "AttrList", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "accel_char", argType = TBasicType TUniChar, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "markup_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "accel_marker", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : True -- Skip return : False foreign import ccall "pango_parse_markup" pango_parse_markup :: CString -> -- markup_text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 CInt -> -- accel_marker : TBasicType TUniChar Ptr (Ptr AttrList) -> -- attr_list : TInterface "Pango" "AttrList" Ptr CString -> -- text : TBasicType TUTF8 Ptr CInt -> -- accel_char : TBasicType TUniChar Ptr (Ptr GError) -> -- error IO CInt parseMarkup :: (MonadIO m) => T.Text -> -- markup_text Int32 -> -- length Char -> -- accel_marker m (AttrList,T.Text,Char) parseMarkup markup_text length_ accel_marker = liftIO $ do markup_text' <- textToCString markup_text let accel_marker' = (fromIntegral . ord) accel_marker attr_list <- allocMem :: IO (Ptr (Ptr AttrList)) text <- allocMem :: IO (Ptr CString) accel_char <- allocMem :: IO (Ptr CInt) onException (do _ <- propagateGError $ pango_parse_markup markup_text' length_ accel_marker' attr_list text accel_char attr_list' <- peek attr_list attr_list'' <- (wrapBoxed AttrList) attr_list' text' <- peek text text'' <- cstringToText text' freeMem text' accel_char' <- peek accel_char let accel_char'' = (chr . fromIntegral) accel_char' freeMem markup_text' freeMem attr_list freeMem text freeMem accel_char return (attr_list'', text'', accel_char'') ) (do freeMem markup_text' freeMem attr_list freeMem text freeMem accel_char ) -- function pango_parse_stretch -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stretch", argType = TInterface "Pango" "Stretch", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_parse_stretch" pango_parse_stretch :: CString -> -- str : TBasicType TUTF8 Ptr CUInt -> -- stretch : TInterface "Pango" "Stretch" CInt -> -- warn : TBasicType TBoolean IO CInt parseStretch :: (MonadIO m) => T.Text -> -- str Bool -> -- warn m (Bool,Stretch) parseStretch str warn = liftIO $ do str' <- textToCString str stretch <- allocMem :: IO (Ptr CUInt) let warn' = (fromIntegral . fromEnum) warn result <- pango_parse_stretch str' stretch warn' let result' = (/= 0) result stretch' <- peek stretch let stretch'' = (toEnum . fromIntegral) stretch' freeMem str' freeMem stretch return (result', stretch'') -- function pango_parse_style -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "style", argType = TInterface "Pango" "Style", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_parse_style" pango_parse_style :: CString -> -- str : TBasicType TUTF8 Ptr CUInt -> -- style : TInterface "Pango" "Style" CInt -> -- warn : TBasicType TBoolean IO CInt parseStyle :: (MonadIO m) => T.Text -> -- str Bool -> -- warn m (Bool,Style) parseStyle str warn = liftIO $ do str' <- textToCString str style <- allocMem :: IO (Ptr CUInt) let warn' = (fromIntegral . fromEnum) warn result <- pango_parse_style str' style warn' let result' = (/= 0) result style' <- peek style let style'' = (toEnum . fromIntegral) style' freeMem str' freeMem style return (result', style'') -- function pango_parse_variant -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "variant", argType = TInterface "Pango" "Variant", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_parse_variant" pango_parse_variant :: CString -> -- str : TBasicType TUTF8 Ptr CUInt -> -- variant : TInterface "Pango" "Variant" CInt -> -- warn : TBasicType TBoolean IO CInt parseVariant :: (MonadIO m) => T.Text -> -- str Bool -> -- warn m (Bool,Variant) parseVariant str warn = liftIO $ do str' <- textToCString str variant <- allocMem :: IO (Ptr CUInt) let warn' = (fromIntegral . fromEnum) warn result <- pango_parse_variant str' variant warn' let result' = (/= 0) result variant' <- peek variant let variant'' = (toEnum . fromIntegral) variant' freeMem str' freeMem variant return (result', variant'') -- function pango_parse_weight -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "weight", argType = TInterface "Pango" "Weight", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "warn", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_parse_weight" pango_parse_weight :: CString -> -- str : TBasicType TUTF8 Ptr CUInt -> -- weight : TInterface "Pango" "Weight" CInt -> -- warn : TBasicType TBoolean IO CInt parseWeight :: (MonadIO m) => T.Text -> -- str Bool -> -- warn m (Bool,Weight) parseWeight str warn = liftIO $ do str' <- textToCString str weight <- allocMem :: IO (Ptr CUInt) let warn' = (fromIntegral . fromEnum) warn result <- pango_parse_weight str' weight warn' let result' = (/= 0) result weight' <- peek weight let weight'' = (toEnum . fromIntegral) weight' freeMem str' freeMem weight return (result', weight'') -- function pango_quantize_line_geometry -- Args : [Arg {argName = "thickness", argType = TBasicType TInt32, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "thickness", argType = TBasicType TInt32, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_quantize_line_geometry" pango_quantize_line_geometry :: Ptr Int32 -> -- thickness : TBasicType TInt32 Ptr Int32 -> -- position : TBasicType TInt32 IO () quantizeLineGeometry :: (MonadIO m) => Int32 -> -- thickness Int32 -> -- position m (Int32,Int32) quantizeLineGeometry thickness position = liftIO $ do thickness' <- allocMem :: IO (Ptr Int32) poke thickness' thickness position' <- allocMem :: IO (Ptr Int32) poke position' position pango_quantize_line_geometry thickness' position' thickness'' <- peek thickness' position'' <- peek position' freeMem thickness' freeMem position' return (thickness'', position'') -- function pango_read_line -- Args : [Arg {argName = "stream", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TInterface "GLib" "String", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "stream", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_read_line" pango_read_line :: Ptr () -> -- stream : TBasicType TVoid Ptr GLib.String -> -- str : TInterface "GLib" "String" IO Int32 readLine :: (MonadIO m) => Ptr () -> -- stream m (Int32,GLib.String) readLine stream = liftIO $ do str <- callocBoxedBytes 24 :: IO (Ptr GLib.String) result <- pango_read_line stream str str' <- (wrapBoxed GLib.String) str return (result, str') -- function pango_reorder_items -- Args : [Arg {argName = "logical_items", argType = TGList (TInterface "Pango" "Item"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "logical_items", argType = TGList (TInterface "Pango" "Item"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList (TInterface "Pango" "Item") -- throws : False -- Skip return : False foreign import ccall "pango_reorder_items" pango_reorder_items :: Ptr (GList (Ptr Item)) -> -- logical_items : TGList (TInterface "Pango" "Item") IO (Ptr (GList (Ptr Item))) reorderItems :: (MonadIO m) => [Item] -> -- logical_items m [Item] reorderItems logical_items = liftIO $ do let logical_items' = map unsafeManagedPtrGetPtr logical_items logical_items'' <- packGList logical_items' result <- pango_reorder_items logical_items'' checkUnexpectedReturnNULL "pango_reorder_items" result result' <- unpackGList result result'' <- mapM (wrapBoxed Item) result' g_list_free result mapM_ touchManagedPtr logical_items g_list_free logical_items'' return result'' -- function pango_scan_int -- Args : [Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "out", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_scan_int" pango_scan_int :: Ptr CString -> -- pos : TBasicType TUTF8 Ptr Int32 -> -- out : TBasicType TInt32 IO CInt scanInt :: (MonadIO m) => T.Text -> -- pos m (Bool,T.Text,Int32) scanInt pos = liftIO $ do pos' <- textToCString pos pos'' <- allocMem :: IO (Ptr CString) poke pos'' pos' out <- allocMem :: IO (Ptr Int32) result <- pango_scan_int pos'' out let result' = (/= 0) result pos''' <- peek pos'' pos'''' <- cstringToText pos''' freeMem pos''' out' <- peek out freeMem pos'' freeMem out return (result', pos'''', out') -- function pango_scan_string -- Args : [Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "out", argType = TInterface "GLib" "String", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_scan_string" pango_scan_string :: Ptr CString -> -- pos : TBasicType TUTF8 Ptr GLib.String -> -- out : TInterface "GLib" "String" IO CInt scanString :: (MonadIO m) => T.Text -> -- pos m (Bool,T.Text,GLib.String) scanString pos = liftIO $ do pos' <- textToCString pos pos'' <- allocMem :: IO (Ptr CString) poke pos'' pos' out <- callocBoxedBytes 24 :: IO (Ptr GLib.String) result <- pango_scan_string pos'' out let result' = (/= 0) result pos''' <- peek pos'' pos'''' <- cstringToText pos''' freeMem pos''' out' <- (wrapBoxed GLib.String) out freeMem pos'' return (result', pos'''', out') -- function pango_scan_word -- Args : [Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "out", argType = TInterface "GLib" "String", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_scan_word" pango_scan_word :: Ptr CString -> -- pos : TBasicType TUTF8 Ptr GLib.String -> -- out : TInterface "GLib" "String" IO CInt scanWord :: (MonadIO m) => T.Text -> -- pos m (Bool,T.Text,GLib.String) scanWord pos = liftIO $ do pos' <- textToCString pos pos'' <- allocMem :: IO (Ptr CString) poke pos'' pos' out <- callocBoxedBytes 24 :: IO (Ptr GLib.String) result <- pango_scan_word pos'' out let result' = (/= 0) result pos''' <- peek pos'' pos'''' <- cstringToText pos''' freeMem pos''' out' <- (wrapBoxed GLib.String) out freeMem pos'' return (result', pos'''', out') -- function pango_script_for_unichar -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Script" -- throws : False -- Skip return : False foreign import ccall "pango_script_for_unichar" pango_script_for_unichar :: CInt -> -- ch : TBasicType TUniChar IO CUInt scriptForUnichar :: (MonadIO m) => Char -> -- ch m Script scriptForUnichar ch = liftIO $ do let ch' = (fromIntegral . ord) ch result <- pango_script_for_unichar ch' let result' = (toEnum . fromIntegral) result return result' -- function pango_script_get_sample_language -- Args : [Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "script", argType = TInterface "Pango" "Script", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Language" -- throws : False -- Skip return : False foreign import ccall "pango_script_get_sample_language" pango_script_get_sample_language :: CUInt -> -- script : TInterface "Pango" "Script" IO (Ptr Language) scriptGetSampleLanguage :: (MonadIO m) => Script -> -- script m Language scriptGetSampleLanguage script = liftIO $ do let script' = (fromIntegral . fromEnum) script result <- pango_script_get_sample_language script' checkUnexpectedReturnNULL "pango_script_get_sample_language" result result' <- (wrapBoxed Language) result return result' -- function pango_shape -- Args : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyphs", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyphs", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_shape" pango_shape :: CString -> -- text : TBasicType TUTF8 Int32 -> -- length : TBasicType TInt32 Ptr Analysis -> -- analysis : TInterface "Pango" "Analysis" Ptr GlyphString -> -- glyphs : TInterface "Pango" "GlyphString" IO () shape :: (MonadIO m) => T.Text -> -- text Int32 -> -- length Analysis -> -- analysis GlyphString -> -- glyphs m () shape text length_ analysis glyphs = liftIO $ do text' <- textToCString text let analysis' = unsafeManagedPtrGetPtr analysis let glyphs' = unsafeManagedPtrGetPtr glyphs pango_shape text' length_ analysis' glyphs' touchManagedPtr analysis touchManagedPtr glyphs freeMem text' return () -- function pango_shape_full -- Args : [Arg {argName = "item_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "paragraph_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "paragraph_length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyphs", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "item_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "item_length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "paragraph_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "paragraph_length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "analysis", argType = TInterface "Pango" "Analysis", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "glyphs", argType = TInterface "Pango" "GlyphString", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "pango_shape_full" pango_shape_full :: CString -> -- item_text : TBasicType TUTF8 Int32 -> -- item_length : TBasicType TInt32 CString -> -- paragraph_text : TBasicType TUTF8 Int32 -> -- paragraph_length : TBasicType TInt32 Ptr Analysis -> -- analysis : TInterface "Pango" "Analysis" Ptr GlyphString -> -- glyphs : TInterface "Pango" "GlyphString" IO () shapeFull :: (MonadIO m) => T.Text -> -- item_text Int32 -> -- item_length Maybe (T.Text) -> -- paragraph_text Int32 -> -- paragraph_length Analysis -> -- analysis GlyphString -> -- glyphs m () shapeFull item_text item_length paragraph_text paragraph_length analysis glyphs = liftIO $ do item_text' <- textToCString item_text maybeParagraph_text <- case paragraph_text of Nothing -> return nullPtr Just jParagraph_text -> do jParagraph_text' <- textToCString jParagraph_text return jParagraph_text' let analysis' = unsafeManagedPtrGetPtr analysis let glyphs' = unsafeManagedPtrGetPtr glyphs pango_shape_full item_text' item_length maybeParagraph_text paragraph_length analysis' glyphs' touchManagedPtr analysis touchManagedPtr glyphs freeMem item_text' freeMem maybeParagraph_text return () -- function pango_skip_space -- Args : [Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [] -- hInArgs : [Arg {argName = "pos", argType = TBasicType TUTF8, direction = DirectionInout, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "pango_skip_space" pango_skip_space :: Ptr CString -> -- pos : TBasicType TUTF8 IO CInt skipSpace :: (MonadIO m) => T.Text -> -- pos m (Bool,T.Text) skipSpace pos = liftIO $ do pos' <- textToCString pos pos'' <- allocMem :: IO (Ptr CString) poke pos'' pos' result <- pango_skip_space pos'' let result' = (/= 0) result pos''' <- peek pos'' pos'''' <- cstringToText pos''' freeMem pos''' freeMem pos'' return (result', pos'''') -- function pango_split_file_list -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray True (-1) (-1) (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "pango_split_file_list" pango_split_file_list :: CString -> -- str : TBasicType TUTF8 IO (Ptr CString) splitFileList :: (MonadIO m) => T.Text -> -- str m [T.Text] splitFileList str = liftIO $ do str' <- textToCString str result <- pango_split_file_list str' checkUnexpectedReturnNULL "pango_split_file_list" result result' <- unpackZeroTerminatedUTF8CArray result mapZeroTerminatedCArray freeMem result freeMem result freeMem str' return result' -- function pango_trim_string -- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_trim_string" pango_trim_string :: CString -> -- str : TBasicType TUTF8 IO CString trimString :: (MonadIO m) => T.Text -> -- str m T.Text trimString str = liftIO $ do str' <- textToCString str result <- pango_trim_string str' checkUnexpectedReturnNULL "pango_trim_string" result result' <- cstringToText result freeMem result freeMem str' return result' -- function pango_unichar_direction -- Args : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ch", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Pango" "Direction" -- throws : False -- Skip return : False foreign import ccall "pango_unichar_direction" pango_unichar_direction :: CInt -> -- ch : TBasicType TUniChar IO CUInt unicharDirection :: (MonadIO m) => Char -> -- ch m Direction unicharDirection ch = liftIO $ do let ch' = (fromIntegral . ord) ch result <- pango_unichar_direction ch' let result' = (toEnum . fromIntegral) result return result' -- function pango_units_from_double -- Args : [Arg {argName = "d", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "d", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_units_from_double" pango_units_from_double :: CDouble -> -- d : TBasicType TDouble IO Int32 unitsFromDouble :: (MonadIO m) => Double -> -- d m Int32 unitsFromDouble d = liftIO $ do let d' = realToFrac d result <- pango_units_from_double d' return result -- function pango_units_to_double -- Args : [Arg {argName = "i", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "i", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TDouble -- throws : False -- Skip return : False foreign import ccall "pango_units_to_double" pango_units_to_double :: Int32 -> -- i : TBasicType TInt32 IO CDouble unitsToDouble :: (MonadIO m) => Int32 -> -- i m Double unitsToDouble i = liftIO $ do result <- pango_units_to_double i let result' = realToFrac result return result' -- function pango_version -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "pango_version" pango_version :: IO Int32 version :: (MonadIO m) => m Int32 version = liftIO $ do result <- pango_version return result -- function pango_version_check -- Args : [Arg {argName = "required_major", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "required_minor", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "required_micro", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "required_major", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "required_minor", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "required_micro", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_version_check" pango_version_check :: Int32 -> -- required_major : TBasicType TInt32 Int32 -> -- required_minor : TBasicType TInt32 Int32 -> -- required_micro : TBasicType TInt32 IO CString versionCheck :: (MonadIO m) => Int32 -> -- required_major Int32 -> -- required_minor Int32 -> -- required_micro m T.Text versionCheck required_major required_minor required_micro = liftIO $ do result <- pango_version_check required_major required_minor required_micro checkUnexpectedReturnNULL "pango_version_check" result result' <- cstringToText result return result' -- function pango_version_string -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "pango_version_string" pango_version_string :: IO CString versionString :: (MonadIO m) => m T.Text versionString = liftIO $ do result <- pango_version_string checkUnexpectedReturnNULL "pango_version_string" result result' <- cstringToText result return result' -- callback AttrClassDestroyFieldCallback attrClassDestroyFieldCallbackClosure :: AttrClassDestroyFieldCallback -> IO Closure attrClassDestroyFieldCallbackClosure cb = newCClosure =<< mkAttrClassDestroyFieldCallback wrapped where wrapped = attrClassDestroyFieldCallbackWrapper Nothing cb type AttrClassDestroyFieldCallbackC = Ptr Attribute -> IO () foreign import ccall "wrapper" mkAttrClassDestroyFieldCallback :: AttrClassDestroyFieldCallbackC -> IO (FunPtr AttrClassDestroyFieldCallbackC) type AttrClassDestroyFieldCallback = Attribute -> IO () noAttrClassDestroyFieldCallback :: Maybe AttrClassDestroyFieldCallback noAttrClassDestroyFieldCallback = Nothing attrClassDestroyFieldCallbackWrapper :: Maybe (Ptr (FunPtr (AttrClassDestroyFieldCallbackC))) -> AttrClassDestroyFieldCallback -> Ptr Attribute -> IO () attrClassDestroyFieldCallbackWrapper funptrptr _cb attr = do attr' <- (newPtr 16 Attribute) attr _cb attr' maybeReleaseFunPtr funptrptr -- callback AttrClassEqualFieldCallback attrClassEqualFieldCallbackClosure :: AttrClassEqualFieldCallback -> IO Closure attrClassEqualFieldCallbackClosure cb = newCClosure =<< mkAttrClassEqualFieldCallback wrapped where wrapped = attrClassEqualFieldCallbackWrapper Nothing cb type AttrClassEqualFieldCallbackC = Ptr Attribute -> Ptr Attribute -> IO CInt foreign import ccall "wrapper" mkAttrClassEqualFieldCallback :: AttrClassEqualFieldCallbackC -> IO (FunPtr AttrClassEqualFieldCallbackC) type AttrClassEqualFieldCallback = Attribute -> Attribute -> IO Bool noAttrClassEqualFieldCallback :: Maybe AttrClassEqualFieldCallback noAttrClassEqualFieldCallback = Nothing attrClassEqualFieldCallbackWrapper :: Maybe (Ptr (FunPtr (AttrClassEqualFieldCallbackC))) -> AttrClassEqualFieldCallback -> Ptr Attribute -> Ptr Attribute -> IO CInt attrClassEqualFieldCallbackWrapper funptrptr _cb attr1 attr2 = do attr1' <- (newPtr 16 Attribute) attr1 attr2' <- (newPtr 16 Attribute) attr2 result <- _cb attr1' attr2' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback IncludedModuleListFieldCallback includedModuleListFieldCallbackClosure :: IncludedModuleListFieldCallback -> IO Closure includedModuleListFieldCallbackClosure cb = newCClosure =<< mkIncludedModuleListFieldCallback wrapped where wrapped = includedModuleListFieldCallbackWrapper Nothing cb type IncludedModuleListFieldCallbackC = Ptr EngineInfo -> Int32 -> IO () foreign import ccall "wrapper" mkIncludedModuleListFieldCallback :: IncludedModuleListFieldCallbackC -> IO (FunPtr IncludedModuleListFieldCallbackC) type IncludedModuleListFieldCallback = EngineInfo -> Int32 -> IO () noIncludedModuleListFieldCallback :: Maybe IncludedModuleListFieldCallback noIncludedModuleListFieldCallback = Nothing includedModuleListFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IncludedModuleListFieldCallbackC))) -> IncludedModuleListFieldCallback -> Ptr EngineInfo -> Int32 -> IO () includedModuleListFieldCallbackWrapper funptrptr _cb engines n_engines = do engines' <- (newPtr 40 EngineInfo) engines _cb engines' n_engines maybeReleaseFunPtr funptrptr -- callback IncludedModuleInitFieldCallback includedModuleInitFieldCallbackClosure :: IncludedModuleInitFieldCallback -> IO Closure includedModuleInitFieldCallbackClosure cb = newCClosure =<< mkIncludedModuleInitFieldCallback wrapped where wrapped = includedModuleInitFieldCallbackWrapper Nothing cb type IncludedModuleInitFieldCallbackC = Ptr GObject.TypeModule -> IO () foreign import ccall "wrapper" mkIncludedModuleInitFieldCallback :: IncludedModuleInitFieldCallbackC -> IO (FunPtr IncludedModuleInitFieldCallbackC) type IncludedModuleInitFieldCallback = GObject.TypeModule -> IO () noIncludedModuleInitFieldCallback :: Maybe IncludedModuleInitFieldCallback noIncludedModuleInitFieldCallback = Nothing includedModuleInitFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IncludedModuleInitFieldCallbackC))) -> IncludedModuleInitFieldCallback -> Ptr GObject.TypeModule -> IO () includedModuleInitFieldCallbackWrapper funptrptr _cb module_ = do module_' <- (newObject GObject.TypeModule) module_ _cb module_' maybeReleaseFunPtr funptrptr -- callback IncludedModuleExitFieldCallback includedModuleExitFieldCallbackClosure :: IncludedModuleExitFieldCallback -> IO Closure includedModuleExitFieldCallbackClosure cb = newCClosure =<< mkIncludedModuleExitFieldCallback wrapped where wrapped = includedModuleExitFieldCallbackWrapper Nothing cb type IncludedModuleExitFieldCallbackC = IO () foreign import ccall "wrapper" mkIncludedModuleExitFieldCallback :: IncludedModuleExitFieldCallbackC -> IO (FunPtr IncludedModuleExitFieldCallbackC) type IncludedModuleExitFieldCallback = IO () noIncludedModuleExitFieldCallback :: Maybe IncludedModuleExitFieldCallback noIncludedModuleExitFieldCallback = Nothing includedModuleExitFieldCallbackWrapper :: Maybe (Ptr (FunPtr (IncludedModuleExitFieldCallbackC))) -> IncludedModuleExitFieldCallback -> IO () includedModuleExitFieldCallbackWrapper funptrptr _cb = do _cb maybeReleaseFunPtr funptrptr