{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (garetxe@gmail.com) A #GdkRGBA is used to represent a (possibly translucent) color, in a way that is compatible with cairos notion of color. -} module GI.Gdk.Structs.RGBA ( -- * Exported types RGBA(..) , newZeroRGBA , noRGBA , -- * Methods -- ** rGBACopy RGBACopyMethodInfo , rGBACopy , -- ** rGBAEqual RGBAEqualMethodInfo , rGBAEqual , -- ** rGBAFree RGBAFreeMethodInfo , rGBAFree , -- ** rGBAHash RGBAHashMethodInfo , rGBAHash , -- ** rGBAParse RGBAParseMethodInfo , rGBAParse , -- ** rGBAToString RGBAToStringMethodInfo , rGBAToString , -- * Properties -- ** Alpha rGBAAlpha , rGBAReadAlpha , rGBAWriteAlpha , -- ** Blue rGBABlue , rGBAReadBlue , rGBAWriteBlue , -- ** Green rGBAGreen , rGBAReadGreen , rGBAWriteGreen , -- ** Red rGBAReadRed , rGBARed , rGBAWriteRed , ) where import Data.GI.Base.ShortPrelude import qualified Data.GI.Base.Attributes as GI.Attributes import qualified Data.Text as T import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map import GI.Gdk.Types import GI.Gdk.Callbacks newtype RGBA = RGBA (ForeignPtr RGBA) foreign import ccall "gdk_rgba_get_type" c_gdk_rgba_get_type :: IO GType instance BoxedObject RGBA where boxedType _ = c_gdk_rgba_get_type -- | Construct a `RGBA` struct initialized to zero. newZeroRGBA :: MonadIO m => m RGBA newZeroRGBA = liftIO $ callocBoxedBytes 32 >>= wrapBoxed RGBA instance tag ~ 'AttrSet => Constructible RGBA tag where new _ attrs = do o <- newZeroRGBA GI.Attributes.set o attrs return o noRGBA :: Maybe RGBA noRGBA = Nothing rGBAReadRed :: MonadIO m => RGBA -> m Double rGBAReadRed s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CDouble let val' = realToFrac val return val' rGBAWriteRed :: MonadIO m => RGBA -> Double -> m () rGBAWriteRed s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 0) (val' :: CDouble) data RGBARedFieldInfo instance AttrInfo RGBARedFieldInfo where type AttrAllowedOps RGBARedFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint RGBARedFieldInfo = (~) Double type AttrBaseTypeConstraint RGBARedFieldInfo = (~) RGBA type AttrGetType RGBARedFieldInfo = Double type AttrLabel RGBARedFieldInfo = "red" attrGet _ = rGBAReadRed attrSet _ = rGBAWriteRed attrConstruct = undefined attrClear _ = undefined rGBARed :: AttrLabelProxy "red" rGBARed = AttrLabelProxy rGBAReadGreen :: MonadIO m => RGBA -> m Double rGBAReadGreen s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CDouble let val' = realToFrac val return val' rGBAWriteGreen :: MonadIO m => RGBA -> Double -> m () rGBAWriteGreen s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 8) (val' :: CDouble) data RGBAGreenFieldInfo instance AttrInfo RGBAGreenFieldInfo where type AttrAllowedOps RGBAGreenFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint RGBAGreenFieldInfo = (~) Double type AttrBaseTypeConstraint RGBAGreenFieldInfo = (~) RGBA type AttrGetType RGBAGreenFieldInfo = Double type AttrLabel RGBAGreenFieldInfo = "green" attrGet _ = rGBAReadGreen attrSet _ = rGBAWriteGreen attrConstruct = undefined attrClear _ = undefined rGBAGreen :: AttrLabelProxy "green" rGBAGreen = AttrLabelProxy rGBAReadBlue :: MonadIO m => RGBA -> m Double rGBAReadBlue s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CDouble let val' = realToFrac val return val' rGBAWriteBlue :: MonadIO m => RGBA -> Double -> m () rGBAWriteBlue s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 16) (val' :: CDouble) data RGBABlueFieldInfo instance AttrInfo RGBABlueFieldInfo where type AttrAllowedOps RGBABlueFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint RGBABlueFieldInfo = (~) Double type AttrBaseTypeConstraint RGBABlueFieldInfo = (~) RGBA type AttrGetType RGBABlueFieldInfo = Double type AttrLabel RGBABlueFieldInfo = "blue" attrGet _ = rGBAReadBlue attrSet _ = rGBAWriteBlue attrConstruct = undefined attrClear _ = undefined rGBABlue :: AttrLabelProxy "blue" rGBABlue = AttrLabelProxy rGBAReadAlpha :: MonadIO m => RGBA -> m Double rGBAReadAlpha s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO CDouble let val' = realToFrac val return val' rGBAWriteAlpha :: MonadIO m => RGBA -> Double -> m () rGBAWriteAlpha s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 24) (val' :: CDouble) data RGBAAlphaFieldInfo instance AttrInfo RGBAAlphaFieldInfo where type AttrAllowedOps RGBAAlphaFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint RGBAAlphaFieldInfo = (~) Double type AttrBaseTypeConstraint RGBAAlphaFieldInfo = (~) RGBA type AttrGetType RGBAAlphaFieldInfo = Double type AttrLabel RGBAAlphaFieldInfo = "alpha" attrGet _ = rGBAReadAlpha attrSet _ = rGBAWriteAlpha attrConstruct = undefined attrClear _ = undefined rGBAAlpha :: AttrLabelProxy "alpha" rGBAAlpha = AttrLabelProxy type instance AttributeList RGBA = RGBAAttributeList type RGBAAttributeList = ('[ '("red", RGBARedFieldInfo), '("green", RGBAGreenFieldInfo), '("blue", RGBABlueFieldInfo), '("alpha", RGBAAlphaFieldInfo)] :: [(Symbol, *)]) -- method RGBA::copy -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TInterface "Gdk" "RGBA") -- throws : False -- Skip return : False foreign import ccall "gdk_rgba_copy" gdk_rgba_copy :: Ptr RGBA -> -- _obj : TInterface "Gdk" "RGBA" IO (Ptr RGBA) rGBACopy :: (MonadIO m) => RGBA -- _obj -> m RGBA -- result rGBACopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- gdk_rgba_copy _obj' checkUnexpectedReturnNULL "gdk_rgba_copy" result result' <- (wrapBoxed RGBA) result touchManagedPtr _obj return result' data RGBACopyMethodInfo instance (signature ~ (m RGBA), MonadIO m) => MethodInfo RGBACopyMethodInfo RGBA signature where overloadedMethod _ = rGBACopy -- method RGBA::equal -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "p2", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TBoolean) -- throws : False -- Skip return : False foreign import ccall "gdk_rgba_equal" gdk_rgba_equal :: Ptr RGBA -> -- _obj : TInterface "Gdk" "RGBA" Ptr RGBA -> -- p2 : TInterface "Gdk" "RGBA" IO CInt rGBAEqual :: (MonadIO m) => RGBA -- _obj -> RGBA -- p2 -> m Bool -- result rGBAEqual _obj p2 = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let p2' = unsafeManagedPtrGetPtr p2 result <- gdk_rgba_equal _obj' p2' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr p2 return result' data RGBAEqualMethodInfo instance (signature ~ (RGBA -> m Bool), MonadIO m) => MethodInfo RGBAEqualMethodInfo RGBA signature where overloadedMethod _ = rGBAEqual -- method RGBA::free -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "gdk_rgba_free" gdk_rgba_free :: Ptr RGBA -> -- _obj : TInterface "Gdk" "RGBA" IO () rGBAFree :: (MonadIO m) => RGBA -- _obj -> m () -- result rGBAFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj gdk_rgba_free _obj' touchManagedPtr _obj return () data RGBAFreeMethodInfo instance (signature ~ (m ()), MonadIO m) => MethodInfo RGBAFreeMethodInfo RGBA signature where overloadedMethod _ = rGBAFree -- method RGBA::hash -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TUInt) -- throws : False -- Skip return : False foreign import ccall "gdk_rgba_hash" gdk_rgba_hash :: Ptr RGBA -> -- _obj : TInterface "Gdk" "RGBA" IO Word32 rGBAHash :: (MonadIO m) => RGBA -- _obj -> m Word32 -- result rGBAHash _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- gdk_rgba_hash _obj' touchManagedPtr _obj return result data RGBAHashMethodInfo instance (signature ~ (m Word32), MonadIO m) => MethodInfo RGBAHashMethodInfo RGBA signature where overloadedMethod _ = rGBAHash -- method RGBA::parse -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "spec", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TBoolean) -- throws : False -- Skip return : False foreign import ccall "gdk_rgba_parse" gdk_rgba_parse :: Ptr RGBA -> -- _obj : TInterface "Gdk" "RGBA" CString -> -- spec : TBasicType TUTF8 IO CInt rGBAParse :: (MonadIO m) => RGBA -- _obj -> T.Text -- spec -> m Bool -- result rGBAParse _obj spec = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj spec' <- textToCString spec result <- gdk_rgba_parse _obj' spec' let result' = (/= 0) result touchManagedPtr _obj freeMem spec' return result' data RGBAParseMethodInfo instance (signature ~ (T.Text -> m Bool), MonadIO m) => MethodInfo RGBAParseMethodInfo RGBA signature where overloadedMethod _ = rGBAParse -- method RGBA::to_string -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TUTF8) -- throws : False -- Skip return : False foreign import ccall "gdk_rgba_to_string" gdk_rgba_to_string :: Ptr RGBA -> -- _obj : TInterface "Gdk" "RGBA" IO CString rGBAToString :: (MonadIO m) => RGBA -- _obj -> m T.Text -- result rGBAToString _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- gdk_rgba_to_string _obj' checkUnexpectedReturnNULL "gdk_rgba_to_string" result result' <- cstringToText result freeMem result touchManagedPtr _obj return result' data RGBAToStringMethodInfo instance (signature ~ (m T.Text), MonadIO m) => MethodInfo RGBAToStringMethodInfo RGBA signature where overloadedMethod _ = rGBAToString type family ResolveRGBAMethod (t :: Symbol) (o :: *) :: * where ResolveRGBAMethod "copy" o = RGBACopyMethodInfo ResolveRGBAMethod "equal" o = RGBAEqualMethodInfo ResolveRGBAMethod "free" o = RGBAFreeMethodInfo ResolveRGBAMethod "hash" o = RGBAHashMethodInfo ResolveRGBAMethod "parse" o = RGBAParseMethodInfo ResolveRGBAMethod "toString" o = RGBAToStringMethodInfo ResolveRGBAMethod l o = MethodResolutionFailed l o instance (info ~ ResolveRGBAMethod t RGBA, MethodInfo info RGBA p) => IsLabelProxy t (RGBA -> p) where fromLabelProxy _ = overloadedMethod (MethodProxy :: MethodProxy info) #if MIN_VERSION_base(4,9,0) instance (info ~ ResolveRGBAMethod t RGBA, MethodInfo info RGBA p) => IsLabel t (RGBA -> p) where fromLabel _ = overloadedMethod (MethodProxy :: MethodProxy info) #endif