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

The #PangoLayoutLine structure represents one of the lines resulting
from laying out a paragraph via #PangoLayout. #PangoLayoutLine
structures are obtained by calling pango_layout_get_line() and
are only valid until the text, attributes, or settings of the
parent #PangoLayout are modified.

Routines for rendering PangoLayout objects are provided in
code specific to each rendering system.
-}

module GI.Pango.Structs.LayoutLine
    ( 

-- * Exported types
    LayoutLine(..)                          ,
    noLayoutLine                            ,


 -- * Methods
-- ** layoutLineGetExtents
    layoutLineGetExtents                    ,


-- ** layoutLineGetPixelExtents
    layoutLineGetPixelExtents               ,


-- ** layoutLineGetXRanges
    layoutLineGetXRanges                    ,


-- ** layoutLineIndexToX
    layoutLineIndexToX                      ,


-- ** layoutLineRef
    layoutLineRef                           ,


-- ** layoutLineUnref
    layoutLineUnref                         ,


-- ** layoutLineXToIndex
    layoutLineXToIndex                      ,




 -- * Properties
-- ** IsParagraphStart
    layoutLineReadIsParagraphStart          ,


-- ** Layout
    layoutLineReadLayout                    ,


-- ** Length
    layoutLineReadLength                    ,


-- ** ResolvedDir
    layoutLineReadResolvedDir               ,


-- ** Runs
    layoutLineReadRuns                      ,


-- ** StartIndex
    layoutLineReadStartIndex                ,




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

noLayoutLine :: Maybe LayoutLine
noLayoutLine = Nothing

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