{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc) Defines the x and y coordinates of a point. -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.Gdk.Structs.Point ( -- * Exported types Point(..) , newZeroPoint , noPoint , -- * Properties -- ** x #attr:x# {- | the x coordinate of the point. -} getPointX , #if ENABLE_OVERLOADING point_x , #endif setPointX , -- ** y #attr:y# {- | the y coordinate of the point. -} getPointY , #if ENABLE_OVERLOADING point_y , #endif setPointY , ) where import Data.GI.Base.ShortPrelude import qualified Data.GI.Base.ShortPrelude as SP import qualified Data.GI.Base.Overloading as O import qualified Prelude as P import qualified Data.GI.Base.Attributes as GI.Attributes import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr import qualified Data.GI.Base.GClosure as B.GClosure import qualified Data.GI.Base.GError as B.GError import qualified Data.GI.Base.GVariant as B.GVariant import qualified Data.GI.Base.GValue as B.GValue import qualified Data.GI.Base.GParamSpec as B.GParamSpec import qualified Data.GI.Base.CallStack as B.CallStack import qualified Data.GI.Base.Properties as B.Properties import qualified Data.Text as T import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map import qualified Foreign.Ptr as FP import qualified GHC.OverloadedLabels as OL -- | Memory-managed wrapper type. newtype Point = Point (ManagedPtr Point) instance WrappedPtr Point where wrappedPtrCalloc = callocBytes 8 wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 8 >=> wrapPtr Point) wrappedPtrFree = Just ptr_to_g_free -- | Construct a `Point` struct initialized to zero. newZeroPoint :: MonadIO m => m Point newZeroPoint = liftIO $ wrappedPtrCalloc >>= wrapPtr Point instance tag ~ 'AttrSet => Constructible Point tag where new _ attrs = do o <- newZeroPoint GI.Attributes.set o attrs return o -- | A convenience alias for `Nothing` :: `Maybe` `Point`. noPoint :: Maybe Point noPoint = Nothing {- | Get the value of the “@x@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' point #x @ -} getPointX :: MonadIO m => Point -> m Int32 getPointX s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val {- | Set the value of the “@x@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' point [ #x 'Data.GI.Base.Attributes.:=' value ] @ -} setPointX :: MonadIO m => Point -> Int32 -> m () setPointX s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 0) (val :: Int32) #if ENABLE_OVERLOADING data PointXFieldInfo instance AttrInfo PointXFieldInfo where type AttrAllowedOps PointXFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint PointXFieldInfo = (~) Int32 type AttrBaseTypeConstraint PointXFieldInfo = (~) Point type AttrGetType PointXFieldInfo = Int32 type AttrLabel PointXFieldInfo = "x" type AttrOrigin PointXFieldInfo = Point attrGet _ = getPointX attrSet _ = setPointX attrConstruct = undefined attrClear _ = undefined point_x :: AttrLabelProxy "x" point_x = AttrLabelProxy #endif {- | Get the value of the “@y@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' point #y @ -} getPointY :: MonadIO m => Point -> m Int32 getPointY s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Int32 return val {- | Set the value of the “@y@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' point [ #y 'Data.GI.Base.Attributes.:=' value ] @ -} setPointY :: MonadIO m => Point -> Int32 -> m () setPointY s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 4) (val :: Int32) #if ENABLE_OVERLOADING data PointYFieldInfo instance AttrInfo PointYFieldInfo where type AttrAllowedOps PointYFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint PointYFieldInfo = (~) Int32 type AttrBaseTypeConstraint PointYFieldInfo = (~) Point type AttrGetType PointYFieldInfo = Int32 type AttrLabel PointYFieldInfo = "y" type AttrOrigin PointYFieldInfo = Point attrGet _ = getPointY attrSet _ = setPointY attrConstruct = undefined attrClear _ = undefined point_y :: AttrLabelProxy "y" point_y = AttrLabelProxy #endif #if ENABLE_OVERLOADING instance O.HasAttributeList Point type instance O.AttributeList Point = PointAttributeList type PointAttributeList = ('[ '("x", PointXFieldInfo), '("y", PointYFieldInfo)] :: [(Symbol, *)]) #endif #if ENABLE_OVERLOADING type family ResolvePointMethod (t :: Symbol) (o :: *) :: * where ResolvePointMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolvePointMethod t Point, O.MethodInfo info Point p) => OL.IsLabel t (Point -> p) where #if MIN_VERSION_base(4,10,0) fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info) #else fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info) #endif #endif