gstreamer: document M.S.G.Core.Clock

gstreamer: document M.S.G.Core.Clock

darcs-hash:20080116191205-21862-44e807359cb5252de1789258b300e107453b31b1.gz

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  This library is free software: you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public License
--  as published by the Free Software Foundation, either version 3 of
--  the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GStreamer, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GStreamer documentation.
--
--  |
--  Maintainer  : gtk2hs-devel@lists.sourceforge.net
--  Stability   : alpha
--  Portability : portable (depends on GHC)
--
--  Abstract class of global clocks.
module Media.Streaming.GStreamer.Core.Clock (

-- * Detail
  -- | GStreamer uses a global clock to synchronize the plugins in a
  --   pipeline. Different clock implementations are possible by
  --   implementing this abstract base class.
  --
  --   The 'Clock' returns a monotonically increasing time with the
  --   method 'clockGetTime'. Its accuracy and base time depend
  --   on the specific clock implementation but time is always
  --   expressed in nanoseconds. Since the baseline of the clock is
  --   undefined, the clock time returned is not meaningful in itself,
  --   what matters are the deltas between two clock times. The time
  --   returned by a clock is called the absolute time.
  --
  --   The pipeline uses the clock to calculate the stream
  --   time. Usually all renderers synchronize to the global clock
  --   using the buffer timestamps, the newsegment events and the
  --   element's base time, see GstPipeline.
  --
  --   A clock implementation can support periodic and single shot
  --   clock notifications both synchronous and asynchronous.
  --
  --   One first needs to create a 'ClockID' for the periodic or
  --   single shot notification using 'clockNewSingleShotID' or
  --   'clockNewPeriodicID'.
  --
  --   To perform a blocking wait for the specific time of the
  --   'ClockID' use 'clockIDWait'. This calls can be interrupted with
  --   the 'clockIDUnschedule' call. If the blocking wait is
  --   unscheduled a return value of 'ClockUnscheduled' is returned.
  --
  --   Periodic callbacks scheduled async will be repeadedly called
  --   automatically until it is unscheduled. To schedule a sync
  --   periodic callback, 'clockIDWait' should be called repeatedly.
  --
  --   The async callbacks can happen from any thread, either provided
  --   by the core or from a streaming thread. The application should
  --   be prepared for this.
  --
  --   A 'ClockID' that has been unscheduled cannot be used again for
  --   any wait operation; a new 'ClockID' should be created.
  --
  --   It is possible to perform a blocking wait on the same 'ClockID'
  --   from multiple threads. However, registering the same 'ClockID'
  --   for multiple async notifications is not possible, the callback
  --   will only be called for the thread registering the entry last.
  --
  --   These clock operations do not operate on the stream time, so
  --   the callbacks will also occur when not in the playing state as
  --   if the clock just keeps on running. Some clocks however do not
  --   progress when the element that provided the clock is not
  --   playing.
  --
  --   When a clock has the 'ClockFlagCanSetMaster' flag set, it can
  --   be slaved to another 'Clock' with 'clockSetMaster'. The clock
  --   will then automatically be synchronized to this master clock by
  --   repeatedly sampling the master clock and the slave clock and
  --   recalibrating the slave clock with 'clockSetCalibration'. This
  --   feature is mostly useful for plugins that have an internal
  --   clock but must operate with another clock selected by the
  --   GstPipeline. They can track the offset and rate difference of
  --   their internal clock relative to the master clock by using the
  --   'clockGetCalibration' function.
  --
  --   The master\/slave synchronisation can be tuned with the
  --   the 'clockTimeout', 'clockWindowSize' and 'clockWindowThreshold' properties.
  --   The 'clockTimeout' property defines the interval to
  --   sample the master clock and run the calibration
  --   functions. 'clockWindowSize' defines the number of samples to
  --   use when calibrating and 'clockWindowThreshold' defines the
  --   minimum number of samples before the calibration is performed.

-- * Types
  Clock,
  ClockClass,
  castToClock,
  toClock,

  -- | A time value measured in nanoseconds.
  ClockTime,

  -- | The 'ClockTime' value representing an invalid time.
  clockTimeNone,
  clockTimeIsValid,

  -- | The 'ClockTime' value representing 1 second, i.e. 1e9.
  second,
  -- | The 'ClockTime' value representing 1 millisecond, i.e. 1e6.
  msecond,
  -- | The 'ClockTime' value representing 1 microsecond, i.e. 1e3.
  usecond,
  -- | The 'ClockTime' value representing 1 nanosecond, i.e. 1.
  nsecond,
  -- | A value holding the difference between two 'ClockTime's.
  ClockTimeDiff,
  -- | An opaque identifier for a timer event.
  ClockID,
  -- | An enumeration type returned by 'clockIDWait'.
  ClockReturn(..),
  -- | The flags a 'Clock' may have.
  ClockFlags(..),
  clockGetFlags,
  clockSetFlags,
  clockUnsetFlags,

-- * Clock Operations
  clockAddObservation,
  clockSetMaster,
  clockGetMaster,
  clockSetResolution,
  clockGetResolution,
  clockGetTime,
  clockNewSingleShotID,
  clockNewPeriodicID,
  clockGetInternalTime,
  clockGetCalibration,
  clockSetCalibration,
  clockIDGetTime,
  clockIDWait,
  clockIDUnschedule,

-- * Clock Properties
  clockTimeout,
  clockWindowSize,
  clockWindowThreshold

  ) where

import Data.Ratio ( Ratio
                  , (%)
                  , numerator
                  , denominator )
import Control.Monad ( liftM
                     , liftM4)
{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.FFI
import System.Glib.Attributes ( Attr
                              , newAttr )
import System.Glib.Properties

{# context lib = "gstreamer" prefix = "gst" #}

-- | Gets the flags set on the clock.
clockGetFlags :: ClockClass clockT
              => clockT          -- ^ @clock@
              -> IO [ClockFlags] -- ^ the flags currently set on the clock
clockGetFlags = mkObjectGetFlags

-- | Sets the given flags on the clock.
clockSetFlags :: ClockClass clockT
              => clockT       -- ^ @clock@
              -> [ClockFlags] -- ^ @flags@ - the flags to be set
              -> IO ()
clockSetFlags = mkObjectSetFlags

-- | Unsets the given flags on the clock.
clockUnsetFlags :: ClockClass clockT
                => clockT       -- ^ @clock@
                -> [ClockFlags] -- ^ @flags@ - the flags to be unset
                -> IO ()
clockUnsetFlags = mkObjectUnsetFlags

-- | Returns 'True' if the given 'ClockTime' is valid, and 'False'
--   otherwise.
clockTimeIsValid :: ClockTime -- ^ @clockTime@
                 -> Bool      -- ^ 'True' if @clockTime@ is valid, 'False' otherwise
clockTimeIsValid = (/= clockTimeNone)

-- | The time master of the master clock and the time slave of the
--   slave clock are added to the list of observations. If enough
--   observations are available, a linear regression algorithm is run
--   on the observations and clock is recalibrated.
--
--   If a calibration is performed, the correlation coefficient of the
--   interpolation will be returned. A value of 1.0 means the clocks
--   are in perfect sync. This value can be used to control the
--   sampling frequency of the master and slave clocks.
clockAddObservation :: ClockClass clock
                    => clock
                    -> ClockTime
                    -> ClockTime
                    -> IO (Maybe Double)
clockAddObservation clock slave master =
    alloca $ \rSquaredPtr ->
        do success <- {# call clock_add_observation #} (toClock clock)
                                                       (fromIntegral slave)
                                                       (fromIntegral master)
                                                       rSquaredPtr
           if toBool success
               then liftM (Just . realToFrac) $ peek rSquaredPtr
               else return Nothing

-- | Set @master@ as the master clock for @clock@. The @clock@ will
--   automatically be calibrated so that 'clockGetTime' reports the
--   same time as the @master@ clock.
--
--   A clock provider that slaves its clock to a master can get the
--   current calibration values with 'clockGetCalibration'.
--
--   The @master@ clock can be 'Nothing' in which case @clock@ will
--   not be slaved any longer. It will, however, continue to report
--   its time adjusted using the last configured rate and time
--   offsets.
--
--   Note that if @clock@ does not have the 'ClockFlagCanSetMaster'
--   flag set, this function will not succeed and return 'False'.
clockSetMaster :: (ClockClass clock, ClockClass master)
               => clock        -- ^ @clock@
               -> Maybe master -- ^ @master@
               -> IO Bool      -- ^ 'True' if @clock@ is capable of
                               --   being slaved to the @master@ clock, otherwise 'False'
clockSetMaster clock master =
    withObject (toClock clock) $ \clockPtr ->
        maybeWith withObject (liftM toClock $ master) $ \masterPtr ->
            liftM toBool $ gst_clock_set_master clockPtr masterPtr
    where
      _ = {# call clock_set_master #}

-- | Return the master that @clock@ is slaved to, or 'Nothing' if
--   @clock@ is not slaved.
clockGetMaster :: ClockClass clock
               => clock            -- ^ @clock@
               -> IO (Maybe Clock) -- ^ the master that @clock@ is slaved to, or 'Nothing'
clockGetMaster clock =
    {# call clock_get_master #} (toClock clock) >>= maybePeek takeObject

-- | Set the resolution of @clock@. Some clocks have the possibility
--   to operate with different resolution at the expense of more
--   resource usage. There is normally no need to change the default
--   resolution of a clock. The resolution of a clock can only be
--   changed if the clock has the 'ClockFlagCanSetResolution' flag
--   set.
clockSetResolution :: ClockClass clock
                   => clock
                   -> ClockTime
                   -> IO ClockTime
clockSetResolution clock resolution =
    liftM fromIntegral $
        {# call clock_set_resolution #} (toClock clock)
                                        (fromIntegral resolution)

-- | Get the resolution of the @clock@. The resolution of the clock is
--   the granularity of the values returned by 'clockGetTime'.
clockGetResolution :: ClockClass clock
                   => clock        -- ^ @clock@
                   -> IO ClockTime -- ^ the resolution currently set in @clock@
clockGetResolution clock =
    liftM fromIntegral $
        {# call clock_get_resolution #} (toClock clock)

-- | Gets the current time of @clock@. The time is always
--   monotonically increasing and adjusted according to the current
--   offset and rate.
clockGetTime :: ClockClass clock
             => clock        -- ^ @clock@
             -> IO ClockTime -- ^ the current time in @clock@
clockGetTime clock =
    liftM fromIntegral $
        {# call clock_get_time #} (toClock clock)

-- | Get a 'ClockID' from @clock@ to trigger a single shot
--   notification at the requested time.
clockNewSingleShotID :: ClockClass clock
                     => clock      -- ^ @clock@
                     -> ClockTime  -- ^ @clockTime@
                     -> IO ClockID -- ^ a single shot notification id triggered at @clockTime@
clockNewSingleShotID clock time =
    {# call clock_new_single_shot_id #} (toClock clock)
                                        (fromIntegral time) >>=
        takeClockID . castPtr

-- | Get a 'ClockID' from @clock@ to trigger periodic
--   notifications. The notifications will start at time @startTime@
--   and then be fired at each @interval@ after.
clockNewPeriodicID :: ClockClass clock
                   => clock      -- ^ @clock@
                   -> ClockTime  -- ^ @startTime@
                   -> ClockTime  -- ^ @interval@
                   -> IO ClockID -- ^ a periodic notification id
clockNewPeriodicID clock startTime interval =
    {# call clock_new_periodic_id #} (toClock clock)
                                     (fromIntegral startTime)
                                     (fromIntegral interval) >>=
        takeClockID . castPtr

-- | Gets the current internal time of @clock@. The time is
--   returned unadjusted in the offset and rate.
clockGetInternalTime :: ClockClass clock
                     => clock        -- ^ @clock@
                     -> IO ClockTime -- ^ the clock's internal time value
clockGetInternalTime clock =
    liftM fromIntegral $
        {# call clock_get_internal_time #} (toClock clock)

-- | Gets the internal rate and reference time of @clock@. See
--   'clockSetCalibration' for more information.
clockGetCalibration :: ClockClass clock
                    => clock -- ^ @clock@
                    -> IO (ClockTime, ClockTime, Ratio ClockTime)
                       -- ^ the clock's internal time, external (adjusted) time, and skew rate
clockGetCalibration clock =
    alloca $ \internalPtr ->
        alloca $ \externalPtr ->
            alloca $ \rateNumPtr ->
                alloca $ \rateDenomPtr ->
                    do {# call clock_get_calibration #} (toClock clock)
                                                        internalPtr
                                                        externalPtr
                                                        rateNumPtr
                                                        rateDenomPtr
                       liftM4 (\a b c d ->
                               (fromIntegral a,
                                fromIntegral b,
                                fromIntegral c % fromIntegral d))
                              (peek internalPtr)
                              (peek externalPtr)
                              (peek rateNumPtr)
                              (peek rateDenomPtr)

-- | Adjusts the rate and time of clock. A rate of @1 % 1@ is the
--   normal speed of the clock. Larger values make the clock go
--   faster.
--
--   The parameters @internal@ and @external@ specifying that
--   'clockGetTime' should have returned @external@ when the clock had
--   internal time @internal@. The parameter @internal@ should not be
--   in the future; that is, it should be less than the value returned
--   by 'clockGetInternalTime' when this function is called.
--
--   Subsequent calls to 'clockGetTime' will return clock times
--   computed as follows:
--
--   > (clock_internal - internal) * rate + external
--
--   Note that 'clockGetTime' always returns increasing values, so if
--   the clock is moved backwards, 'clockGetTime' will report the
--   previous value until the clock catches up.
clockSetCalibration :: ClockClass clock
                    => clock           -- ^ @clock@
                    -> ClockTime       -- ^ @internal@
                    -> ClockTime       -- ^ @external@
                    -> Ratio ClockTime -- ^ @rate@
                    -> IO ()
clockSetCalibration clock internal external rate =
    {# call clock_set_calibration #} (toClock clock)
                                     (fromIntegral internal)
                                     (fromIntegral external)
                                     (fromIntegral $ numerator rate)
                                     (fromIntegral $ denominator rate)

-- | Get the time of @clockID@.
clockIDGetTime :: ClockID      -- ^ @clockID@
               -> IO ClockTime
clockIDGetTime clockID =
    liftM fromIntegral $ withClockID clockID $
        {# call clock_id_get_time #} . castPtr

-- | Perform a blocking wait on @clockID@. The parameter @clockID@
--   should have been created with 'clockNewSingleShotID' or
--   'clockNewPeriodicID', and should not been unscheduled with a call
--   to 'clockIDUnschedule'.
--
--   If second value in the returned pair is not 'Nothing', it will
--   contain the difference against the clock and the time of
--   @clockID@ when this method was called. Positive values indicate
--   how late @clockID@ was relative to the clock. Negative values
--   indicate how much time was spend waiting on the clock before the
--   function returned.
clockIDWait :: ClockID -- ^ @clockID@
            -> IO (ClockReturn, Maybe ClockTimeDiff)
clockIDWait clockID =
    alloca $ \jitterPtr ->
        do result <- liftM cToEnum $ withClockID clockID $ \clockIDPtr ->
                         {# call clock_id_wait #} (castPtr clockIDPtr) jitterPtr
           jitter <- let peekJitter = liftM (Just . fromIntegral) $ peek jitterPtr
                     in case result of
                          ClockOk -> peekJitter
                          ClockEarly -> peekJitter
                          _ -> return Nothing
           return (result, jitter)

-- | Cancel an outstanding request with @clockID@. After this call,
--   @clockID@ cannot be used anymore to recieve notifications; you
--   must create a new 'ClockID'.
clockIDUnschedule :: ClockID -- ^ @clockID@
                  -> IO ()
clockIDUnschedule clockID =
    withClockID clockID $ {# call clock_id_unschedule #} . castPtr

clockTimeout :: ClockClass clockT
             => Attr clockT ClockTime
clockTimeout = newAttr
    (objectGetPropertyUInt64 "timeout")
    (objectSetPropertyUInt64 "timeout")

clockWindowSize :: ClockClass clockT
                => Attr clockT Int
clockWindowSize =
    newAttrFromIntProperty "window-size"

clockWindowThreshold :: ClockClass clockT
                     => Attr clockT Int
clockWindowThreshold =
    newAttrFromIntProperty "window-threshold"

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  This library is free software: you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public License
--  as published by the Free Software Foundation, either version 3 of
--  the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GStreamer, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GStreamer documentation.
--
-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net
--   Stability   : alpha
--   Portability : portable (depends on GHC)
module Media.Streaming.GStreamer.Core.Clock (

  Clock,
  ClockClass,
  castToClock,
  toClock,

  ClockTime,
  clockTimeNone,
  clockTimeIsValid,
  second,
  msecond,
  usecond,
  nsecond,

  ClockTimeDiff,
  ClockReturn(..),
  ClockID,

  ClockFlags(..),
  clockGetFlags,
  clockSetFlags,
  clockUnsetFlags,

  clockAddObservation,
  clockSetMaster,
  clockGetMaster,
  clockSetResolution,
  clockGetResolution,
  clockGetTime,
  clockNewSingleShotID,
  clockNewPeriodicID,
  clockGetInternalTime,
  clockGetCalibration,
  clockSetCalibration,
  clockIDGetTime,
  clockIDWait,
  clockIDUnschedule,

  clockTimeout,
  clockWindowSize,
  clockWindowThreshold

  ) where

import Data.Ratio ( Ratio
                  , (%)
                  , numerator
                  , denominator )
import Control.Monad (liftM, liftM4)
{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.FFI
import System.Glib.Attributes ( Attr
                              , newAttr )
import System.Glib.Properties

{# context lib = "gstreamer" prefix = "gst" #}

clockGetFlags :: ClockClass clockT
              => clockT
              -> IO [ClockFlags]
clockGetFlags = mkObjectGetFlags

clockSetFlags :: ClockClass clockT
              => clockT
              -> [ClockFlags]
              -> IO ()
clockSetFlags = mkObjectSetFlags

clockUnsetFlags :: ClockClass clockT
                => clockT
                -> [ClockFlags]
                -> IO ()
clockUnsetFlags = mkObjectUnsetFlags

clockTimeIsValid :: ClockTime
                 -> Bool
clockTimeIsValid = (/= clockTimeNone)

clockAddObservation :: ClockClass clock
                    => clock
                    -> ClockTime
                    -> ClockTime
                    -> IO (Maybe Double)
clockAddObservation clock slave master =
    alloca $ \rSquaredPtr ->
        do success <- {# call clock_add_observation #} (toClock clock)
                                                       (fromIntegral slave)
                                                       (fromIntegral master)
                                                       rSquaredPtr
           if toBool success
               then liftM (Just . realToFrac) $ peek rSquaredPtr
               else return Nothing

clockSetMaster :: (ClockClass clock, ClockClass master)
               => clock
               -> master
               -> IO Bool
clockSetMaster clock master =
    liftM toBool $ {# call clock_set_master #} (toClock clock) (toClock master)

clockGetMaster :: ClockClass clock
               => clock
               -> IO (Maybe Clock)
clockGetMaster clock =
    {# call clock_get_master #} (toClock clock) >>= maybePeek takeObject

clockSetResolution :: ClockClass clock
                   => clock
                   -> ClockTime
                   -> IO ClockTime
clockSetResolution clock resolution =
    liftM fromIntegral $
        {# call clock_set_resolution #} (toClock clock)
                                        (fromIntegral resolution)

clockGetResolution :: ClockClass clock
                   => clock
                   -> IO ClockTime
clockGetResolution clock =
    liftM fromIntegral $
        {# call clock_get_resolution #} (toClock clock)

clockGetTime :: ClockClass clock
             => clock
             -> IO ClockTime
clockGetTime clock =
    liftM fromIntegral $
        {# call clock_get_time #} (toClock clock)

clockNewSingleShotID :: ClockClass clock
                     => clock
                     -> ClockTime
                     -> IO ClockID
clockNewSingleShotID clock time =
    {# call clock_new_single_shot_id #} (toClock clock)
                                        (fromIntegral time) >>=
        takeClockID . castPtr

clockNewPeriodicID :: ClockClass clock
                   => clock
                   -> ClockTime
                   -> ClockTime
                   -> IO ClockID
clockNewPeriodicID clock startTime interval =
    {# call clock_new_periodic_id #} (toClock clock)
                                     (fromIntegral startTime)
                                     (fromIntegral interval) >>=
        takeClockID . castPtr

clockGetInternalTime :: ClockClass clock
                     => clock
                     -> IO ClockTime
clockGetInternalTime clock =
    liftM fromIntegral $
        {# call clock_get_internal_time #} (toClock clock)

clockGetCalibration :: ClockClass clock
                    => clock
                    -> IO (ClockTime, ClockTime, Ratio ClockTime)
clockGetCalibration clock =
    alloca $ \internalPtr ->
        alloca $ \externalPtr ->
            alloca $ \rateNumPtr ->
                alloca $ \rateDenomPtr ->
                    do {# call clock_get_calibration #} (toClock clock)
                                                        internalPtr
                                                        externalPtr
                                                        rateNumPtr
                                                        rateDenomPtr
                       liftM4 (\a b c d ->
                               (fromIntegral a,
                                fromIntegral b,
                                (fromIntegral c) % (fromIntegral d)))
                              (peek internalPtr)
                              (peek externalPtr)
                              (peek rateNumPtr)
                              (peek rateDenomPtr)

clockSetCalibration :: ClockClass clock
                    => clock
                    -> ClockTime
                    -> ClockTime
                    -> Ratio ClockTime
                    -> IO ()
clockSetCalibration clock internal external rate =
    {# call clock_set_calibration #} (toClock clock)
                                     (fromIntegral internal)
                                     (fromIntegral external)
                                     (fromIntegral $ numerator rate)
                                     (fromIntegral $ denominator rate)

clockIDGetTime :: ClockID
               -> IO ClockTime
clockIDGetTime clockID =
    liftM fromIntegral $ withClockID clockID $
        {# call clock_id_get_time #} . castPtr

clockIDWait :: ClockID
            -> IO (ClockReturn, ClockTimeDiff)
clockIDWait clockID =
    alloca $ \jitterPtr ->
        do result <- withClockID clockID $ \clockIDPtr ->
                         {# call clock_id_wait #} (castPtr clockIDPtr) jitterPtr
           jitter <- peek jitterPtr
           return $ (cToEnum result, fromIntegral jitter)

clockIDUnschedule :: ClockID
                  -> IO ()
clockIDUnschedule clockID =
    withClockID clockID $ {# call clock_id_unschedule #} . castPtr

clockTimeout :: ClockClass clockT
             => Attr clockT ClockTime
clockTimeout = newAttr
    (objectGetPropertyUInt64 "timeout")
    (objectSetPropertyUInt64 "timeout")

clockWindowSize :: ClockClass clockT
                => Attr clockT Int
clockWindowSize =
    newAttrFromIntProperty "window-size"

clockWindowThreshold :: ClockClass clockT
                     => Attr clockT Int
clockWindowThreshold =
    newAttrFromIntProperty "window-threshold"


Add support for constants of Float and Bool types

module GI.Value
    ( Value(..)
    , fromArgument
    , valueType
    ) where

import Control.Applicative ((<$>))
import Data.Int
import Data.Word
import Foreign (peekByteOff,Ptr)
import Foreign.C
import System.IO.Unsafe (unsafePerformIO)

import GI.Type
import GI.Internal.Types

#include <girepository.h>

data Value
    = VVoid
    | VBoolean Bool
    | VInt8 Int8
    | VUInt8 Word8
    | VInt16 Int16
    | VUInt16 Word16
    | VInt32 Int32
    | VUInt32 Word32
    | VInt64 Int64
    | VUInt64 Word64
    | VFloat Float
    | VDouble Double
    | VGType Word32
    | VUTF8 String
    | VFileName String
    deriving (Eq, Show)

valueType :: Value -> Type
valueType VVoid           = TBasicType TVoid
valueType (VBoolean _)    = TBasicType TBoolean
valueType (VInt8 _)       = TBasicType TInt8
valueType (VUInt8 _)      = TBasicType TUInt8
valueType (VInt16 _)      = TBasicType TInt16
valueType (VUInt16 _)     = TBasicType TUInt16
valueType (VInt32 _)      = TBasicType TInt32
valueType (VUInt32 _)     = TBasicType TUInt32
valueType (VInt64 _)      = TBasicType TInt64
valueType (VUInt64 _)     = TBasicType TUInt64
valueType (VFloat _)      = TBasicType TFloat
valueType (VDouble _)     = TBasicType TDouble
valueType (VGType _)      = TBasicType TGType
valueType (VUTF8 _)       = TBasicType TUTF8
valueType (VFileName _)   = TBasicType TFileName

fromArgument :: TypeInfo -> Argument -> Value
fromArgument ti (Argument arg) =
    case typeFromTypeInfo ti of
        TBasicType t -> unsafePerformIO $ basic t
        t -> error $ "don't know how to decode argument of type " ++
                show t

    where

    basic TInt8 = VInt8 <$> fromIntegral <$> {# get GIArgument->v_int8 #} arg
    basic TUInt8 = VUInt8 <$> fromIntegral <$> {# get GIArgument->v_uint8 #} arg
    basic TInt16 = VInt16 <$> fromIntegral <$> {# get GIArgument->v_int16 #} arg
    basic TUInt16 = VUInt16 <$> fromIntegral <$> {# get GIArgument->v_uint16 #} arg
    basic TInt32 = VInt32 <$> fromIntegral <$> {# get GIArgument->v_int32 #} arg
    basic TUInt32 = VUInt32 <$> fromIntegral <$> {# get GIArgument->v_uint32 #} arg
    basic TInt64 = VInt64 <$> fromIntegral <$> {# get GIArgument->v_int64 #} arg
    basic TUInt64 = VUInt64 <$> fromIntegral <$> {# get GIArgument->v_uint64 #} arg
    basic TBoolean = VBoolean <$> (/= 0) <$> {# get GIArgument->v_boolean #} arg
    -- XXX: Loss of precision?
    basic TFloat = VFloat <$> fromRational <$> toRational <$>  {# get GIArgument->v_float #} arg
    -- XXX: Loss of precision?
    basic TDouble = VDouble <$> fromRational <$> toRational <$>  {# get GIArgument->v_double #} arg
    basic TUTF8 = VUTF8 <$> (peekCString =<< {# get GIArgument->v_string #} arg)
    basic t = error $ "a: implement me: " ++ show t

module GI.Value
    ( Value(..)
    , fromArgument
    , valueType
    ) where

import Control.Applicative ((<$>))
import Data.Int
import Data.Word
import Foreign (peekByteOff,Ptr)
import Foreign.C
import System.IO.Unsafe (unsafePerformIO)

import GI.Type
import GI.Internal.Types

#include <girepository.h>

data Value
    = VVoid
    | VBoolean Bool
    | VInt8 Int8
    | VUInt8 Word8
    | VInt16 Int16
    | VUInt16 Word16
    | VInt32 Int32
    | VUInt32 Word32
    | VInt64 Int64
    | VUInt64 Word64
    | VFloat Float
    | VDouble Double
    | VGType Word32
    | VUTF8 String
    | VFileName String
    deriving (Eq, Show)

valueType :: Value -> Type
valueType VVoid           = TBasicType TVoid
valueType (VBoolean _)    = TBasicType TBoolean
valueType (VInt8 _)       = TBasicType TInt8
valueType (VUInt8 _)      = TBasicType TUInt8
valueType (VInt16 _)      = TBasicType TInt16
valueType (VUInt16 _)     = TBasicType TUInt16
valueType (VInt32 _)      = TBasicType TInt32
valueType (VUInt32 _)     = TBasicType TUInt32
valueType (VInt64 _)      = TBasicType TInt64
valueType (VUInt64 _)     = TBasicType TUInt64
valueType (VFloat _)      = TBasicType TFloat
valueType (VDouble _)     = TBasicType TDouble
valueType (VGType _)      = TBasicType TGType
valueType (VUTF8 _)       = TBasicType TUTF8
valueType (VFileName _)   = TBasicType TFileName

fromArgument :: TypeInfo -> Argument -> Value
fromArgument ti (Argument arg) =
    case typeFromTypeInfo ti of
        TBasicType t -> unsafePerformIO $ basic t
        t -> error $ "don't know how to decode argument of type " ++
                show t

    where

    basic TInt8 = VInt8 <$> fromIntegral <$> {# get GIArgument->v_int8 #} arg
    basic TUInt8 = VUInt8 <$> fromIntegral <$> {# get GIArgument->v_uint8 #} arg
    basic TInt16 = VInt16 <$> fromIntegral <$> {# get GIArgument->v_int16 #} arg
    basic TUInt16 = VUInt16 <$> fromIntegral <$> {# get GIArgument->v_uint16 #} arg
    basic TInt32 = VInt32 <$> fromIntegral <$> {# get GIArgument->v_int32 #} arg
    basic TUInt32 = VUInt32 <$> fromIntegral <$> {# get GIArgument->v_uint32 #} arg
    basic TInt64 = VInt64 <$> fromIntegral <$> {# get GIArgument->v_int64 #} arg
    basic TUInt64 = VUInt64 <$> fromIntegral <$> {# get GIArgument->v_uint64 #} arg
    -- XXX: Loss of precision?
    basic TDouble = VDouble <$> fromRational <$> toRational <$>  {# get GIArgument->v_double #} arg
    basic TUTF8 = VUTF8 <$> (peekCString =<< {# get GIArgument->v_string #} arg)
    basic t = error $ "a: implement me: " ++ show t


[project @ 2003-11-03 14:21:54 by juhp] Emacs file variables only work on the first line.

{-# OPTIONS -cpp #-}  -- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry TextIter TextBuffer@
--
--  Author : Axel Simon
--
--  Created: 23 February 2002
--
--  Version $Revision: 1.11 $ from $Date: 2003/11/03 14:21:54 $
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
--   * An iterator is an abstract datatype representing a pointer into a
--     @ref data TextBuffer@.
--
-- @documentation@ ------------------------------------------------------------
--
-- * The following functions do not make sense due to Haskell's wide character
--   representation of Unicode:
--     gtk_text_iter_get_line_index
--     gtk_text_iter_get_visible_line_index
--     gtk_text_iter_get_bytes_in_line
--     gtk_text_iter_set_line_index
--     gtk_text_iter_set_visible_line_index
--
-- * The functions gtk_text_iter_in_range and gtk_text_iter_order are not bound
--   because they are only convenience functions which can replaced by calls
--   to textIterCompare.
--
-- * All offsets are counted from 0.
--
-- @todo@ ---------------------------------------------------------------------
--
-- * Bind the following function when GSList is bound:
--     gtk_text_iter_get_marks
--     gtk_text_iter_get_toggled_tags
--     gtk_text_iter_get_tags
--
-- * Bind the following functions when we are sure about anchors
--   (see @ref data TextBuffer@):
--     gtk_text_iter_get_anchor
--
-- * Bind TextAttribute functions when I am clear how to model them.
--     gtk_text_iter_get_attribute
--
-- * Forward exceptions in the two callback functions.
--
module TextIter(
  TextIter(TextIter),
  mkTextIter,
  makeEmptyTextIter,	-- for internal use only
  textIterGetBuffer,
  textIterCopy,
  textIterGetOffset,
  textIterGetLine,
  textIterGetLineOffset,
  textIterGetVisibleLineOffset,
  textIterGetChar,
  textIterGetSlice,
  textIterGetText,
  textIterGetVisibleSlice,
  textIterGetVisibleText,
  textIterGetPixbuf,
  textIterBeginsTag,
  textIterEndsTag,
  textIterTogglesTag,
  textIterHasTag,
  textIterEditable,
  textIterCanInsert,
  textIterStartsWord,
  textIterEndsWord,
  textIterInsideWord,
  textIterStartsLine,
  textIterEndsLine,
  textIterStartsSentence,
  textIterEndsSentence,
  textIterInsideSentence,
  textIterIsCursorPosition,
  textIterGetCharsInLine,
  textIterIsEnd,
  textIterIsStart,
  textIterForwardChar,
  textIterBackwardChar,
  textIterForwardChars,
  textIterBackwardChars,
  textIterForwardLine,
  textIterBackwardLine,
  textIterForwardLines,
  textIterBackwardLines,
  textIterForwardWordEnds,
  textIterBackwardWordStarts,
  textIterForwardWordEnd,
  textIterBackwardWordStart,
  textIterForwardCursorPosition,
  textIterBackwardCursorPosition,
  textIterForwardCursorPositions,
  textIterBackwardCursorPositions,
  textIterForwardSentenceEnds,
  textIterBackwardSentenceStarts,
  textIterForwardSentenceEnd,
  textIterBackwardSentenceStart,
  textIterSetOffset,
  textIterSetLine,
  textIterSetLineOffset,
  textIterSetVisibleLineOffset,
  textIterForwardToEnd,
  textIterForwardToLineEnd,
  textIterForwardToTagToggle,
  textIterBackwardToTagToggle,
  textIterForwardFindChar,
  textIterBackwardFindChar,
  textIterForwardSearch,
  textIterBackwardSearch,
  textIterEqual,
  textIterCompare
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)
import Char	(chr)
import FFI
import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import Signal#}
import Structs  (textIterSize)
import Enums	(TextSearchFlags, Flags(fromFlags))

{# context lib="gtk" prefix="gtk" #}

-- methods

{#pointer *TextIter foreign newtype #}

-- Create a TextIter from a pointer.
--
mkTextIter :: Ptr TextIter -> IO TextIter
mkTextIter iterPtr = liftM TextIter $
  newForeignPtr iterPtr (text_iter_free iterPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_text_iter_free"
  text_iter_free' :: FinalizerPtr TextIter

text_iter_free :: Ptr TextIter -> FinalizerPtr TextIter
text_iter_free _ = text_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_text_iter_free"
  text_iter_free :: Ptr TextIter -> IO ()

#else

foreign import ccall "gtk_text_iter_free" unsafe
  text_iter_free :: Ptr TextIter -> IO ()

#endif

-- Allocate memory to be filled with a TextIter.
--
makeEmptyTextIter :: IO TextIter
makeEmptyTextIter = do
  iterPtr <- mallocBytes textIterSize
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- @method textIterGetBuffer@ Return the @ref type TextBuffer@ this iterator
-- is associated with.
--
textIterGetBuffer :: TextIter -> IO TextBuffer
textIterGetBuffer ti = makeNewGObject mkTextBuffer $
  {#call unsafe text_iter_get_buffer#} ti

-- @method textIterCopy@ Copy the iterator.
--
textIterCopy :: TextIter -> IO TextIter
textIterCopy ti = do
  iterPtr <- {#call unsafe text_iter_copy#} ti
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- @method textIterGetOffset@ Extract the offset relative to the beginning of
-- the buffer.
--
textIterGetOffset :: TextIter -> IO Int
textIterGetOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_offset#} ti

-- @method textIterGetLine@ Extract the line of the buffer.
--
textIterGetLine :: TextIter -> IO Int
textIterGetLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line#} ti

-- @method textIterGetLineOffset@ Extract the offset relative to the beginning
-- of the line.
--
textIterGetLineOffset :: TextIter -> IO Int
textIterGetLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line_offset#} ti

-- @method textIterGetVisibleLineOffset@ Extract the offset relative to the
-- beginning of the line skipping invisible parts of the line.
--
textIterGetVisibleLineOffset :: TextIter -> IO Int
textIterGetVisibleLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_visible_line_offset#} ti

-- @method textIterGetChar@ Return the character at this iterator.
--
textIterGetChar :: TextIter -> IO (Maybe Char)
textIterGetChar ti = do
  (res::Int) <- liftM fromIntegral $ {#call unsafe text_iter_get_char#} ti
  return $ if res==0 then Nothing else Just (chr res)

-- @method textIterGetSlice@ Return the text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetSlice :: TextIter -> TextIter -> IO String
textIterGetSlice end start = do
  cStr <- {#call text_iter_get_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- @method textIterGetText@ Return the text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetText :: TextIter -> TextIter -> IO String
textIterGetText start end = do
  cStr <- {#call text_iter_get_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- @method textIterGetVisibleSlice@ Return the visible text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetVisibleSlice :: TextIter -> TextIter -> IO String
textIterGetVisibleSlice start end = do
  cStr <- {#call text_iter_get_visible_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- @method textIterGetVisibleText@ Return the visible text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetVisibleText :: TextIter -> TextIter -> IO String
textIterGetVisibleText start end = do
  cStr <- {#call text_iter_get_visible_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- @method textIterGetPixbuf@ Get the @ref data Pixbuf@ under the iterator.
--
textIterGetPixbuf :: TextIter -> IO (Maybe Pixbuf)
textIterGetPixbuf it = do
  pbPtr <- {#call unsafe text_iter_get_pixbuf#} it
  if pbPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pbPtr)

-- @method textIterBeginsTag@ Query whether a @ref type TextIter@ is at the
-- start of a @ref type TextTag@.
--
textIterBeginsTag :: TextIter -> TextTag -> IO Bool
textIterBeginsTag ti tt = liftM toBool $
  {#call unsafe text_iter_begins_tag#} ti tt

-- @method textIterEndsTag@ Query whether a @ref type TextIter@ is at the end
-- of a @ref type TextTag@.
--
textIterEndsTag :: TextIter -> TextTag -> IO Bool
textIterEndsTag ti tt = liftM toBool $
  {#call unsafe text_iter_ends_tag#} ti tt

-- @method textIterTogglesTag@ Query if the @ref type TextIter@ is at the
-- beginning or the end of a @ref type TextTag@.
--
textIterTogglesTag :: TextIter -> TextTag -> IO Bool
textIterTogglesTag ti tt = liftM toBool $
  {#call unsafe text_iter_toggles_tag#} ti tt

-- @method textIterHasTag@ Check if @ref type TextIter@ is within a range
-- tagged with tag.
--
textIterHasTag :: TextIter -> TextTag -> IO Bool
textIterHasTag ti tt = liftM toBool $
  {#call unsafe text_iter_has_tag#} ti tt

-- @method textIterEditable@ Check if @ref type TextIter@ is within an
-- editable region.
--
-- * If no tags that affect editability are attached to the current position
--   @ref arg def@ will be returned.
--
-- * This function cannot be used to decide whether text can be inserted at
--   @ref type TextIter@. Use the @ref method textIterCanInsert@ function for
--   this purpose.
--
textIterEditable :: TextIter -> Bool -> IO Bool
textIterEditable ti def = liftM toBool $
  {#call unsafe text_iter_editable#} ti (fromBool def)

-- @method textIterCanInsert@ Check if new text can be inserted at
-- @ref type TextIter@.
--
-- * Use @ref method textBufferInsertInteractive@ if you want to insert text
--   depending on the current editable status.
--
textIterCanInsert :: TextIter -> Bool -> IO Bool
textIterCanInsert ti def = liftM toBool $
  {#call unsafe text_iter_can_insert#} ti (fromBool def)

-- @method textIterStartsWord@ Determine if @ref type TextIter@ begins a new
-- natural-language word.
--
textIterStartsWord :: TextIter -> IO Bool
textIterStartsWord ti = liftM toBool $ {#call unsafe text_iter_starts_word#} ti

-- @method textIterEndsWord@ Determine if @ref type TextIter@ ends a new
-- natural-language word.
--
textIterEndsWord :: TextIter -> IO Bool
textIterEndsWord ti = liftM toBool $ {#call unsafe text_iter_ends_word#} ti

-- @method textIterInsideWord@ Determine if @ref type TextIter@ is inside a
-- word.
--
textIterInsideWord :: TextIter -> IO Bool
textIterInsideWord ti = liftM toBool $ {#call unsafe text_iter_inside_word#} ti

-- @method textIterStartsLine@ Determine if @ref type TextIter@ begins a new
-- line.
--
textIterStartsLine :: TextIter -> IO Bool
textIterStartsLine ti = liftM toBool $ {#call unsafe text_iter_starts_line#} ti

-- @method textIterEndsLine@ Determine if @ref type TextIter@ point to the
-- beginning of a line delimiter.
--
-- * Returns False if @ref type TextIter@ points to the \n in a \r\n sequence.
--
textIterEndsLine :: TextIter -> IO Bool
textIterEndsLine ti = liftM toBool $ {#call unsafe text_iter_ends_line#} ti

-- @method textIterStartsSentence@ Determine if @ref type TextIter@ starts a
-- sentence.
--
textIterStartsSentence :: TextIter -> IO Bool
textIterStartsSentence ti = liftM toBool $
  {#call unsafe text_iter_starts_sentence#} ti

-- @method textIterEndsSentence@ Determine if @ref type TextIter@ ends a
-- sentence.
--
textIterEndsSentence :: TextIter -> IO Bool
textIterEndsSentence ti = liftM toBool $
  {#call unsafe text_iter_ends_sentence#} ti

-- @method textIterInsideSentence@ Determine if @ref type TextIter@ is inside
-- a sentence.
--
textIterInsideSentence :: TextIter -> IO Bool
textIterInsideSentence ti = liftM toBool $
  {#call unsafe text_iter_inside_sentence#} ti

-- @method textIterIsCursorPosition@ Determine if @ref type TextIter@ is at a
-- cursor position.
--
textIterIsCursorPosition :: TextIter -> IO Bool
textIterIsCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_is_cursor_position#} ti

-- @method textIterGetCharsInLine@ Return number of characters in this line.
--
-- * The return value includes delimiters.
--
textIterGetCharsInLine :: TextIter -> IO Int
textIterGetCharsInLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_chars_in_line#} ti

-- @method textIterGetAttributes@ Get the text attributes at the iterator.
--
-- * The @ref arg ta@ argument gives the default values if no specific
--   attributes are set at that specific location.
--
-- * The function returns @literal Nothing@ if the text at the iterator has
--   the same attributes.
textIterGetAttributes = undefined

-- @method textIterIsEnd@ Determine if @ref type TextIter@ is at the end of
-- the buffer.
--
textIterIsEnd :: TextIter -> IO Bool
textIterIsEnd ti = liftM toBool $
  {#call unsafe text_iter_is_end#} ti

-- @method textIterIsStart@ Determine if @ref type TextIter@ is at the
-- beginning of the buffer.
--
textIterIsStart :: TextIter -> IO Bool
textIterIsStart ti = liftM toBool $
  {#call unsafe text_iter_is_start#} ti

-- @method textIterForwardChar@ Move @ref type TextIter@ forwards.
--
-- * Retuns True if the iterator is pointing to a character.
--
textIterForwardChar :: TextIter -> IO Bool
textIterForwardChar ti = liftM toBool $
  {#call unsafe text_iter_forward_char#} ti

-- @method textIterBackwardChar@ Move @ref type TextIter@ backwards.
--
-- * Retuns True if the movement was possible.
--
textIterBackwardChar :: TextIter -> IO Bool
textIterBackwardChar ti = liftM toBool $
  {#call unsafe text_iter_backward_char#} ti

-- @method textIterForwardChars@ Move @ref type TextIter@ forwards by
-- @ref arg n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterForwardChars :: TextIter -> Int -> IO Bool
textIterForwardChars ti n = liftM toBool $
  {#call unsafe text_iter_forward_chars#} ti (fromIntegral n)

-- @method textIterBackwardChars@ Move @ref type TextIter@ backwards by
-- @ref arg n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterBackwardChars :: TextIter -> Int -> IO Bool
textIterBackwardChars ti n = liftM toBool $
  {#call unsafe text_iter_backward_chars#} ti (fromIntegral n)

-- @method textIterForwardLine@ Move @ref type TextIter@ forwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If @ref type TextIter@ is on the first line, it will be moved to the
--   beginning of the buffer.
--
textIterForwardLine :: TextIter -> IO Bool
textIterForwardLine ti = liftM toBool $
  {#call unsafe text_iter_forward_line#} ti

-- @method textIterBackwardLine@ Move @ref type TextIter@ backwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If @ref type TextIter@ is on the first line, it will be moved to the end
--   of the buffer.
--
textIterBackwardLine :: TextIter -> IO Bool
textIterBackwardLine ti = liftM toBool $
  {#call unsafe text_iter_backward_line#} ti

-- @method textIterForwardLines@ Move @ref type TextIter@ forwards by
-- @ref arg n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If @ref type TextIter@ is on the first line, it will be moved to the
--   beginning of the buffer.
--
-- * @ref arg n@ can be negative.
--
textIterForwardLines :: TextIter -> Int -> IO Bool
textIterForwardLines ti n = liftM toBool $
  {#call unsafe text_iter_forward_lines#} ti (fromIntegral n)

-- @method textIterBackwardLines@ Move @ref type TextIter@ backwards by
-- @ref arg n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If @ref type TextIter@ is on the first line, it will be moved to the end
--   of the buffer.
--
-- * @ref arg n@ can be negative.
--
textIterBackwardLines :: TextIter -> Int -> IO Bool
textIterBackwardLines ti n = liftM toBool $
  {#call unsafe text_iter_backward_lines#} ti (fromIntegral n)

-- @method textIterForwardWordEnds@ Move @ref type TextIter@ forwards by
-- @ref arg n@ word ends.
--
-- * Retuns True if the iterator is pointing to a new word end.
--
textIterForwardWordEnds :: TextIter -> Int -> IO Bool
textIterForwardWordEnds ti n = liftM toBool $
  {#call unsafe text_iter_forward_word_ends#} ti (fromIntegral n)

-- @method textIterBackwardWordStarts@ Move @ref type TextIter@ backwards by
-- @ref arg n@ word beginnings.
--
-- * Retuns True if the iterator is pointing to a new word start.
--
textIterBackwardWordStarts :: TextIter -> Int -> IO Bool
textIterBackwardWordStarts ti n = liftM toBool $
  {#call unsafe text_iter_backward_word_starts#} ti (fromIntegral n)

-- @method textIterForwardWordEnd@ Move @ref type TextIter@ forwards to the
-- next word end.
--
-- * Retuns True if the iterator has moved to a new word end.
--
textIterForwardWordEnd :: TextIter -> IO Bool
textIterForwardWordEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_word_end#} ti

-- @method textIterBackwardWordStart@ Move @ref type TextIter@ backwards to
-- the next word beginning.
--
-- * Retuns True if the iterator has moved to a new word beginning.
--
textIterBackwardWordStart :: TextIter -> IO Bool
textIterBackwardWordStart ti = liftM toBool $
  {#call unsafe text_iter_backward_word_start#} ti

-- @method textIterForwardCursorPosition@ Move @ref type TextIter@ forwards to
-- the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that @ref type TextIter@ does not point inbetween such double characters.
--
-- * Returns True if @ref type TextIter@ moved and points to a character (not
--   to an object).
--
textIterForwardCursorPosition :: TextIter -> IO Bool
textIterForwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_forward_cursor_position#} ti

-- @method textIterBackwardCursorPosition@ Move @ref type TextIter@ backwards
-- to the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that @ref type TextIter@ does not point inbetween such double characters.
--
-- * Returns True if @ref type TextIter@ moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPosition :: TextIter -> IO Bool
textIterBackwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_backward_cursor_position#} ti

-- @method textIterForwardCursorPositions@ Move @ref type TextIter@ forwards
-- by @ref arg n@ cursor positions.
--
-- * Returns True if @ref type TextIter@ moved and points to a character (not
--   to an object).
--
textIterForwardCursorPositions :: TextIter -> Int -> IO Bool
textIterForwardCursorPositions ti n = liftM toBool $
  {#call unsafe text_iter_forward_cursor_positions#} ti (fromIntegral n)

-- @method textIterBackwardCursorPositions@ Move @ref type TextIter@ backwards
-- by @ref arg n@ cursor positions.
--
-- * Returns True if @ref type TextIter@ moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPositions :: TextIter -> Int -> IO Bool
textIterBackwardCursorPositions ti n = liftM toBool $
  {#call unsafe text_iter_backward_cursor_positions#} ti (fromIntegral n)

-- @method textIterForwardSentenceEnds@ Move @ref type TextIter@ forwards by
-- @ref arg n@ sentence ends.
--
-- * Retuns True if the iterator is pointing to a new sentence end.
--
textIterForwardSentenceEnds :: TextIter -> Int -> IO Bool
textIterForwardSentenceEnds ti n = liftM toBool $
  {#call unsafe text_iter_forward_sentence_ends#} ti (fromIntegral n)

-- @method textIterBackwardSentenceStarts@ Move @ref type TextIter@ backwards
-- by @ref arg n@ sentence beginnings.
--
-- * Retuns True if the iterator is pointing to a new sentence start.
--
textIterBackwardSentenceStarts :: TextIter -> Int -> IO Bool
textIterBackwardSentenceStarts ti n = liftM toBool $
  {#call unsafe text_iter_backward_sentence_starts#} ti (fromIntegral n)

-- @method textIterForwardSentenceEnd@ Move @ref type TextIter@ forwards to
-- the next sentence end.
--
-- * Retuns True if the iterator has moved to a new sentence end.
--
textIterForwardSentenceEnd :: TextIter -> IO Bool
textIterForwardSentenceEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_sentence_end#} ti

-- @method textIterBackwardSentenceStart@ Move @ref type TextIter@ backwards
-- to the next sentence beginning.
--
-- * Retuns True if the iterator has moved to a new sentence beginning.
--
textIterBackwardSentenceStart :: TextIter -> IO Bool
textIterBackwardSentenceStart ti = liftM toBool $
  {#call unsafe text_iter_backward_sentence_start#} ti

-- @method textIterSetOffset@ Set @ref type TextIter@ to an offset within the
-- buffer.
--
textIterSetOffset :: TextIter -> Int -> IO ()
textIterSetOffset ti n =
  {#call unsafe text_iter_set_offset#} ti (fromIntegral n)

-- @method textIterSetLine@ Set @ref type TextIter@ to a line within the
-- buffer.
--
textIterSetLine :: TextIter -> Int -> IO ()
textIterSetLine ti n =
  {#call unsafe text_iter_set_line#} ti (fromIntegral n)

-- @method textIterSetLineOffset@ Set @ref type TextIter@ to an offset within
-- the line.
--
textIterSetLineOffset :: TextIter -> Int -> IO ()
textIterSetLineOffset ti n =
  {#call unsafe text_iter_set_line_offset#} ti (fromIntegral n)

-- @method textIterSetVisibleLineOffset@ Set @ref type TextIter@ to an visible
-- character within the line.
--
textIterSetVisibleLineOffset :: TextIter -> Int -> IO ()
textIterSetVisibleLineOffset ti n =
  {#call unsafe text_iter_set_visible_line_offset#} ti (fromIntegral n)

-- @method textIterForwardToEnd@ Moves @ref type TextIter@ to the end of the
-- buffer.
--
textIterForwardToEnd :: TextIter -> IO ()
textIterForwardToEnd ti = {#call unsafe text_iter_forward_to_end#} ti

-- @method textIterForwardToLineEnd@ Moves @ref type TextIter@ to the end of
-- the line.
--
-- * Returns True if @ref type TextIter@ moved to a new location which is not
--   the buffer end iterator.
--
textIterForwardToLineEnd :: TextIter -> IO Bool
textIterForwardToLineEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_to_line_end#} ti

-- @method textIterForwardToTagToggle@ Moves @ref type TextIter@ forward to
-- the next change of a @ref type TextTag@.
--
-- * If Nothing is supplied, any @ref type TextTag@ will be matched.
--
-- * Returns True if there was a tag toggle after @ref type TextIter@.
--
textIterForwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterForwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_forward_to_tag_toggle#} ti
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- @method textIterBackwardToTagToggle@ Moves @ref type TextIter@ backward to
-- the next change of a @ref type TextTag@.
--
-- * If Nothing is supplied, any @ref type TextTag@ will be matched.
--
-- * Returns True if there was a tag toggle before @ref type TextIter@.
--
textIterBackwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterBackwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_backward_to_tag_toggle#} ti
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- Setup a callback for a predicate function.
--
type TextCharPredicateCB = Char -> Bool

{#pointer TextCharPredicate#}

#if __GLASGOW_HASKELL__>=600

foreign import ccall "wrapper" mkTextCharPredicate ::
  ({#type gunichar#} -> Ptr () -> {#type gboolean#}) -> IO TextCharPredicate

#else

foreign export dynamic mkTextCharPredicate ::
  ({#type gunichar#} -> Ptr () -> {#type gboolean#}) -> IO TextCharPredicate

#endif

-- @method textIterForwardFindChar@ Move @ref type TextIter@ forward until a
-- predicate function returns True.
--
-- * If @ref arg pred@ returns True before @ref arg limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @ref arg limit@ is Nothing, the search stops at the end of the buffer.
--
textIterForwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                           IO Bool
textIterForwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_forward_find_char#}
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- @method textIterBackwardFindChar@ Move @ref type TextIter@ backward until a
-- predicate function returns True.
--
-- * If @ref arg pred@ returns True before @ref arg limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @ref arg limit@ is Nothing, the search stops at the end of the buffer.
--
textIterBackwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                            IO Bool
textIterBackwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_backward_find_char#}
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- @method textIterForwardSearch@ Search forward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @ref arg limit@.
--
-- * @ref type TextSearchFlags@ may be empty.
--
-- * Returns the start and end position of the string found.
--
textIterForwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                         Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterForwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_forward_search#} ti cStr
    ((fromIntegral.fromFlags) flags) start end
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- @method textIterBackwardSearch@ Search backward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @ref arg limit@.
--
-- * @ref type TextSearchFlags@ my be empty.
--
-- * Returns the start and end position of the string found.
--
textIterBackwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                          Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterBackwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_backward_search#} ti cStr
    ((fromIntegral.fromFlags) flags) start end
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- @method textIterEqual@ Compare two @ref type TextIter@ for equality.
--
-- * @ref type TextIter@ could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This is done
--   the next abstraction layer.
--
textIterEqual :: TextIter -> TextIter -> IO Bool
textIterEqual ti2 ti1 = liftM toBool $ {#call unsafe text_iter_equal#} ti1 ti2

-- @method textIterCompare@ Compare two @ref type TextIter@.
--
-- * @ref type TextIter@ could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This could
--   be done the next abstraction layer.
--
textIterCompare :: TextIter -> TextIter -> IO Ordering
textIterCompare ti2 ti1 = do
  res <- {#call unsafe text_iter_compare#} ti1 ti2
  return $ case res of
    (-1)   -> LT
    0	   -> EQ
    1	   -> GT

{-# OPTIONS -cpp #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry TextIter TextBuffer@
--
--  Author : Axel Simon
--
--  Created: 23 February 2002
--
--  Version $Revision: 1.10 $ from $Date: 2003/10/21 21:28:53 $
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
--   * An iterator is an abstract datatype representing a pointer into a
--     @ref data TextBuffer@.
--
-- @documentation@ ------------------------------------------------------------
--
-- * The following functions do not make sense due to Haskell's wide character
--   representation of Unicode:
--     gtk_text_iter_get_line_index
--     gtk_text_iter_get_visible_line_index
--     gtk_text_iter_get_bytes_in_line
--     gtk_text_iter_set_line_index
--     gtk_text_iter_set_visible_line_index
--
-- * The functions gtk_text_iter_in_range and gtk_text_iter_order are not bound
--   because they are only convenience functions which can replaced by calls
--   to textIterCompare.
--
-- * All offsets are counted from 0.
--
-- @todo@ ---------------------------------------------------------------------
--
-- * Bind the following function when GSList is bound:
--     gtk_text_iter_get_marks
--     gtk_text_iter_get_toggled_tags
--     gtk_text_iter_get_tags
--
-- * Bind the following functions when we are sure about anchors
--   (see @ref data TextBuffer@):
--     gtk_text_iter_get_anchor
--
-- * Bind TextAttribute functions when I am clear how to model them.
--     gtk_text_iter_get_attribute
--
-- * Forward exceptions in the two callback functions.
--
module TextIter(
  TextIter(TextIter),
  mkTextIter,
  makeEmptyTextIter,	-- for internal use only
  textIterGetBuffer,
  textIterCopy,
  textIterGetOffset,
  textIterGetLine,
  textIterGetLineOffset,
  textIterGetVisibleLineOffset,
  textIterGetChar,
  textIterGetSlice,
  textIterGetText,
  textIterGetVisibleSlice,
  textIterGetVisibleText,
  textIterGetPixbuf,
  textIterBeginsTag,
  textIterEndsTag,
  textIterTogglesTag,
  textIterHasTag,
  textIterEditable,
  textIterCanInsert,
  textIterStartsWord,
  textIterEndsWord,
  textIterInsideWord,
  textIterStartsLine,
  textIterEndsLine,
  textIterStartsSentence,
  textIterEndsSentence,
  textIterInsideSentence,
  textIterIsCursorPosition,
  textIterGetCharsInLine,
  textIterIsEnd,
  textIterIsStart,
  textIterForwardChar,
  textIterBackwardChar,
  textIterForwardChars,
  textIterBackwardChars,
  textIterForwardLine,
  textIterBackwardLine,
  textIterForwardLines,
  textIterBackwardLines,
  textIterForwardWordEnds,
  textIterBackwardWordStarts,
  textIterForwardWordEnd,
  textIterBackwardWordStart,
  textIterForwardCursorPosition,
  textIterBackwardCursorPosition,
  textIterForwardCursorPositions,
  textIterBackwardCursorPositions,
  textIterForwardSentenceEnds,
  textIterBackwardSentenceStarts,
  textIterForwardSentenceEnd,
  textIterBackwardSentenceStart,
  textIterSetOffset,
  textIterSetLine,
  textIterSetLineOffset,
  textIterSetVisibleLineOffset,
  textIterForwardToEnd,
  textIterForwardToLineEnd,
  textIterForwardToTagToggle,
  textIterBackwardToTagToggle,
  textIterForwardFindChar,
  textIterBackwardFindChar,
  textIterForwardSearch,
  textIterBackwardSearch,
  textIterEqual,
  textIterCompare
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)
import Char	(chr)
import FFI
import GObject	(makeNewGObject)
{#import Hierarchy#}
{#import Signal#}
import Structs  (textIterSize)
import Enums	(TextSearchFlags, Flags(fromFlags))

{# context lib="gtk" prefix="gtk" #}

-- methods

{#pointer *TextIter foreign newtype #}

-- Create a TextIter from a pointer.
--
mkTextIter :: Ptr TextIter -> IO TextIter
mkTextIter iterPtr = liftM TextIter $
  newForeignPtr iterPtr (text_iter_free iterPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_text_iter_free"
  text_iter_free' :: FinalizerPtr TextIter

text_iter_free :: Ptr TextIter -> FinalizerPtr TextIter
text_iter_free _ = text_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_text_iter_free"
  text_iter_free :: Ptr TextIter -> IO ()

#else

foreign import ccall "gtk_text_iter_free" unsafe
  text_iter_free :: Ptr TextIter -> IO ()

#endif

-- Allocate memory to be filled with a TextIter.
--
makeEmptyTextIter :: IO TextIter
makeEmptyTextIter = do
  iterPtr <- mallocBytes textIterSize
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- @method textIterGetBuffer@ Return the @ref type TextBuffer@ this iterator
-- is associated with.
--
textIterGetBuffer :: TextIter -> IO TextBuffer
textIterGetBuffer ti = makeNewGObject mkTextBuffer $
  {#call unsafe text_iter_get_buffer#} ti

-- @method textIterCopy@ Copy the iterator.
--
textIterCopy :: TextIter -> IO TextIter
textIterCopy ti = do
  iterPtr <- {#call unsafe text_iter_copy#} ti
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- @method textIterGetOffset@ Extract the offset relative to the beginning of
-- the buffer.
--
textIterGetOffset :: TextIter -> IO Int
textIterGetOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_offset#} ti

-- @method textIterGetLine@ Extract the line of the buffer.
--
textIterGetLine :: TextIter -> IO Int
textIterGetLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line#} ti

-- @method textIterGetLineOffset@ Extract the offset relative to the beginning
-- of the line.
--
textIterGetLineOffset :: TextIter -> IO Int
textIterGetLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line_offset#} ti

-- @method textIterGetVisibleLineOffset@ Extract the offset relative to the
-- beginning of the line skipping invisible parts of the line.
--
textIterGetVisibleLineOffset :: TextIter -> IO Int
textIterGetVisibleLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_visible_line_offset#} ti

-- @method textIterGetChar@ Return the character at this iterator.
--
textIterGetChar :: TextIter -> IO (Maybe Char)
textIterGetChar ti = do
  (res::Int) <- liftM fromIntegral $ {#call unsafe text_iter_get_char#} ti
  return $ if res==0 then Nothing else Just (chr res)

-- @method textIterGetSlice@ Return the text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetSlice :: TextIter -> TextIter -> IO String
textIterGetSlice end start = do
  cStr <- {#call text_iter_get_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- @method textIterGetText@ Return the text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetText :: TextIter -> TextIter -> IO String
textIterGetText start end = do
  cStr <- {#call text_iter_get_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- @method textIterGetVisibleSlice@ Return the visible text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetVisibleSlice :: TextIter -> TextIter -> IO String
textIterGetVisibleSlice start end = do
  cStr <- {#call text_iter_get_visible_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- @method textIterGetVisibleText@ Return the visible text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetVisibleText :: TextIter -> TextIter -> IO String
textIterGetVisibleText start end = do
  cStr <- {#call text_iter_get_visible_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- @method textIterGetPixbuf@ Get the @ref data Pixbuf@ under the iterator.
--
textIterGetPixbuf :: TextIter -> IO (Maybe Pixbuf)
textIterGetPixbuf it = do
  pbPtr <- {#call unsafe text_iter_get_pixbuf#} it
  if pbPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pbPtr)

-- @method textIterBeginsTag@ Query whether a @ref type TextIter@ is at the
-- start of a @ref type TextTag@.
--
textIterBeginsTag :: TextIter -> TextTag -> IO Bool
textIterBeginsTag ti tt = liftM toBool $
  {#call unsafe text_iter_begins_tag#} ti tt

-- @method textIterEndsTag@ Query whether a @ref type TextIter@ is at the end
-- of a @ref type TextTag@.
--
textIterEndsTag :: TextIter -> TextTag -> IO Bool
textIterEndsTag ti tt = liftM toBool $
  {#call unsafe text_iter_ends_tag#} ti tt

-- @method textIterTogglesTag@ Query if the @ref type TextIter@ is at the
-- beginning or the end of a @ref type TextTag@.
--
textIterTogglesTag :: TextIter -> TextTag -> IO Bool
textIterTogglesTag ti tt = liftM toBool $
  {#call unsafe text_iter_toggles_tag#} ti tt

-- @method textIterHasTag@ Check if @ref type TextIter@ is within a range
-- tagged with tag.
--
textIterHasTag :: TextIter -> TextTag -> IO Bool
textIterHasTag ti tt = liftM toBool $
  {#call unsafe text_iter_has_tag#} ti tt

-- @method textIterEditable@ Check if @ref type TextIter@ is within an
-- editable region.
--
-- * If no tags that affect editability are attached to the current position
--   @ref arg def@ will be returned.
--
-- * This function cannot be used to decide whether text can be inserted at
--   @ref type TextIter@. Use the @ref method textIterCanInsert@ function for
--   this purpose.
--
textIterEditable :: TextIter -> Bool -> IO Bool
textIterEditable ti def = liftM toBool $
  {#call unsafe text_iter_editable#} ti (fromBool def)

-- @method textIterCanInsert@ Check if new text can be inserted at
-- @ref type TextIter@.
--
-- * Use @ref method textBufferInsertInteractive@ if you want to insert text
--   depending on the current editable status.
--
textIterCanInsert :: TextIter -> Bool -> IO Bool
textIterCanInsert ti def = liftM toBool $
  {#call unsafe text_iter_can_insert#} ti (fromBool def)

-- @method textIterStartsWord@ Determine if @ref type TextIter@ begins a new
-- natural-language word.
--
textIterStartsWord :: TextIter -> IO Bool
textIterStartsWord ti = liftM toBool $ {#call unsafe text_iter_starts_word#} ti

-- @method textIterEndsWord@ Determine if @ref type TextIter@ ends a new
-- natural-language word.
--
textIterEndsWord :: TextIter -> IO Bool
textIterEndsWord ti = liftM toBool $ {#call unsafe text_iter_ends_word#} ti

-- @method textIterInsideWord@ Determine if @ref type TextIter@ is inside a
-- word.
--
textIterInsideWord :: TextIter -> IO Bool
textIterInsideWord ti = liftM toBool $ {#call unsafe text_iter_inside_word#} ti

-- @method textIterStartsLine@ Determine if @ref type TextIter@ begins a new
-- line.
--
textIterStartsLine :: TextIter -> IO Bool
textIterStartsLine ti = liftM toBool $ {#call unsafe text_iter_starts_line#} ti

-- @method textIterEndsLine@ Determine if @ref type TextIter@ point to the
-- beginning of a line delimiter.
--
-- * Returns False if @ref type TextIter@ points to the \n in a \r\n sequence.
--
textIterEndsLine :: TextIter -> IO Bool
textIterEndsLine ti = liftM toBool $ {#call unsafe text_iter_ends_line#} ti

-- @method textIterStartsSentence@ Determine if @ref type TextIter@ starts a
-- sentence.
--
textIterStartsSentence :: TextIter -> IO Bool
textIterStartsSentence ti = liftM toBool $
  {#call unsafe text_iter_starts_sentence#} ti

-- @method textIterEndsSentence@ Determine if @ref type TextIter@ ends a
-- sentence.
--
textIterEndsSentence :: TextIter -> IO Bool
textIterEndsSentence ti = liftM toBool $
  {#call unsafe text_iter_ends_sentence#} ti

-- @method textIterInsideSentence@ Determine if @ref type TextIter@ is inside
-- a sentence.
--
textIterInsideSentence :: TextIter -> IO Bool
textIterInsideSentence ti = liftM toBool $
  {#call unsafe text_iter_inside_sentence#} ti

-- @method textIterIsCursorPosition@ Determine if @ref type TextIter@ is at a
-- cursor position.
--
textIterIsCursorPosition :: TextIter -> IO Bool
textIterIsCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_is_cursor_position#} ti

-- @method textIterGetCharsInLine@ Return number of characters in this line.
--
-- * The return value includes delimiters.
--
textIterGetCharsInLine :: TextIter -> IO Int
textIterGetCharsInLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_chars_in_line#} ti

-- @method textIterGetAttributes@ Get the text attributes at the iterator.
--
-- * The @ref arg ta@ argument gives the default values if no specific
--   attributes are set at that specific location.
--
-- * The function returns @literal Nothing@ if the text at the iterator has
--   the same attributes.
textIterGetAttributes = undefined

-- @method textIterIsEnd@ Determine if @ref type TextIter@ is at the end of
-- the buffer.
--
textIterIsEnd :: TextIter -> IO Bool
textIterIsEnd ti = liftM toBool $
  {#call unsafe text_iter_is_end#} ti

-- @method textIterIsStart@ Determine if @ref type TextIter@ is at the
-- beginning of the buffer.
--
textIterIsStart :: TextIter -> IO Bool
textIterIsStart ti = liftM toBool $
  {#call unsafe text_iter_is_start#} ti

-- @method textIterForwardChar@ Move @ref type TextIter@ forwards.
--
-- * Retuns True if the iterator is pointing to a character.
--
textIterForwardChar :: TextIter -> IO Bool
textIterForwardChar ti = liftM toBool $
  {#call unsafe text_iter_forward_char#} ti

-- @method textIterBackwardChar@ Move @ref type TextIter@ backwards.
--
-- * Retuns True if the movement was possible.
--
textIterBackwardChar :: TextIter -> IO Bool
textIterBackwardChar ti = liftM toBool $
  {#call unsafe text_iter_backward_char#} ti

-- @method textIterForwardChars@ Move @ref type TextIter@ forwards by
-- @ref arg n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterForwardChars :: TextIter -> Int -> IO Bool
textIterForwardChars ti n = liftM toBool $
  {#call unsafe text_iter_forward_chars#} ti (fromIntegral n)

-- @method textIterBackwardChars@ Move @ref type TextIter@ backwards by
-- @ref arg n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterBackwardChars :: TextIter -> Int -> IO Bool
textIterBackwardChars ti n = liftM toBool $
  {#call unsafe text_iter_backward_chars#} ti (fromIntegral n)

-- @method textIterForwardLine@ Move @ref type TextIter@ forwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If @ref type TextIter@ is on the first line, it will be moved to the
--   beginning of the buffer.
--
textIterForwardLine :: TextIter -> IO Bool
textIterForwardLine ti = liftM toBool $
  {#call unsafe text_iter_forward_line#} ti

-- @method textIterBackwardLine@ Move @ref type TextIter@ backwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If @ref type TextIter@ is on the first line, it will be moved to the end
--   of the buffer.
--
textIterBackwardLine :: TextIter -> IO Bool
textIterBackwardLine ti = liftM toBool $
  {#call unsafe text_iter_backward_line#} ti

-- @method textIterForwardLines@ Move @ref type TextIter@ forwards by
-- @ref arg n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If @ref type TextIter@ is on the first line, it will be moved to the
--   beginning of the buffer.
--
-- * @ref arg n@ can be negative.
--
textIterForwardLines :: TextIter -> Int -> IO Bool
textIterForwardLines ti n = liftM toBool $
  {#call unsafe text_iter_forward_lines#} ti (fromIntegral n)

-- @method textIterBackwardLines@ Move @ref type TextIter@ backwards by
-- @ref arg n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If @ref type TextIter@ is on the first line, it will be moved to the end
--   of the buffer.
--
-- * @ref arg n@ can be negative.
--
textIterBackwardLines :: TextIter -> Int -> IO Bool
textIterBackwardLines ti n = liftM toBool $
  {#call unsafe text_iter_backward_lines#} ti (fromIntegral n)

-- @method textIterForwardWordEnds@ Move @ref type TextIter@ forwards by
-- @ref arg n@ word ends.
--
-- * Retuns True if the iterator is pointing to a new word end.
--
textIterForwardWordEnds :: TextIter -> Int -> IO Bool
textIterForwardWordEnds ti n = liftM toBool $
  {#call unsafe text_iter_forward_word_ends#} ti (fromIntegral n)

-- @method textIterBackwardWordStarts@ Move @ref type TextIter@ backwards by
-- @ref arg n@ word beginnings.
--
-- * Retuns True if the iterator is pointing to a new word start.
--
textIterBackwardWordStarts :: TextIter -> Int -> IO Bool
textIterBackwardWordStarts ti n = liftM toBool $
  {#call unsafe text_iter_backward_word_starts#} ti (fromIntegral n)

-- @method textIterForwardWordEnd@ Move @ref type TextIter@ forwards to the
-- next word end.
--
-- * Retuns True if the iterator has moved to a new word end.
--
textIterForwardWordEnd :: TextIter -> IO Bool
textIterForwardWordEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_word_end#} ti

-- @method textIterBackwardWordStart@ Move @ref type TextIter@ backwards to
-- the next word beginning.
--
-- * Retuns True if the iterator has moved to a new word beginning.
--
textIterBackwardWordStart :: TextIter -> IO Bool
textIterBackwardWordStart ti = liftM toBool $
  {#call unsafe text_iter_backward_word_start#} ti

-- @method textIterForwardCursorPosition@ Move @ref type TextIter@ forwards to
-- the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that @ref type TextIter@ does not point inbetween such double characters.
--
-- * Returns True if @ref type TextIter@ moved and points to a character (not
--   to an object).
--
textIterForwardCursorPosition :: TextIter -> IO Bool
textIterForwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_forward_cursor_position#} ti

-- @method textIterBackwardCursorPosition@ Move @ref type TextIter@ backwards
-- to the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that @ref type TextIter@ does not point inbetween such double characters.
--
-- * Returns True if @ref type TextIter@ moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPosition :: TextIter -> IO Bool
textIterBackwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_backward_cursor_position#} ti

-- @method textIterForwardCursorPositions@ Move @ref type TextIter@ forwards
-- by @ref arg n@ cursor positions.
--
-- * Returns True if @ref type TextIter@ moved and points to a character (not
--   to an object).
--
textIterForwardCursorPositions :: TextIter -> Int -> IO Bool
textIterForwardCursorPositions ti n = liftM toBool $
  {#call unsafe text_iter_forward_cursor_positions#} ti (fromIntegral n)

-- @method textIterBackwardCursorPositions@ Move @ref type TextIter@ backwards
-- by @ref arg n@ cursor positions.
--
-- * Returns True if @ref type TextIter@ moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPositions :: TextIter -> Int -> IO Bool
textIterBackwardCursorPositions ti n = liftM toBool $
  {#call unsafe text_iter_backward_cursor_positions#} ti (fromIntegral n)

-- @method textIterForwardSentenceEnds@ Move @ref type TextIter@ forwards by
-- @ref arg n@ sentence ends.
--
-- * Retuns True if the iterator is pointing to a new sentence end.
--
textIterForwardSentenceEnds :: TextIter -> Int -> IO Bool
textIterForwardSentenceEnds ti n = liftM toBool $
  {#call unsafe text_iter_forward_sentence_ends#} ti (fromIntegral n)

-- @method textIterBackwardSentenceStarts@ Move @ref type TextIter@ backwards
-- by @ref arg n@ sentence beginnings.
--
-- * Retuns True if the iterator is pointing to a new sentence start.
--
textIterBackwardSentenceStarts :: TextIter -> Int -> IO Bool
textIterBackwardSentenceStarts ti n = liftM toBool $
  {#call unsafe text_iter_backward_sentence_starts#} ti (fromIntegral n)

-- @method textIterForwardSentenceEnd@ Move @ref type TextIter@ forwards to
-- the next sentence end.
--
-- * Retuns True if the iterator has moved to a new sentence end.
--
textIterForwardSentenceEnd :: TextIter -> IO Bool
textIterForwardSentenceEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_sentence_end#} ti

-- @method textIterBackwardSentenceStart@ Move @ref type TextIter@ backwards
-- to the next sentence beginning.
--
-- * Retuns True if the iterator has moved to a new sentence beginning.
--
textIterBackwardSentenceStart :: TextIter -> IO Bool
textIterBackwardSentenceStart ti = liftM toBool $
  {#call unsafe text_iter_backward_sentence_start#} ti

-- @method textIterSetOffset@ Set @ref type TextIter@ to an offset within the
-- buffer.
--
textIterSetOffset :: TextIter -> Int -> IO ()
textIterSetOffset ti n =
  {#call unsafe text_iter_set_offset#} ti (fromIntegral n)

-- @method textIterSetLine@ Set @ref type TextIter@ to a line within the
-- buffer.
--
textIterSetLine :: TextIter -> Int -> IO ()
textIterSetLine ti n =
  {#call unsafe text_iter_set_line#} ti (fromIntegral n)

-- @method textIterSetLineOffset@ Set @ref type TextIter@ to an offset within
-- the line.
--
textIterSetLineOffset :: TextIter -> Int -> IO ()
textIterSetLineOffset ti n =
  {#call unsafe text_iter_set_line_offset#} ti (fromIntegral n)

-- @method textIterSetVisibleLineOffset@ Set @ref type TextIter@ to an visible
-- character within the line.
--
textIterSetVisibleLineOffset :: TextIter -> Int -> IO ()
textIterSetVisibleLineOffset ti n =
  {#call unsafe text_iter_set_visible_line_offset#} ti (fromIntegral n)

-- @method textIterForwardToEnd@ Moves @ref type TextIter@ to the end of the
-- buffer.
--
textIterForwardToEnd :: TextIter -> IO ()
textIterForwardToEnd ti = {#call unsafe text_iter_forward_to_end#} ti

-- @method textIterForwardToLineEnd@ Moves @ref type TextIter@ to the end of
-- the line.
--
-- * Returns True if @ref type TextIter@ moved to a new location which is not
--   the buffer end iterator.
--
textIterForwardToLineEnd :: TextIter -> IO Bool
textIterForwardToLineEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_to_line_end#} ti

-- @method textIterForwardToTagToggle@ Moves @ref type TextIter@ forward to
-- the next change of a @ref type TextTag@.
--
-- * If Nothing is supplied, any @ref type TextTag@ will be matched.
--
-- * Returns True if there was a tag toggle after @ref type TextIter@.
--
textIterForwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterForwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_forward_to_tag_toggle#} ti
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- @method textIterBackwardToTagToggle@ Moves @ref type TextIter@ backward to
-- the next change of a @ref type TextTag@.
--
-- * If Nothing is supplied, any @ref type TextTag@ will be matched.
--
-- * Returns True if there was a tag toggle before @ref type TextIter@.
--
textIterBackwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterBackwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_backward_to_tag_toggle#} ti
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- Setup a callback for a predicate function.
--
type TextCharPredicateCB = Char -> Bool

{#pointer TextCharPredicate#}

#if __GLASGOW_HASKELL__>=600

foreign import ccall "wrapper" mkTextCharPredicate ::
  ({#type gunichar#} -> Ptr () -> {#type gboolean#}) -> IO TextCharPredicate

#else

foreign export dynamic mkTextCharPredicate ::
  ({#type gunichar#} -> Ptr () -> {#type gboolean#}) -> IO TextCharPredicate

#endif

-- @method textIterForwardFindChar@ Move @ref type TextIter@ forward until a
-- predicate function returns True.
--
-- * If @ref arg pred@ returns True before @ref arg limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @ref arg limit@ is Nothing, the search stops at the end of the buffer.
--
textIterForwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                           IO Bool
textIterForwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_forward_find_char#}
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- @method textIterBackwardFindChar@ Move @ref type TextIter@ backward until a
-- predicate function returns True.
--
-- * If @ref arg pred@ returns True before @ref arg limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @ref arg limit@ is Nothing, the search stops at the end of the buffer.
--
textIterBackwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                            IO Bool
textIterBackwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_backward_find_char#}
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- @method textIterForwardSearch@ Search forward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @ref arg limit@.
--
-- * @ref type TextSearchFlags@ may be empty.
--
-- * Returns the start and end position of the string found.
--
textIterForwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                         Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterForwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_forward_search#} ti cStr
    ((fromIntegral.fromFlags) flags) start end
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- @method textIterBackwardSearch@ Search backward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @ref arg limit@.
--
-- * @ref type TextSearchFlags@ my be empty.
--
-- * Returns the start and end position of the string found.
--
textIterBackwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                          Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterBackwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_backward_search#} ti cStr
    ((fromIntegral.fromFlags) flags) start end
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- @method textIterEqual@ Compare two @ref type TextIter@ for equality.
--
-- * @ref type TextIter@ could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This is done
--   the next abstraction layer.
--
textIterEqual :: TextIter -> TextIter -> IO Bool
textIterEqual ti2 ti1 = liftM toBool $ {#call unsafe text_iter_equal#} ti1 ti2

-- @method textIterCompare@ Compare two @ref type TextIter@.
--
-- * @ref type TextIter@ could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This could
--   be done the next abstraction layer.
--
textIterCompare :: TextIter -> TextIter -> IO Ordering
textIterCompare ti2 ti1 = do
  res <- {#call unsafe text_iter_compare#} ti1 ti2
  return $ case res of
    (-1)   -> LT
    0	   -> EQ
    1	   -> GT


Make valueInit less conservative.

Make valueInit less conservative.

darcs-hash:20060201212808-91c87-61bbb605c6855623d93cc3d11ea99eac64c70658.gz

-- -*-haskell-*-
--  GIMP Toolkit (GTK) GValue
--
--  Author : Axel Simon
--
--  Created: 1 June 2001
--
--  Version $Revision: 1.3 $ from $Date: 2005/11/16 13:14:16 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- This module implements only the necessities for the GTK binding.
--
-- * Everything here is only used by "Graphics.UI.Gtk.TreeList.TreeModel" and
-- friends.
--
module System.Glib.GValue (
  GValue(GValue),
  valueInit,
  valueUnset,
  valueGetType,
  allocaGValue
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.GType	(GType)

{# context lib="glib" prefix="g" #}

{# pointer *GValue newtype #}

-- | Clear a GValue.
--
valueInit :: GValue -> GType -> IO ()
valueInit gv gt = do
  -- The g_type field of the value must be zero or g_value_init will fail.
  {# call unsafe value_init #} gv gt
  return ()

-- | Free the data in a GValue.
--
valueUnset :: GValue -> IO ()
valueUnset = {#call unsafe value_unset#}

-- | Get the type of the value stored in the GValue
--
valueGetType :: GValue -> IO GType
valueGetType (GValue gvPtr) = {# get GValue->g_type #} gvPtr

-- | Temporarily allocate a GValue.
--
allocaGValue :: (GValue -> IO b) -> IO b
allocaGValue body =
  -- c2hs is broken in that it can't handle arrays of compound arrays in the
  -- sizeof hook
  allocaBytes ({# sizeof GType #}+ 2* {# sizeof guint64 #}) $ \gvPtr -> do
  -- The g_type field of the value must be zero or g_value_init will fail.
  {# set GValue->g_type #} gvPtr (0 :: GType)
  result <- body (GValue gvPtr)
  valueUnset (GValue gvPtr)
  return result

-- -*-haskell-*-
--  GIMP Toolkit (GTK) GValue
--
--  Author : Axel Simon
--
--  Created: 1 June 2001
--
--  Version $Revision: 1.3 $ from $Date: 2005/11/16 13:14:16 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- This module implements only the necessities for the GTK binding.
--
-- * Everything here is only used by "Graphics.UI.Gtk.TreeList.TreeModel" and
-- friends.
--
module System.Glib.GValue (
  GValue(GValue),
  valueInit,
  valueUnset,
  valueGetType,
  allocaGValue
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.GType	(GType)

{# context lib="glib" prefix="g" #}

{# pointer *GValue newtype #}

-- | Clear a GValue.
--
valueInit :: GValue -> GType -> IO ()
valueInit gv@(GValue gvPtr) gt = do
  -- The g_type field of the value must be zero or g_value_init will fail.
  {# set GValue->g_type #} gvPtr (0 :: GType)
  {# call unsafe value_init #} gv gt
  return ()

-- | Free the data in a GValue.
--
valueUnset :: GValue -> IO ()
valueUnset = {#call unsafe value_unset#}

-- | Get the type of the value stored in the GValue
--
valueGetType :: GValue -> IO GType
valueGetType (GValue gvPtr) = {# get GValue->g_type #} gvPtr

-- | Temporarily allocate a GValue.
--
allocaGValue :: (GValue -> IO b) -> IO b
allocaGValue body =
  -- c2hs is broken in that it can't handle arrays of compound arrays in the
  -- sizeof hook
  allocaBytes ({# sizeof GType #}+ 2* {# sizeof guint64 #}) $ \gvPtr -> do
  -- The g_type field of the value must be zero or g_value_init will fail.
  {# set GValue->g_type #} gvPtr (0 :: GType)
  result <- body (GValue gvPtr)
  valueUnset (GValue gvPtr)
  return result