{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

A #PangoTabArray struct contains an array
of tab stops. Each tab stop has an alignment and a position.
-}

module GI.Pango.Structs.TabArray
    ( 

-- * Exported types
    TabArray(..)                            ,
    noTabArray                              ,


 -- * Methods
-- ** tabArrayCopy
    tabArrayCopy                            ,


-- ** tabArrayFree
    tabArrayFree                            ,


-- ** tabArrayGetPositionsInPixels
    tabArrayGetPositionsInPixels            ,


-- ** tabArrayGetSize
    tabArrayGetSize                         ,


-- ** tabArrayGetTab
    tabArrayGetTab                          ,


-- ** tabArrayGetTabs
    tabArrayGetTabs                         ,


-- ** tabArrayNew
    tabArrayNew                             ,


-- ** tabArrayResize
    tabArrayResize                          ,


-- ** tabArraySetTab
    tabArraySetTab                          ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Pango.Types
import GI.Pango.Callbacks

newtype TabArray = TabArray (ForeignPtr TabArray)
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

noTabArray :: Maybe TabArray
noTabArray = Nothing

-- 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 ()