{-|
Module      : Monomer.Widgets.Singles.SeparatorLine
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

SeparatorLine is used for adding a separator line between two widgets. It adapts
to the active layout direction, creating a vertical line on a horizontal layout
and vice versa.

@
hstack [
  label "Left half",
  separatorLine,
  label "Right half"
]
@

The separator line has the provided width in the direction orthogonal to the
parent layout, and takes all the available space in the other axis. In case of
wanting a shorter line, padding should be used.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.SeparatorLine (
  -- * Configuration
  SeparatorLineCfg,
  -- * Constructors
  separatorLine,
  separatorLine_
) where

import Control.Applicative ((<|>))
import Control.Lens ((^.))
import Data.Default
import Data.Maybe
import Data.Tuple

import Monomer.Widgets.Single

import qualified Monomer.Core.Lens as L

{-|
Configuration options for separatorLine:

- 'width': the max width of the line.
- 'resizeFactor': flexibility to have more or less spaced assigned.
-}
data SeparatorLineCfg = SeparatorLineCfg {
  SeparatorLineCfg -> Maybe Double
_slcWidth :: Maybe Double,
  SeparatorLineCfg -> Maybe Double
_slcFactor :: Maybe Double
}

instance Default SeparatorLineCfg where
  def :: SeparatorLineCfg
def = SeparatorLineCfg {
    _slcWidth :: Maybe Double
_slcWidth = forall a. Maybe a
Nothing,
    _slcFactor :: Maybe Double
_slcFactor = forall a. Maybe a
Nothing
  }

instance Semigroup SeparatorLineCfg where
  <> :: SeparatorLineCfg -> SeparatorLineCfg -> SeparatorLineCfg
(<>) SeparatorLineCfg
s1 SeparatorLineCfg
s2 = SeparatorLineCfg {
    _slcWidth :: Maybe Double
_slcWidth = SeparatorLineCfg -> Maybe Double
_slcWidth SeparatorLineCfg
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SeparatorLineCfg -> Maybe Double
_slcWidth SeparatorLineCfg
s1,
    _slcFactor :: Maybe Double
_slcFactor = SeparatorLineCfg -> Maybe Double
_slcFactor SeparatorLineCfg
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SeparatorLineCfg -> Maybe Double
_slcFactor SeparatorLineCfg
s1
  }

instance Monoid SeparatorLineCfg where
  mempty :: SeparatorLineCfg
mempty = forall a. Default a => a
def

instance CmbWidth SeparatorLineCfg where
  width :: Double -> SeparatorLineCfg
width Double
w = forall a. Default a => a
def {
    _slcWidth :: Maybe Double
_slcWidth = forall a. a -> Maybe a
Just Double
w
  }

instance CmbResizeFactor SeparatorLineCfg where
  resizeFactor :: Double -> SeparatorLineCfg
resizeFactor Double
f = forall a. Default a => a
def {
    _slcFactor :: Maybe Double
_slcFactor = forall a. a -> Maybe a
Just Double
f
  }

-- | Creates a separatorLine widget.
separatorLine :: WidgetNode s e
separatorLine :: forall s e. WidgetNode s e
separatorLine = forall s e. [SeparatorLineCfg] -> WidgetNode s e
separatorLine_ forall a. Default a => a
def

-- | Creates a separatorLine widget. Accepts config.
separatorLine_ :: [SeparatorLineCfg] -> WidgetNode s e
separatorLine_ :: forall s e. [SeparatorLineCfg] -> WidgetNode s e
separatorLine_ [SeparatorLineCfg]
configs = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"separatorLine" forall {s} {e}. Widget s e
widget where
  config :: SeparatorLineCfg
config = forall a. Monoid a => [a] -> a
mconcat (forall t. CmbResizeFactor t => Double -> t
resizeFactor Double
0 forall a. a -> [a] -> [a]
: [SeparatorLineCfg]
configs)
  widget :: Widget s e
widget = forall s e. SeparatorLineCfg -> Widget s e
makeSeparatorLine SeparatorLineCfg
config

makeSeparatorLine :: SeparatorLineCfg -> Widget s e
makeSeparatorLine :: forall s e. SeparatorLineCfg -> Widget s e
makeSeparatorLine !SeparatorLineCfg
config = forall {s} {e}. Widget s e
widget where
  widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle () forall a. Default a => a
def {
    singleGetBaseStyle :: SingleGetBaseStyle s e
singleGetBaseStyle = forall {s} {e} {p}. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
    singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReq,
    singleRender :: SingleRenderHandler s e
singleRender = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
  }

  getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = forall a. a -> Maybe a
Just Style
style where
    style :: Style
style = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasSeparatorLineStyle s a => Lens' s a
L.separatorLineStyle

  getSizeReq :: WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node = (SizeReq, SizeReq)
sizeReq where
    theme :: ThemeState
theme = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
    direction :: LayoutDirection
direction = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasLayoutDirection s a => Lens' s a
L.layoutDirection
    width :: Double
width = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasSeparatorLineWidth s a => Lens' s a
L.separatorLineWidth) (SeparatorLineCfg -> Maybe Double
_slcWidth SeparatorLineCfg
config)
    factor :: Double
factor = forall a. a -> Maybe a -> a
fromMaybe Double
0 (SeparatorLineCfg -> Maybe Double
_slcFactor SeparatorLineCfg
config)

    isFixed :: Bool
isFixed = Double
factor forall a. Ord a => a -> a -> Bool
< Double
0.01
    flexSide :: SizeReq
flexSide = Double -> Double -> SizeReq
flexSize Double
10 Double
0.5
    fixedW :: SizeReq
fixedW = Double -> SizeReq
fixedSize Double
width
    flexW :: SizeReq
flexW = Double -> Double -> SizeReq
flexSize Double
width Double
factor
    expandW :: SizeReq
expandW = Double -> Double -> SizeReq
expandSize Double
width Double
factor

    sizeReq :: (SizeReq, SizeReq)
sizeReq
      | Bool
isFixed Bool -> Bool -> Bool
&& LayoutDirection
direction forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutNone = (SizeReq
fixedW, SizeReq
fixedW)
      | Bool
isFixed Bool -> Bool -> Bool
&& LayoutDirection
direction forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutHorizontal = (SizeReq
fixedW, SizeReq
flexSide)
      | Bool
isFixed = (SizeReq
flexSide, SizeReq
fixedW)
      | LayoutDirection
direction forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutNone = (SizeReq
expandW, SizeReq
expandW)
      | LayoutDirection
direction forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutHorizontal = (SizeReq
expandW, SizeReq
flexW)
      | Bool
otherwise = (SizeReq
flexW, SizeReq
expandW)

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    Renderer -> IO ()
beginPath Renderer
renderer
    Renderer -> Color -> IO ()
setFillColor Renderer
renderer Color
fgColor
    Renderer -> Rect -> IO ()
renderRect Renderer
renderer Rect
lineRect
    Renderer -> IO ()
fill Renderer
renderer
    where
      theme :: ThemeState
theme = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
      style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      direction :: LayoutDirection
direction = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasLayoutDirection s a => Lens' s a
L.layoutDirection
      fgColor :: Color
fgColor = StyleState -> Color
styleFgColor StyleState
style
      width :: Double
width = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasSeparatorLineWidth s a => Lens' s a
L.separatorLineWidth) (SeparatorLineCfg -> Maybe Double
_slcWidth SeparatorLineCfg
config)

      Rect Double
cx Double
cy Double
cw Double
ch = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
      lineW :: Double
lineW = Double
cx forall a. Num a => a -> a -> a
+ (Double
cw forall a. Num a => a -> a -> a
- Double
width) forall a. Fractional a => a -> a -> a
/ Double
2
      lineH :: Double
lineH = Double
cy forall a. Num a => a -> a -> a
+ (Double
ch forall a. Num a => a -> a -> a
- Double
width) forall a. Fractional a => a -> a -> a
/ Double
2
      lineRect :: Rect
lineRect
        | LayoutDirection
direction forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutNone = Double -> Double -> Double -> Double -> Rect
Rect Double
cx Double
cy Double
cw Double
ch
        | LayoutDirection
direction forall a. Eq a => a -> a -> Bool
== LayoutDirection
LayoutHorizontal = Double -> Double -> Double -> Double -> Rect
Rect Double
lineW Double
cy Double
width Double
ch
        | Bool
otherwise = Double -> Double -> Double -> Double -> Rect
Rect Double
cx Double
lineH Double
cw Double
width