mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-06 07:13:37 +00:00
44 lines
1.3 KiB
Haskell
44 lines
1.3 KiB
Haskell
|
module MetaBrush.Render.Util
|
||
|
|
( withRGBA, showRGBA
|
||
|
|
, widgetAddClasses, widgetAddClass )
|
||
|
|
where
|
||
|
|
|
||
|
|
-- base
|
||
|
|
import GHC.Stack
|
||
|
|
( HasCallStack )
|
||
|
|
|
||
|
|
-- gi-gdk
|
||
|
|
import qualified GI.Gdk as GDK
|
||
|
|
|
||
|
|
-- text
|
||
|
|
import Data.Text
|
||
|
|
( Text )
|
||
|
|
import qualified Data.Text as Text
|
||
|
|
( pack )
|
||
|
|
|
||
|
|
-- transformers
|
||
|
|
import Control.Monad.IO.Class
|
||
|
|
( MonadIO(liftIO) )
|
||
|
|
|
||
|
|
--------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
withRGBA :: MonadIO m => GDK.RGBA -> ( Double -> Double -> Double -> Double -> m b ) -> m b
|
||
|
|
withRGBA rgba f = do
|
||
|
|
r <- GDK.getRGBARed rgba
|
||
|
|
g <- GDK.getRGBAGreen rgba
|
||
|
|
b <- GDK.getRGBABlue rgba
|
||
|
|
a <- GDK.getRGBAAlpha rgba
|
||
|
|
f r g b a
|
||
|
|
|
||
|
|
showRGBA :: MonadIO m => GDK.RGBA -> m String
|
||
|
|
showRGBA rgba = withRGBA rgba \ r g b a ->
|
||
|
|
pure $ "rgba(" ++ show r ++ "," ++ show g ++ "," ++ show b ++ "," ++ show a ++ ")"
|
||
|
|
|
||
|
|
widgetAddClasses :: ( HasCallStack, GTK.IsWidget widget, MonadIO m ) => widget -> [Text] -> m ()
|
||
|
|
widgetAddClasses widget classNames = do
|
||
|
|
styleContext <- GTK.widgetGetStyleContext widget
|
||
|
|
for_ classNames ( GTK.styleContextAddClass styleContext )
|
||
|
|
|
||
|
|
widgetAddClass :: ( HasCallStack, GTK.IsWidget widget, MonadIO m ) => widget -> Text -> m ()
|
||
|
|
widgetAddClass widget className = GTK.widgetGetStyleContext widget >>= ( `GTK.styleContextAddClass` className )
|