{-# LINE 2 "./System/Glib/GObject.chs" #-}
module System.Glib.GObject (
module System.Glib.Types,
objectNew,
objectRef,
objectRefSink,
makeNewGObject,
constructNewGObject,
wrapNewGObject,
gTypeGObject,
isA,
DestroyNotify,
destroyFunPtr,
destroyStablePtr,
Quark,
quarkFromString,
objectCreateAttribute,
objectSetAttribute,
objectGetAttributeUnsafe
) where
import Control.Monad (liftM, when)
import Data.IORef (newIORef, readIORef, writeIORef)
import qualified Data.Text as T (pack)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Types
{-# LINE 69 "./System/Glib/GObject.chs" #-}
import System.Glib.GValue (GValue)
import System.Glib.GType (GType, typeInstanceIsA)
import System.Glib.GTypeConstants ( object )
import System.Glib.GParameter
import System.Glib.Attributes (newNamedAttr, Attr)
import Foreign.StablePtr
import Control.Concurrent.MVar ( MVar, newMVar, modifyMVar )
{-# LINE 78 "./System/Glib/GObject.chs" #-}
type GParm = Ptr (GParameter)
{-# LINE 80 "./System/Glib/GObject.chs" #-}
objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject)
objectNew :: GType -> [(String, GValue)] -> IO (Ptr GObject)
objectNew GType
objType [(String, GValue)]
parameters =
(Ptr () -> Ptr GObject) -> IO (Ptr ()) -> IO (Ptr GObject)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr () -> Ptr GObject
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr ()) -> IO (Ptr GObject))
-> IO (Ptr ()) -> IO (Ptr GObject)
forall a b. (a -> b) -> a -> b
$
[GParameter] -> (Ptr GParameter -> IO (Ptr ())) -> IO (Ptr ())
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (((String, GValue) -> GParameter)
-> [(String, GValue)] -> [GParameter]
forall a b. (a -> b) -> [a] -> [b]
map (String, GValue) -> GParameter
GParameter [(String, GValue)]
parameters) ((Ptr GParameter -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr GParameter -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr GParameter
paramArrayPtr ->
GType -> CUInt -> Ptr GParameter -> IO (Ptr ())
g_object_newv GType
objType
(Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [(String, GValue)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, GValue)]
parameters) Ptr GParameter
paramArrayPtr
objectRefSink :: GObjectClass obj => Ptr obj -> IO ()
objectRefSink :: forall obj. GObjectClass obj => Ptr obj -> IO ()
objectRefSink Ptr obj
obj = do
Ptr () -> IO (Ptr ())
g_object_ref_sink (Ptr obj -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr obj
obj)
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
objectRef :: GObjectClass obj => Ptr obj -> IO ()
objectRef :: forall obj. GObjectClass obj => Ptr obj -> IO ()
objectRef Ptr obj
obj = do
Ptr () -> IO (Ptr ())
g_object_ref (Ptr obj -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr obj
obj)
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
gTypeGObject :: GType
gTypeGObject :: GType
gTypeGObject = GType
object
makeNewGObject ::
GObjectClass obj
=> (ForeignPtr obj -> obj, FinalizerPtr obj)
-> IO (Ptr obj)
-> IO obj
makeNewGObject :: forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr obj -> obj
constr, FinalizerPtr obj
objectUnref) IO (Ptr obj)
generator = do
objPtr <- IO (Ptr obj)
generator
when (objPtr == nullPtr) (fail "makeNewGObject: object is NULL")
objectRef objPtr
obj <- newForeignPtr objPtr objectUnref
return $! constr obj
type DestroyNotify = FunPtr (((Ptr ()) -> (IO ())))
{-# LINE 130 "./System/Glib/GObject.chs" #-}
constructNewGObject :: GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
constructNewGObject :: forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
constructNewGObject (ForeignPtr obj -> obj
constr, FinalizerPtr obj
objectUnref) IO (Ptr obj)
generator = do
objPtr <- IO (Ptr obj)
generator
objectRefSink objPtr
obj <- newForeignPtr objPtr objectUnref
return $! constr obj
wrapNewGObject :: GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject :: forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr obj -> obj
constr, FinalizerPtr obj
objectUnref) IO (Ptr obj)
generator = do
objPtr <- IO (Ptr obj)
generator
when (objPtr == nullPtr) (fail "wrapNewGObject: object is NULL")
obj <- newForeignPtr objPtr objectUnref
return $! constr obj
foreign import ccall unsafe "&freeHaskellFunctionPtr" destroyFunPtr :: DestroyNotify
type Quark = (CUInt)
{-# LINE 169 "./System/Glib/GObject.chs" #-}
{-# NOINLINE uniqueCnt #-}
uniqueCnt :: MVar Int
uniqueCnt :: MVar Int
uniqueCnt = IO (MVar Int) -> MVar Int
forall a. IO a -> a
unsafePerformIO (IO (MVar Int) -> MVar Int) -> IO (MVar Int) -> MVar Int
forall a b. (a -> b) -> a -> b
$ Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
newMVar Int
0
quarkFromString :: GlibString string => string -> IO Quark
quarkFromString :: forall string. GlibString string => string -> IO CUInt
quarkFromString string
name = string -> (CString -> IO CUInt) -> IO CUInt
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
name CString -> IO CUInt
g_quark_from_string
{-# LINE 178 "./System/Glib/GObject.chs" #-}
objectCreateAttribute :: GObjectClass o => IO (Attr o (Maybe a))
objectCreateAttribute :: forall o a. GObjectClass o => IO (Attr o (Maybe a))
objectCreateAttribute = do
cnt <- MVar Int -> (Int -> IO (Int, Int)) -> IO Int
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar Int
uniqueCnt (\Int
cnt -> (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
cntInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
cnt))
let propName = String
"Gtk2HsAttr"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
cnt
attr <- quarkFromString $ T.pack 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 :: forall o a. GObjectClass o => CUInt -> o -> Maybe a -> IO ()
objectSetAttribute CUInt
attr o
obj Maybe a
Nothing = do
(\(GObject ForeignPtr GObject
arg1) CUInt
arg2 Ptr ()
arg3 -> ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GObject
arg1 ((Ptr GObject -> IO ()) -> IO ())
-> (Ptr GObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
argPtr1 ->Ptr GObject -> CUInt -> Ptr () -> IO ()
g_object_set_qdata Ptr GObject
argPtr1 CUInt
arg2 Ptr ()
arg3) (o -> GObject
forall o. GObjectClass o => o -> GObject
toGObject o
obj) CUInt
attr Ptr ()
forall a. Ptr a
nullPtr
objectSetAttribute CUInt
attr o
obj (Just a
val) = do
sPtr <- a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
newStablePtr a
val
(\(GObject ForeignPtr GObject
arg1) CUInt
arg2 Ptr ()
arg3 FunPtr (Ptr () -> IO ())
arg4 -> ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GObject
arg1 ((Ptr GObject -> IO ()) -> IO ())
-> (Ptr GObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
argPtr1 ->Ptr GObject -> CUInt -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO ()
g_object_set_qdata_full Ptr GObject
argPtr1 CUInt
arg2 Ptr ()
arg3 FunPtr (Ptr () -> IO ())
arg4) (toGObject obj) attr (castStablePtrToPtr sPtr)
destroyStablePtr
objectGetAttributeUnsafe :: GObjectClass o => Quark -> o -> IO (Maybe a)
objectGetAttributeUnsafe :: forall o a. GObjectClass o => CUInt -> o -> IO (Maybe a)
objectGetAttributeUnsafe CUInt
attr o
obj = do
sPtr <- (\(GObject ForeignPtr GObject
arg1) CUInt
arg2 -> ForeignPtr GObject -> (Ptr GObject -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GObject
arg1 ((Ptr GObject -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr GObject -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
argPtr1 ->Ptr GObject -> CUInt -> IO (Ptr ())
g_object_get_qdata Ptr GObject
argPtr1 CUInt
arg2) (o -> GObject
forall o. GObjectClass o => o -> GObject
toGObject o
obj) CUInt
attr
if sPtr==nullPtr then return Nothing else
liftM Just $! deRefStablePtr (castPtrToStablePtr sPtr)
isA :: GObjectClass o => o -> GType -> Bool
isA :: forall o. GObjectClass o => o -> GType -> Bool
isA o
obj GType
gType =
Ptr () -> GType -> Bool
typeInstanceIsA ((ForeignPtr () -> Ptr ()
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr(ForeignPtr () -> Ptr ()) -> (o -> ForeignPtr ()) -> o -> Ptr ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ForeignPtr GObject -> ForeignPtr ()
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr(ForeignPtr GObject -> ForeignPtr ())
-> (o -> ForeignPtr GObject) -> o -> ForeignPtr ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GObject -> ForeignPtr GObject
unGObject(GObject -> ForeignPtr GObject)
-> (o -> GObject) -> o -> ForeignPtr GObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
.o -> GObject
forall o. GObjectClass o => o -> GObject
toGObject) o
obj) GType
gType
foreign import ccall safe "g_object_newv"
g_object_newv :: (CULong -> (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_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 ()))))