{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} module MetaBrush.Asset.Colours ( ColourRecord(..), ColourType , colours ) where -- base import Data.Traversable ( for ) -- gi-gdk import qualified GI.Gdk as GDK -- gi-gtk import qualified GI.Gtk as GTK -- text import Data.Text ( Text ) -------------------------------------------------------------------------------- data ColourRecord a = Colours { bg :: !a , viewport_bg :: !a , plain :: !a , contrast :: !a , highlight :: !a , logo_base :: !a , logo_highlight :: !a , viewport_scrollbar :: !a , tab_scrollbar :: !a , ruler :: !a , magnifier :: !a , glass :: !a , cursor :: !a , point :: !a , control :: !a } deriving stock ( Show, Functor, Foldable, Traversable ) data ColourType = Color | BackgroundColor deriving stock Show data ColourName = ColourName { colourName :: !Text , colourType :: !ColourType , stateFlags :: ![ GTK.StateFlags ] } deriving stock Show colourNames :: ColourRecord ColourName colourNames = Colours { bg = ColourName "bg" BackgroundColor [ GTK.StateFlagsNormal ] , viewport_bg = ColourName "viewport_bg" BackgroundColor [ GTK.StateFlagsNormal ] , plain = ColourName "plain" Color [ GTK.StateFlagsNormal ] , contrast = ColourName "contrast" Color [ GTK.StateFlagsNormal ] , highlight = ColourName "highlight" Color [ GTK.StateFlagsNormal ] , logo_base = ColourName "logo_base" Color [ GTK.StateFlagsNormal ] , logo_highlight = ColourName "logo_highlight" Color [ GTK.StateFlagsNormal ] , viewport_scrollbar = ColourName "viewport_scrollbar" Color [ GTK.StateFlagsNormal ] , tab_scrollbar = ColourName "tab_scrollbar" Color [ GTK.StateFlagsNormal ] , ruler = ColourName "ruler" BackgroundColor [ GTK.StateFlagsNormal ] , magnifier = ColourName "magnifier" Color [ GTK.StateFlagsNormal ] , glass = ColourName "glass" Color [ GTK.StateFlagsNormal ] , cursor = ColourName "cursor" Color [ GTK.StateFlagsNormal ] , point = ColourName "point" Color [ GTK.StateFlagsNormal ] , control = ColourName "control" Color [ GTK.StateFlagsNormal ] } type Colours = ColourRecord GDK.RGBA colours :: GTK.WidgetPath -> IO Colours colours windowWidgetPath = for colourNames \ ( ColourName { .. } ) -> do style <- GTK.styleContextNew GTK.styleContextSetPath style windowWidgetPath GTK.styleContextAddClass style colourName case colourType of BackgroundColor -> GTK.styleContextGetBackgroundColor style stateFlags Color -> GTK.styleContextGetColor style stateFlags