module System.Glib.GObject (
module System.Glib.Types,
objectNew,
objectRef,
objectRefSink,
makeNewGObject,
constructNewGObject,
gTypeGObject,
isA,
DestroyNotify,
destroyFunPtr,
destroyStablePtr,
Quark,
quarkFromString,
objectCreateAttribute,
objectSetAttribute,
objectGetAttributeUnsafe
) where
import Control.Monad (liftM, when)
import Data.IORef (newIORef, readIORef, writeIORef)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Types
import System.Glib.GValue (GValue)
import System.Glib.GType (GType, typeInstanceIsA)
import System.Glib.GParameter
import System.Glib.Attributes (newNamedAttr, Attr)
import Foreign.StablePtr
import Control.Concurrent.MVar ( MVar, newMVar, modifyMVar )
type GParm = Ptr (GParameter)
objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject)
objectNew objType parameters =
liftM castPtr $
withArray (map GParameter parameters) $ \paramArrayPtr ->
g_object_newv objType
(fromIntegral $ length parameters) paramArrayPtr
objectRefSink :: GObjectClass obj => Ptr obj -> IO ()
objectRefSink obj = do
g_object_ref_sink (castPtr obj)
return ()
objectRef :: GObjectClass obj => Ptr obj -> IO ()
objectRef obj = do
g_object_ref (castPtr obj)
return ()
gTypeGObject :: GType
gTypeGObject =
g_object_get_type
makeNewGObject ::
GObjectClass obj
=> (ForeignPtr obj -> obj, FinalizerPtr obj)
-> IO (Ptr obj)
-> IO obj
makeNewGObject (constr, objectUnref) generator = do
objPtr <- generator
when (objPtr == nullPtr) (fail "makeNewGObject: object is NULL")
objectRef objPtr
obj <- newForeignPtr objPtr objectUnref
return $! constr obj
type DestroyNotify = FunPtr (((Ptr ()) -> (IO ())))
foreign import ccall "wrapper" mkDestroyNotifyPtr :: IO () -> IO DestroyNotify
constructNewGObject :: GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
constructNewGObject (constr, objectUnref) generator = do
objPtr <- generator
objectRefSink objPtr
obj <- newForeignPtr objPtr objectUnref
return $! constr obj
foreign import ccall unsafe "&freeHaskellFunctionPtr" destroyFunPtr :: DestroyNotify
type Quark = (CUInt)
uniqueCnt :: MVar Int
uniqueCnt = unsafePerformIO $ newMVar 0
quarkFromString :: String -> IO Quark
quarkFromString name = withUTFString name g_quark_from_string
objectCreateAttribute :: GObjectClass o => IO (Attr o (Maybe a))
objectCreateAttribute = do
cnt <- modifyMVar uniqueCnt (\cnt -> return (cnt+1, cnt))
let propName = "Gtk2HsAttr"++show cnt
attr <- quarkFromString propName
return (newNamedAttr propName (objectGetAttributeUnsafe attr)
(objectSetAttribute attr))
foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: DestroyNotify
objectSetAttribute :: GObjectClass o => Quark -> o -> Maybe a -> IO ()
objectSetAttribute attr obj Nothing = do
(\(GObject arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->g_object_set_qdata argPtr1 arg2 arg3) (toGObject obj) attr nullPtr
objectSetAttribute attr obj (Just val) = do
sPtr <- newStablePtr val
(\(GObject arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->g_object_set_qdata_full argPtr1 arg2 arg3 arg4) (toGObject obj) attr (castStablePtrToPtr sPtr)
destroyStablePtr
objectGetAttributeUnsafe :: GObjectClass o => Quark -> o -> IO (Maybe a)
objectGetAttributeUnsafe attr obj = do
sPtr <- (\(GObject arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->g_object_get_qdata argPtr1 arg2) (toGObject obj) attr
if sPtr==nullPtr then return Nothing else
liftM Just $! deRefStablePtr (castPtrToStablePtr sPtr)
isA :: GObjectClass o => o -> GType -> Bool
isA obj gType =
typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr.unGObject.toGObject) obj) gType
foreign import ccall safe "g_object_newv"
g_object_newv :: (CUInt -> (CUInt -> ((Ptr GParameter) -> (IO (Ptr ())))))
foreign import ccall unsafe "g_object_ref_sink"
g_object_ref_sink :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall unsafe "g_object_ref"
g_object_ref :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall unsafe "g_object_get_type"
g_object_get_type :: CUInt
foreign import ccall unsafe "g_quark_from_string"
g_quark_from_string :: ((Ptr CChar) -> (IO CUInt))
foreign import ccall safe "g_object_set_qdata"
g_object_set_qdata :: ((Ptr GObject) -> (CUInt -> ((Ptr ()) -> (IO ()))))
foreign import ccall safe "g_object_set_qdata_full"
g_object_set_qdata_full :: ((Ptr GObject) -> (CUInt -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO ())))))
foreign import ccall unsafe "g_object_get_qdata"
g_object_get_qdata :: ((Ptr GObject) -> (CUInt -> (IO (Ptr ()))))