metabrush/src/app/MetaBrush/Asset/Colours.hs

{-# LANGUAGE BlockArguments     #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}

{-# OPTIONS_GHC -fno-warn-deprecations #-}

module MetaBrush.Asset.Colours
  ( ColourRecord(..), ColourType
  , Colours, getColours
  )
  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
  , active              :: !a
  , highlight           :: !a
  , cursor              :: !a
  , cursorOutline       :: !a
  , plain               :: !a
  , base                :: !a
  , splash              :: !a
  , pathPoint           :: !a
  , pathPointOutline    :: !a
  , controlPoint        :: !a
  , controlPointOutline :: !a
  , path                :: !a
  , brushStroke         :: !a
  , pointHover          :: !a
  , pointSelected       :: !a
  , viewport            :: !a
  , viewportScrollbar   :: !a
  , tabScrollbar        :: !a
  , magnifier           :: !a
  , glass               :: !a
  }
  deriving stock ( Show, Functor, Foldable, Traversable )

data ColourType
  = Colour
  | BackgroundColour
  deriving stock Show

data ColourName
  = ColourName
    { colourName :: !Text
    , colourType :: !ColourType
    , stateFlags :: ![ GTK.StateFlags ]
    }
  deriving stock Show

colourNames :: ColourRecord ColourName
colourNames = Colours
  { bg                  = ColourName "bg"                BackgroundColour [ GTK.StateFlagsNormal ]
  , active              = ColourName "active"            BackgroundColour [ GTK.StateFlagsNormal ]
  , highlight           = ColourName "highlight"                   Colour [ GTK.StateFlagsNormal ]
  , cursor              = ColourName "cursor"                      Colour [ GTK.StateFlagsNormal ]
  , cursorOutline       = ColourName "cursorStroke"                Colour [ GTK.StateFlagsNormal ]
  , plain               = ColourName "plain"                       Colour [ GTK.StateFlagsNormal ]
  , base                = ColourName "base"                        Colour [ GTK.StateFlagsNormal ]
  , splash              = ColourName "splash"                      Colour [ GTK.StateFlagsNormal ]
  , pathPoint           = ColourName "pathPoint"                   Colour [ GTK.StateFlagsNormal ]
  , pathPointOutline    = ColourName "pathPointStroke"             Colour [ GTK.StateFlagsNormal ]
  , controlPoint        = ColourName "controlPoint"                Colour [ GTK.StateFlagsNormal ]
  , controlPointOutline = ColourName "controlPointStroke"          Colour [ GTK.StateFlagsNormal ]
  , path                = ColourName "path"                        Colour [ GTK.StateFlagsNormal ]
  , brushStroke         = ColourName "brushStroke"                 Colour [ GTK.StateFlagsNormal ]
  , pointHover          = ColourName "pointHover"                  Colour [ GTK.StateFlagsNormal ]
  , pointSelected       = ColourName "pointSelected"               Colour [ GTK.StateFlagsNormal ]
  , viewport            = ColourName "viewport"          BackgroundColour [ GTK.StateFlagsNormal ]
  , viewportScrollbar   = ColourName "viewportScrollbar" BackgroundColour [ GTK.StateFlagsNormal ]
  , tabScrollbar        = ColourName "tabScrollbar"      BackgroundColour [ GTK.StateFlagsNormal ]
  , magnifier           = ColourName "magnifier"                   Colour [ GTK.StateFlagsNormal ]
  , glass               = ColourName "glass"                       Colour [ GTK.StateFlagsNormal ]
  }

type Colours = ColourRecord GDK.RGBA

getColours :: GTK.WidgetPath -> IO Colours
getColours windowWidgetPath =
  for colourNames \ ( ColourName { .. } ) -> do
    style <- GTK.styleContextNew
    GTK.styleContextSetPath  style windowWidgetPath
    GTK.styleContextAddClass style colourName
    case colourType of
      BackgroundColour -> GTK.styleContextGetBackgroundColor style stateFlags
      Colour           -> GTK.styleContextGetColor           style stateFlags