content: {-|
  Module      : Monomer.Core.StyleTypes
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Basic types for styling widgets.
  -}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE StrictData #-}
  
  module Monomer.Core.StyleTypes where
  
  import Control.Applicative ((<|>))
  import Data.Default
  import GHC.Generics
  
  import Monomer.Common
  import Monomer.Graphics.Types
  
  {-|
  Represents a size requirement for a specific axis. Mainly used by stack and box,
  with grid using it as the base for its calculations. Each field represents:
  
  - Fixed: A minimum size required by the widget. This type of space is the first
  that gets assigned.
  - Flex: Additional space the widget accepts, up to the provided value. After
  fixed requirements are satisfied, flex sizes are assigned proportionally
  considering factor.
  - Extra: After flex is satisfied, the remaining space is distributed
  proportionally, considering factor, to all non zero extra requirements. There is
  no limit to how much extra space can be assigned.
  - Factor: How much flex/extra space a widget will get proportionally. This also
  affects how much a requirement is willing to lose: a value less than 1 can
  receive less space, but gives up less too.
  -}
  data SizeReq = SizeReq {
    _szrFixed :: Double,
    _szrFlex :: Double,
    _szrExtra :: Double,
    _szrFactor :: Factor
  } deriving (Eq, Show, Generic)
  
  instance Default SizeReq where
    def = SizeReq {
      _szrFixed = 0,
      _szrFlex = 0,
      _szrExtra = 0,
      _szrFactor = 1
    }
  
  -- | Different mouse pointer types.
  data CursorIcon
    = CursorArrow
    | CursorHand
    | CursorIBeam
    | CursorInvalid
    | CursorSizeH
    | CursorSizeV
    | CursorDiagTL
    | CursorDiagTR
    | CursorSizeAll
    | CursorWait
    | CursorWaitArrow
    | CursorCrosshair
    deriving (Eq, Ord, Enum, Show, Generic)
  
  instance Default CursorIcon where
    def = CursorArrow
  
  {-|
  Main style type, comprised of configurations for the different states:
  
  - Basic: Starting state for a widget, without any kind of interaction. This
  is used as the base for all other states, which override values as needed.
  - Hover: The mouse pointer is on top of the current widget.
  - Focus: The widget has keyboard focus.
  - Focus-Hover: The widget has keyboard focus and mouse is on top. Without this
  state one of Hover or Focus would take precedence and it would not be possible
  to specify the desired behavior.
  - Active: The mouse button is currently pressed and the pointer is within the
  boundaries of the widget.
  - Disabled: The widget is disabled.
  -}
  data Style = Style {
    _styleBasic :: Maybe StyleState,
    _styleHover :: Maybe StyleState,
    _styleFocus :: Maybe StyleState,
    _styleFocusHover :: Maybe StyleState,
    _styleActive :: Maybe StyleState,
    _styleDisabled :: Maybe StyleState
  } deriving (Eq, Show, Generic)
  
  instance Default Style where
    def = Style {
      _styleBasic = Nothing,
      _styleHover = Nothing,
      _styleFocus = Nothing,
      _styleFocusHover = Nothing,
      _styleActive = Nothing,
      _styleDisabled = Nothing
    }
  
  instance Semigroup Style where
    (<>) style1 style2 = Style {
      _styleBasic = _styleBasic style1 <> _styleBasic style2,
      _styleHover = _styleHover style1 <> _styleHover style2,
      _styleFocus = _styleFocus style1 <> _styleFocus style2,
      _styleFocusHover = _styleFocusHover style1 <> _styleFocusHover style2,
      _styleActive = _styleActive style1 <> _styleActive style2,
      _styleDisabled = _styleDisabled style1 <> _styleDisabled style2
    }
  
  instance Monoid Style where
    mempty = def
  
  {-|
  Customizable style items for a specific state. All values are optional, and can
  be combined with the latest values taking precedence when the previous value is
  not empty.
  -}
  data StyleState = StyleState {
    -- | User defined width req. Takes precedence over widget req.
    _sstSizeReqW :: Maybe SizeReq,
    -- | User defined height req. Takes precedence over widget req.
    _sstSizeReqH :: Maybe SizeReq,
    -- | Space between the border and the content of the widget
    _sstPadding :: Maybe Padding,
    -- | Border definition.
    _sstBorder :: Maybe Border,
    -- | Radius. Affects both border and background.
    _sstRadius :: Maybe Radius,
    -- | Background color.
    _sstBgColor :: Maybe Color,
    -- | Main foreground color. Each widget decides how it uses it.
    _sstFgColor :: Maybe Color,
    -- | Secondary foreground color. Each widget decides how it uses it.
    _sstSndColor :: Maybe Color,
    -- | Highlight color. Each widget decides how it uses it.
    _sstHlColor :: Maybe Color,
    -- | Text style, including font, size and color.
    _sstText :: Maybe TextStyle,
    -- | The assigned cursor icon to this specific state.
    _sstCursorIcon :: Maybe CursorIcon
  } deriving (Eq, Show, Generic)
  
  instance Default StyleState where
    def = StyleState {
      _sstSizeReqW = Nothing,
      _sstSizeReqH = Nothing,
      _sstPadding = Nothing,
      _sstBorder = Nothing,
      _sstRadius = Nothing,
      _sstBgColor = Nothing,
      _sstFgColor = Nothing,
      _sstSndColor = Nothing,
      _sstHlColor = Nothing,
      _sstText = Nothing,
      _sstCursorIcon = Nothing
    }
  
  instance Semigroup StyleState where
    (<>) s1 s2 = StyleState {
      _sstSizeReqW = _sstSizeReqW s2 <|> _sstSizeReqW s1,
      _sstSizeReqH = _sstSizeReqH s2 <|> _sstSizeReqH s1,
      _sstPadding = _sstPadding s1 <> _sstPadding s2,
      _sstBorder = _sstBorder s1 <> _sstBorder s2,
      _sstRadius = _sstRadius s1 <> _sstRadius s2,
      _sstBgColor = _sstBgColor s2 <|> _sstBgColor s1,
      _sstFgColor = _sstFgColor s2 <|> _sstFgColor s1,
      _sstSndColor = _sstSndColor s2 <|> _sstSndColor s1,
      _sstHlColor = _sstHlColor s2 <|> _sstHlColor s1,
      _sstText = _sstText s1 <> _sstText s2,
      _sstCursorIcon = _sstCursorIcon s2 <|> _sstCursorIcon s1
    }
  
  instance Monoid StyleState where
    mempty = def
  
  -- | Padding definitions (space between border and content) for each side.
  data Padding = Padding {
    _padLeft :: Maybe Double,
    _padRight :: Maybe Double,
    _padTop :: Maybe Double,
    _padBottom :: Maybe Double
  } deriving (Eq, Show, Generic)
  
  instance Default Padding where
    def = Padding {
      _padLeft = Nothing,
      _padRight = Nothing,
      _padTop = Nothing,
      _padBottom = Nothing
    }
  
  instance Semigroup Padding where
    (<>) p1 p2 = Padding {
      _padLeft = _padLeft p2 <|> _padLeft p1,
      _padRight = _padRight p2 <|> _padRight p1,
      _padTop = _padTop p2 <|> _padTop p1,
      _padBottom = _padBottom p2 <|> _padBottom p1
    }
  
  instance Monoid Padding where
    mempty = def
  
  -- | Defines width and color for a given border side.
  data BorderSide = BorderSide {
    _bsWidth :: Double,
    _bsColor :: Color
  } deriving (Eq, Show, Generic)
  
  instance Default BorderSide where
    def = BorderSide {
      _bsWidth = 0,
      _bsColor = def
    }
  
  instance Semigroup BorderSide where
    (<>) b1 b2 = b2
  
  instance Monoid BorderSide where
    mempty = def
  
  -- | Border definitions for each side.
  data Border = Border {
    _brdLeft :: Maybe BorderSide,
    _brdRight :: Maybe BorderSide,
    _brdTop :: Maybe BorderSide,
    _brdBottom :: Maybe BorderSide
  } deriving (Eq, Show, Generic)
  
  instance Default Border where
    def = Border {
      _brdLeft = Nothing,
      _brdRight = Nothing,
      _brdTop = Nothing,
      _brdBottom = Nothing
    }
  
  instance Semigroup Border where
    (<>) b1 b2 = Border {
      _brdLeft = _brdLeft b1 <> _brdLeft b2,
      _brdRight = _brdRight b1 <> _brdRight b2,
      _brdTop = _brdTop b1 <> _brdTop b2,
      _brdBottom = _brdBottom b1 <> _brdBottom b2
    }
  
  instance Monoid Border where
    mempty = def
  
  -- | Type of corner radius.
  data RadiusType
    = RadiusInner
    | RadiusBoth
    deriving (Eq, Show, Generic)
  
  instance Default RadiusType where
    def = RadiusBoth
  
  instance Semigroup RadiusType where
    (<>) rc1 rc2 = rc2
  
  instance Monoid RadiusType where
    mempty = def
  
  -- | Defines radius type and width/radius for a given corner.
  newtype RadiusCorner = RadiusCorner {
    _rcrWidth :: Double
  } deriving (Eq, Show, Generic)
  
  instance Default RadiusCorner where
    def = RadiusCorner {
      _rcrWidth = def
    }
  
  instance Semigroup RadiusCorner where
    (<>) rc1 rc2 = rc2
  
  instance Monoid RadiusCorner where
    mempty = def
  
  -- | Provides radius definitions for each corner.
  data Radius = Radius {
    _radTopLeft :: Maybe RadiusCorner,
    _radTopRight :: Maybe RadiusCorner,
    _radBottomLeft :: Maybe RadiusCorner,
    _radBottomRight :: Maybe RadiusCorner
  } deriving (Eq, Show, Generic)
  
  instance Default Radius where
    def = Radius {
      _radTopLeft = Nothing,
      _radTopRight = Nothing,
      _radBottomLeft = Nothing,
      _radBottomRight = Nothing
    }
  
  instance Semigroup Radius where
    (<>) r1 r2 = Radius {
      _radTopLeft = _radTopLeft r2 <|> _radTopLeft r1,
      _radTopRight = _radTopRight r2 <|> _radTopRight r1,
      _radBottomLeft = _radBottomLeft r2 <|> _radBottomLeft r1,
      _radBottomRight = _radBottomRight r2 <|> _radBottomRight r1
    }
  
  instance Monoid Radius where
    mempty = def
  
  -- | Defines how to break texts into lines.
  data LineBreak
    = OnSpaces
    | OnCharacters
    deriving (Eq, Ord, Enum, Show, Generic)
  
  instance Default LineBreak where
    def = OnSpaces
  
  -- | Text related definitions.
  data TextStyle = TextStyle {
    _txsFont :: Maybe Font,          -- ^ The font type.
    _txsFontSize :: Maybe FontSize,  -- ^ Text size in pixels.
    _txsFontSpaceH :: Maybe FontSpace, -- ^ Horizontal text spacing in pixels.
    _txsFontSpaceV :: Maybe FontSpace, -- ^ Vertical text spacing in pixels.
    _txsFontColor :: Maybe Color,    -- ^ Text color.
    _txsUnderline :: Maybe Bool,     -- ^ True if underline should be displayed.
    _txsOverline :: Maybe Bool,      -- ^ True if overline should be displayed.
    _txsThroughline :: Maybe Bool,   -- ^ True if throughline should be displayed.
    _txsAlignH :: Maybe AlignTH,     -- ^ Horizontal alignment.
    _txsAlignV :: Maybe AlignTV,     -- ^ Vertical alignment.
    _txsLineBreak :: Maybe LineBreak -- ^ Line break option.
  } deriving (Eq, Show, Generic)
  
  instance Default TextStyle where
    def = TextStyle {
      _txsFont = Nothing,
      _txsFontSize = Nothing,
      _txsFontSpaceH = Nothing,
      _txsFontSpaceV = Nothing,
      _txsFontColor = Nothing,
      _txsUnderline = Nothing,
      _txsOverline = Nothing,
      _txsThroughline = Nothing,
      _txsAlignH = Nothing,
      _txsAlignV = Nothing,
      _txsLineBreak = Nothing
    }
  
  instance Semigroup TextStyle where
    (<>) ts1 ts2 = TextStyle {
      _txsFont = _txsFont ts2 <|> _txsFont ts1,
      _txsFontSize = _txsFontSize ts2 <|> _txsFontSize ts1,
      _txsFontSpaceH = _txsFontSpaceH ts2 <|> _txsFontSpaceH ts1,
      _txsFontSpaceV = _txsFontSpaceV ts2 <|> _txsFontSpaceV ts1,
      _txsFontColor = _txsFontColor ts2 <|> _txsFontColor ts1,
      _txsUnderline = _txsUnderline ts2 <|> _txsUnderline ts1,
      _txsOverline = _txsOverline ts2 <|> _txsOverline ts1,
      _txsThroughline = _txsThroughline ts2 <|> _txsThroughline ts1,
      _txsAlignH = _txsAlignH ts2 <|> _txsAlignH ts1,
      _txsAlignV = _txsAlignV ts2 <|> _txsAlignV ts1,
      _txsLineBreak = _txsLineBreak ts2 <|> _txsLineBreak ts1
    }
  
  instance Monoid TextStyle where
    mempty = def
  