{- |
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 structure used to describe a text range.
-}

module GI.Atk.Structs.TextRange
    ( 

-- * Exported types
    TextRange(..)                           ,
    noTextRange                             ,


 -- * Properties
-- ** Bounds
    textRangeReadBounds                     ,


-- ** Content
    textRangeReadContent                    ,


-- ** EndOffset
    textRangeReadEndOffset                  ,


-- ** StartOffset
    textRangeReadStartOffset                ,




    ) 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.Atk.Types
import GI.Atk.Callbacks

newtype TextRange = TextRange (ForeignPtr TextRange)
foreign import ccall "atk_text_range_get_type" c_atk_text_range_get_type :: 
    IO GType

instance BoxedObject TextRange where
    boxedType _ = c_atk_text_range_get_type

noTextRange :: Maybe TextRange
noTextRange = Nothing

textRangeReadBounds :: TextRange -> IO TextRectangle
textRangeReadBounds s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (Ptr TextRectangle)
    val' <- (newPtr 16 TextRectangle) val
    return val'

textRangeReadStartOffset :: TextRange -> IO Int32
textRangeReadStartOffset s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO Int32
    return val

textRangeReadEndOffset :: TextRange -> IO Int32
textRangeReadEndOffset s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 20) :: IO Int32
    return val

textRangeReadContent :: TextRange -> IO T.Text
textRangeReadContent s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO CString
    val' <- cstringToText val
    return val'