content: {-|
  Module      : Monomer.Core.SizeReq
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Helper functions creating, validating and merging size requirements.
  -}
  {-# LANGUAGE Strict #-}
  
  module Monomer.Core.SizeReq (
    SizeReqUpdater,
    clearExtra,
    clearExtraW,
    clearExtraH,
    fixedToMinW,
    fixedToMinH,
    fixedToMaxW,
    fixedToMaxH,
    fixedToExpandW,
    fixedToExpandH,
    sizeReqBounded,
    sizeReqValid,
    sizeReqAddStyle,
    sizeReqMin,
    sizeReqMax,
    sizeReqMaxBounded,
    sizeReqFixed,
    sizeReqFlex,
    sizeReqExtra,
    sizeReqFactor,
    sizeReqMergeSum,
    sizeReqMergeMax
  ) where
  
  import Control.Lens ((&), (^.), (.~))
  import Data.Bits
  import Data.Default
  import Data.Maybe
  
  import Monomer.Common
  import Monomer.Core.Style
  import Monomer.Core.StyleUtil
  import Monomer.Helper
  
  import qualified Monomer.Core.Lens as L
  
  -- | Transforms a SizeReq pair by applying an arbitrary operation.
  type SizeReqUpdater = (SizeReq, SizeReq) -> (SizeReq, SizeReq)
  
  -- | Clears the extra field of a pair of SizeReqs.
  clearExtra :: SizeReqUpdater
  clearExtra (reqW, reqH) = (reqW & L.extra .~ 0, reqH & L.extra .~ 0)
  
  -- | Clears the horizontal extra field of a pair of SizeReqs.
  clearExtraW :: SizeReqUpdater
  clearExtraW (reqW, reqH) = (reqW & L.extra .~ 0, reqH)
  
  -- | Clears the vertical extra field of a pair of SizeReqs.
  clearExtraH :: SizeReqUpdater
  clearExtraH (reqW, reqH) = (reqW, reqH & L.extra .~ 0)
  
  -- | Switches a SizeReq pair from fixed size to minimum size.
  fixedToMin
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToMin fs (reqW, reqH) = (newReqW, newReqH) where
    (fixedW, fixedH) = (reqW ^. L.fixed, reqH ^. L.fixed)
    newReqW = SizeReq fixedW 0 fixedW fs
    newReqH = SizeReq fixedH 0 fixedH fs
  
  -- | Switches a SizeReq pair from fixed width to minimum width.
  fixedToMinW
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToMinW fw (SizeReq fixed _ _ _, reqH) = (newReqW, reqH) where
    newReqW = SizeReq fixed 0 fixed fw
  
  -- | Switches a SizeReq pair from fixed height to minimum height.
  fixedToMinH
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToMinH fh (reqW, SizeReq fixed _ _ _) = (reqW, newReqH) where
    newReqH = SizeReq fixed 0 fixed fh
  
  -- | Switches a SizeReq pair from fixed size to maximum size.
  fixedToMax
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToMax fs (reqW, reqH) = (newReqW, newReqH) where
    (fixedW, fixedH) = (reqW ^. L.fixed, reqH ^. L.fixed)
    newReqW = SizeReq 0 fixedW 0 fs
    newReqH = SizeReq 0 fixedH 0 fs
  
  -- | Switches a SizeReq pair from fixed width to maximum width.
  fixedToMaxW
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToMaxW fw (SizeReq fixed _ _ _, reqH) = (newReqW, reqH) where
    newReqW = SizeReq 0 fixed 0 fw
  
  -- | Switches a SizeReq pair from fixed height to maximum height.
  fixedToMaxH
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToMaxH fh (reqW, SizeReq fixed _ _ _) = (reqW, newReqH) where
    newReqH = SizeReq 0 fixed 0 fh
  
  -- | Switches a SizeReq pair from fixed size to expand size.
  fixedToExpand
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToExpand fs (reqW, reqH) = (newReqW, newReqH) where
    (fixedW, fixedH) = (reqW ^. L.fixed, reqH ^. L.fixed)
    newReqW = SizeReq 0 fixedW fixedW fs
    newReqH = SizeReq 0 fixedH fixedH fs
  
  -- | Switches a SizeReq pair from fixed width to expand width.
  fixedToExpandW
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToExpandW fw (SizeReq fixed _ _ _, reqH) = (newReqW, reqH) where
    newReqW = SizeReq 0 fixed fixed fw
  
  -- | Switches a SizeReq pair from fixed height to expand height.
  fixedToExpandH
    :: Double          -- ^ The resize factor.
    -> SizeReqUpdater  -- ^ The updated SizeReq.
  fixedToExpandH fh (reqW, SizeReq fixed _ _ _) = (reqW, newReqH) where
    newReqH = SizeReq 0 fixed fixed fh
  
  -- | Returns a bounded value by the SizeReq, starting from value and offset.
  sizeReqBounded :: SizeReq -> Double -> Double -> Double
  sizeReqBounded sizeReq offset value = max minSize (min maxSize value) where
    minSize = offset + sizeReqMin sizeReq
    maxSize = offset + sizeReqMax sizeReq
  
  -- | Checks that value, given an offset, matches a SizeReq.
  sizeReqValid :: SizeReq -> Double -> Double -> Bool
  sizeReqValid sizeReq offset value = doubleInRange minSize maxSize value where
    minSize = offset + sizeReqMin sizeReq
    maxSize = offset + sizeReqMax sizeReq
  
  -- | Adds border/padding size to a SizeReq pair.
  sizeReqAddStyle :: StyleState -> (SizeReq, SizeReq) -> (SizeReq, SizeReq)
  sizeReqAddStyle style (reqW, reqH) = (newReqW, newReqH) where
    Size w h = fromMaybe def (addOuterSize style def)
    realReqW = fromMaybe reqW (_sstSizeReqW style)
    realReqH = fromMaybe reqH (_sstSizeReqH style)
    newReqW = modifySizeReq realReqW (+w)
    newReqH = modifySizeReq realReqH (+h)
  
  -- | Returns the minimum valid value for a SizeReq.
  sizeReqMin :: SizeReq -> Double
  sizeReqMin req = req ^. L.fixed
  
  -- | Returns the maximum valid value for a SizeReq. This can be unbounded if
  --   extra field is not zero.
  sizeReqMax :: SizeReq -> Double
  sizeReqMax req
    | req ^. L.extra > 0 = maxNumericValue
    | otherwise = req ^. L.fixed + req ^. L.flex
  
  -- | Returns the maximum, bounded, valid value for a SizeReq. Extra is ignored.
  sizeReqMaxBounded :: SizeReq -> Double
  sizeReqMaxBounded req = req ^. L.fixed + req ^. L.flex
  
  -- | Returns the fixed size of a SizeReq.
  sizeReqFixed :: SizeReq -> Double
  sizeReqFixed req = req ^. L.fixed
  
  -- | Returns the flex size of a SizeReq.
  sizeReqFlex :: SizeReq -> Double
  sizeReqFlex req = req ^. L.flex
  
  -- | Returns the extra size of a SizeReq.
  sizeReqExtra :: SizeReq -> Double
  sizeReqExtra req = req ^. L.extra
  
  -- | Returns the resize factor of a SizeReq.
  sizeReqFactor :: SizeReq -> Double
  sizeReqFactor req = req ^. L.factor
  
  {-|
  Sums two SizeReqs. This is used for combining two widgets one after the other,
  /summing/ their sizes.
  
  The fixed, flex and extra fields are summed individually, while the max factor
  is kept.
  -}
  sizeReqMergeSum :: SizeReq -> SizeReq -> SizeReq
  sizeReqMergeSum req1 req2 = newReq where
    newReq = SizeReq {
      _szrFixed = _szrFixed req1 + _szrFixed req2,
      _szrFlex = _szrFlex req1 + _szrFlex req2,
      _szrExtra = _szrExtra req1 + _szrExtra req2,
      _szrFactor = max (_szrFactor req1) (_szrFactor req2)
    }
  
  {-|
  Merges two SizeReqs. This is used for combining two widgets by keeping the
  largest size requirement.
  
  Fields are combined in order to first satisfy fixed requirements, adapting flex
  if one of the fixed provided more space than required. For both extra and factor
  the largest value is kept.
  -}
  sizeReqMergeMax :: SizeReq -> SizeReq -> SizeReq
  sizeReqMergeMax req1 req2 = newReq where
    isFixedReq1 = round (req1 ^. L.fixed) > 0
    isFixedReq2 = round (req2 ^. L.fixed) > 0
    flexReq1 = req1 ^. L.flex
    flexReq2 = req2 ^. L.flex
    newFixed = max (req1 ^. L.fixed) (req2 ^. L.fixed)
    newFlex
      | not (isFixedReq1 `xor` isFixedReq2) = max flexReq1 flexReq2
      | isFixedReq1 && flexReq1 > flexReq2 = flexReq1
      | isFixedReq2 && flexReq2 > flexReq1 = flexReq2
      | otherwise = max 0 $ max flexReq1 flexReq2 - newFixed
    newReq = SizeReq {
      _szrFixed = newFixed,
      _szrFlex = newFlex,
      _szrExtra = max (req1 ^. L.extra) (req2 ^. L.extra),
      _szrFactor = max (req1 ^. L.factor) (req2 ^. L.factor)
    }
  
  modifySizeReq :: SizeReq -> (Double -> Double) -> SizeReq
  modifySizeReq (SizeReq fixed flex extra factor) fn = SizeReq {
      _szrFixed = if fixed > 0 then fn fixed else 0,
      _szrFlex = if flex > 0 then fn flex else 0,
      _szrExtra = if extra > 0 then fn extra else 0,
      _szrFactor = factor
    }
  
  doubleInRange :: Double -> Double -> Double -> Bool
  doubleInRange minValue maxValue curValue = validMin && validMax where
    minDiff = curValue - minValue
    maxDiff = maxValue - curValue
    -- Some calculations may leave small differences in otherwise valid results
    validMin = minDiff >= 0 || abs minDiff < 0.0001
    validMax = maxDiff >= 0 || abs maxDiff < 0.0001
  