module Graphics.UI.Gtk.ModelView.CellRendererCairo (
CellRendererCairo,
CellRendererCairoClass,
castToCellRendererCairo, gTypeCellRendererCairo,
toCellRendererCairo,
withCellRendererCairo,
cellRendererCairoNew,
cellRendererSetRenderer,
cellRenderer
) where
import Control.Monad (liftM, unless)
import Control.Monad.Reader (runReaderT)
import System.Glib.FFI
import System.Glib.GType
import System.Glib.Types
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk
import Graphics.Rendering.Cairo.Internal
newtype CellRendererCairo = CellRendererCairo (ForeignPtr (CellRendererCairo))
withCellRendererCairo (CellRendererCairo fptr) = withForeignPtr fptr
mkCellRendererCairo = (CellRendererCairo, objectUnrefFromMainloop)
unCellRendererCairo (CellRendererCairo o) = o
class CellRendererClass o => CellRendererCairoClass o
toCellRendererCairo :: CellRendererCairoClass o => o -> CellRendererCairo
toCellRendererCairo = unsafeCastGObject . toGObject
instance CellRendererCairoClass CellRendererCairo
instance CellRendererClass CellRendererCairo
instance ObjectClass CellRendererCairo
instance GObjectClass CellRendererCairo where
toGObject = GObject . castForeignPtr . unCellRendererCairo
unsafeCastGObject = CellRendererCairo . castForeignPtr . unGObject
castToCellRendererCairo :: GObjectClass obj => obj -> CellRendererCairo
castToCellRendererCairo = castTo gTypeCellRendererCairo "CellRendererCairo"
gTypeCellRendererCairo :: GType
gTypeCellRendererCairo =
gtk_cell_renderer_cairo_get_type
cellRendererCairoNew :: IO CellRendererCairo
cellRendererCairoNew = do
obj <- makeNewObject mkCellRendererCairo $
liftM castPtr $ gtk_cell_renderer_cairo_new
return obj
cellRenderer
:: CellRendererCairoClass self => WriteAttr self (Rectangle -> Render ())
cellRenderer = writeAttr cellRendererSetRenderer
cellRendererSetRenderer
:: CellRendererCairoClass self => self -> (Rectangle -> Render ()) -> IO ()
cellRendererSetRenderer self callback = do
sptr <- newStablePtr cb
gclosurePtr <- gtk2hs_closure_new sptr
withForeignPtr (unGObject $ toGObject self)
(\p -> set_cell_renderer (castPtr p) gclosurePtr)
where
cb cptr x y width height = do
let rect = Rectangle x y width height
context = Cairo cptr
runReaderT (runRender (callback rect)) context
status context >>= \stat -> unless
(stat == StatusSuccess) $ fail =<< statusToString stat
foreign import ccall "gtk_cell_renderer_cairo_set_cell_renderer"
set_cell_renderer :: Ptr () -> Ptr GClosure -> IO ()
foreign import ccall unsafe "gtk2hs_closure_new"
gtk2hs_closure_new :: StablePtr a -> IO (Ptr GClosure)
foreign import ccall unsafe "hsgthread.h >k2hs_g_object_unref_from_mainloop"
objectUnrefFromMainloop :: FinalizerPtr a
castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String
-> (obj -> obj')
castTo gtype objTypeName obj =
case toGObject obj of
gobj@(GObject objFPtr)
| typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype
-> unsafeCastGObject gobj
| otherwise -> error $ "Cannot cast object to " ++ objTypeName
foreign import ccall unsafe "Graphics/UI/Gtk/ModelView/CellRendererCairo.chs.h gtk_cell_renderer_cairo_get_type"
gtk_cell_renderer_cairo_get_type :: CUInt
foreign import ccall unsafe "Graphics/UI/Gtk/ModelView/CellRendererCairo.chs.h gtk_cell_renderer_cairo_new"
gtk_cell_renderer_cairo_new :: (IO (Ptr ()))