module Graphics.UI.Gtk.Layout.BackgroundContainer where
import Control.Monad.Trans (liftIO)
import Data.IORef
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.GC
import System.Glib.Types
data BackgroundContainer = BackgroundContainer EventBox (IORef (Maybe Pixbuf))
instance WidgetClass BackgroundContainer
instance ObjectClass BackgroundContainer
instance GObjectClass BackgroundContainer where
toGObject (BackgroundContainer ev _) = toGObject ev
unsafeCastGObject ev = (BackgroundContainer (unsafeCastGObject ev) undefined)
instance EventBoxClass BackgroundContainer
instance ContainerClass BackgroundContainer
instance BinClass BackgroundContainer
backgroundContainerNew :: IO BackgroundContainer
backgroundContainerNew = do
ev <- eventBoxNew
ref <- newIORef Nothing
return $ BackgroundContainer ev ref
backgroundContainerNewWithPicture :: FilePath -> IO BackgroundContainer
backgroundContainerNewWithPicture fp = do
ev <- eventBoxNew
pb <- pixbufNewFromFile fp
ref <- newIORef (Just pb)
let wdgt = BackgroundContainer ev ref
wdgt `on` exposeEvent $ liftIO (backgroundExpose wdgt) >> return False
return wdgt
backgroundContainerNewWithPixbuf :: Pixbuf -> IO BackgroundContainer
backgroundContainerNewWithPixbuf pb = do
ev <- eventBoxNew
ref <- newIORef (Just pb)
let wdgt = BackgroundContainer ev ref
wdgt `on` exposeEvent $ liftIO (backgroundExpose wdgt) >> return False
return wdgt
backgroundExpose :: BackgroundContainer -> IO ()
backgroundExpose (BackgroundContainer ev ref) = do
dw <- widgetGetDrawWindow ev
drawWindowClear dw
pixbufM <- readIORef ref
case pixbufM of
Nothing -> return ()
Just pb -> do sz@(w,h) <- widgetGetSize ev
pb' <- pixbufScaleSimple pb w h InterpBilinear
drawWindowBeginPaintRect dw (Rectangle 0 0 w h)
gc <- gcNew dw
drawPixbuf dw gc pb' 0 0 0 0 (1) (1) RgbDitherNone (1) (1)
drawWindowEndPaint dw
backgroundSetPicture :: BackgroundContainer -> Maybe FilePath -> IO()
backgroundSetPicture (BackgroundContainer ev ref) fpM = do
pbM <- maybe (return Nothing) (fmap Just . pixbufNewFromFile) fpM
writeIORef ref pbM
backgroundSetPixbuf :: BackgroundContainer -> Maybe Pixbuf -> IO()
backgroundSetPixbuf (BackgroundContainer ev ref) pbM =
writeIORef ref pbM