packages feed

taffybar-2.0.0: src/System/Taffybar/Compat/GtkLibs.hs

-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Compat.GtkLibs
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
-----------------------------------------------------------------------------
module System.Taffybar.Compat.GtkLibs where

import           Control.Monad.IO.Class
import           Data.GI.Base.ManagedPtr
import           Data.Word
import           Foreign.ForeignPtr
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           GI.GdkPixbuf.Enums
import qualified GI.GdkPixbuf.Objects.Pixbuf as PB
import qualified GI.Gtk
import qualified Graphics.UI.Gtk as Gtk
import qualified Graphics.UI.Gtk.Types as Gtk
import           System.Glib.GObject

fromGIPixBuf :: MonadIO m => PB.Pixbuf -> m Gtk.Pixbuf
fromGIPixBuf (PB.Pixbuf pbManagedPtr) = liftIO $
  wrapNewGObject Gtk.mkPixbuf (castPtr <$> disownManagedPtr pbManagedPtr)

fromGIWidget :: MonadIO m => GI.Gtk.Widget -> m Gtk.Widget
fromGIWidget (GI.Gtk.Widget wManagedPtr) = liftIO $
  wrapNewGObject Gtk.mkWidget (castPtr <$> disownManagedPtr wManagedPtr)

toGIWidget :: MonadIO m => Gtk.Widget -> m GI.Gtk.Widget
toGIWidget widget = liftIO $ do
  fPtr <- withForeignPtr (Gtk.unWidget widget) $
          flip GI.Gtk.newManagedPtr (return ()) . castPtr
  return $! GI.Gtk.Widget fPtr

toGIWindow :: MonadIO m => Gtk.Window -> m GI.Gtk.Window
toGIWindow window = liftIO $ do
  let wid = Gtk.toWidget window
  fPtr <- withForeignPtr (Gtk.unWidget wid) $ flip GI.Gtk.newManagedPtr (return ()) . castPtr
  return $! GI.Gtk.Window fPtr

-- | Call the GI version of 'pixbufNewFromData' with sensible parameters. The
-- provided ptr will be freed when the pixbuf is destroyed.
pixbufNewFromData :: (Integral p2, Integral p1) => Ptr Word8 -> p2 -> p1 -> IO Gtk.Pixbuf
pixbufNewFromData ptr w h = do
  let width = fromIntegral w
      height = fromIntegral h
      rowStride = width * 4
  giPb <- PB.pixbufNewFromData ptr ColorspaceRgb True 8
    width height rowStride (Just free)
  fromGIPixBuf giPb