{-|
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.StyleTypes
import Monomer.Core.StyleUtil
import Monomer.Core.Util
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 :: SizeReqUpdater
clearExtra (SizeReq
reqW, SizeReq
reqH) = (SizeReq
reqW forall a b. a -> (a -> b) -> b
& forall s a. HasExtra s a => Lens' s a
L.extra forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0, SizeReq
reqH forall a b. a -> (a -> b) -> b
& forall s a. HasExtra s a => Lens' s a
L.extra forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0)

-- | Clears the horizontal extra field of a pair of SizeReqs.
clearExtraW :: SizeReqUpdater
clearExtraW :: SizeReqUpdater
clearExtraW (SizeReq
reqW, SizeReq
reqH) = (SizeReq
reqW forall a b. a -> (a -> b) -> b
& forall s a. HasExtra s a => Lens' s a
L.extra forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0, SizeReq
reqH)

-- | Clears the vertical extra field of a pair of SizeReqs.
clearExtraH :: SizeReqUpdater
clearExtraH :: SizeReqUpdater
clearExtraH (SizeReq
reqW, SizeReq
reqH) = (SizeReq
reqW, SizeReq
reqH forall a b. a -> (a -> b) -> b
& forall s a. HasExtra s a => Lens' s a
L.extra forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0)

-- | Switches a SizeReq pair from fixed size to minimum size.
fixedToMin
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToMin :: Double -> SizeReqUpdater
fixedToMin Double
fs (SizeReq
reqW, SizeReq
reqH) = (SizeReq
newReqW, SizeReq
newReqH) where
  (Double
fixedW, Double
fixedH) = (SizeReq
reqW forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed, SizeReq
reqH forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed)
  newReqW :: SizeReq
newReqW = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
fixedW Double
0 Double
fixedW Double
fs
  newReqH :: SizeReq
newReqH = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
fixedH Double
0 Double
fixedH Double
fs

-- | Switches a SizeReq pair from fixed width to minimum width.
fixedToMinW
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToMinW :: Double -> SizeReqUpdater
fixedToMinW Double
fw (SizeReq Double
fixed Double
_ Double
_ Double
_, SizeReq
reqH) = (SizeReq
newReqW, SizeReq
reqH) where
  newReqW :: SizeReq
newReqW = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
fixed Double
0 Double
fixed Double
fw

-- | Switches a SizeReq pair from fixed height to minimum height.
fixedToMinH
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToMinH :: Double -> SizeReqUpdater
fixedToMinH Double
fh (SizeReq
reqW, SizeReq Double
fixed Double
_ Double
_ Double
_) = (SizeReq
reqW, SizeReq
newReqH) where
  newReqH :: SizeReq
newReqH = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
fixed Double
0 Double
fixed Double
fh

-- | Switches a SizeReq pair from fixed size to maximum size.
fixedToMax
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToMax :: Double -> SizeReqUpdater
fixedToMax Double
fs (SizeReq
reqW, SizeReq
reqH) = (SizeReq
newReqW, SizeReq
newReqH) where
  (Double
fixedW, Double
fixedH) = (SizeReq
reqW forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed, SizeReq
reqH forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed)
  newReqW :: SizeReq
newReqW = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
0 Double
fixedW Double
0 Double
fs
  newReqH :: SizeReq
newReqH = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
0 Double
fixedH Double
0 Double
fs

-- | Switches a SizeReq pair from fixed width to maximum width.
fixedToMaxW
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToMaxW :: Double -> SizeReqUpdater
fixedToMaxW Double
fw (SizeReq Double
fixed Double
_ Double
_ Double
_, SizeReq
reqH) = (SizeReq
newReqW, SizeReq
reqH) where
  newReqW :: SizeReq
newReqW = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
0 Double
fixed Double
0 Double
fw

-- | Switches a SizeReq pair from fixed height to maximum height.
fixedToMaxH
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToMaxH :: Double -> SizeReqUpdater
fixedToMaxH Double
fh (SizeReq
reqW, SizeReq Double
fixed Double
_ Double
_ Double
_) = (SizeReq
reqW, SizeReq
newReqH) where
  newReqH :: SizeReq
newReqH = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
0 Double
fixed Double
0 Double
fh

-- | Switches a SizeReq pair from fixed size to expand size.
fixedToExpand
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToExpand :: Double -> SizeReqUpdater
fixedToExpand Double
fs (SizeReq
reqW, SizeReq
reqH) = (SizeReq
newReqW, SizeReq
newReqH) where
  (Double
fixedW, Double
fixedH) = (SizeReq
reqW forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed, SizeReq
reqH forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed)
  newReqW :: SizeReq
newReqW = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
0 Double
fixedW Double
fixedW Double
fs
  newReqH :: SizeReq
newReqH = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
0 Double
fixedH Double
fixedH Double
fs

-- | Switches a SizeReq pair from fixed width to expand width.
fixedToExpandW
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToExpandW :: Double -> SizeReqUpdater
fixedToExpandW Double
fw (SizeReq Double
fixed Double
_ Double
_ Double
_, SizeReq
reqH) = (SizeReq
newReqW, SizeReq
reqH) where
  newReqW :: SizeReq
newReqW = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
0 Double
fixed Double
fixed Double
fw

-- | Switches a SizeReq pair from fixed height to expand height.
fixedToExpandH
  :: Double          -- ^ The resize factor.
  -> SizeReqUpdater  -- ^ The updated SizeReq.
fixedToExpandH :: Double -> SizeReqUpdater
fixedToExpandH Double
fh (SizeReq
reqW, SizeReq Double
fixed Double
_ Double
_ Double
_) = (SizeReq
reqW, SizeReq
newReqH) where
  newReqH :: SizeReq
newReqH = Double -> Double -> Double -> Double -> SizeReq
SizeReq Double
0 Double
fixed Double
fixed Double
fh

-- | Returns a bounded value by the SizeReq, starting from value and offset.
sizeReqBounded :: SizeReq -> Double -> Double -> Double
sizeReqBounded :: SizeReq -> Double -> Double -> Double
sizeReqBounded SizeReq
sizeReq Double
offset Double
value = forall a. Ord a => a -> a -> a
max Double
minSize (forall a. Ord a => a -> a -> a
min Double
maxSize Double
value) where
  minSize :: Double
minSize = Double
offset forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqMin SizeReq
sizeReq
  maxSize :: Double
maxSize = Double
offset forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqMax SizeReq
sizeReq

-- | Checks that value, given an offset, matches a SizeReq.
sizeReqValid :: SizeReq -> Double -> Double -> Bool
sizeReqValid :: SizeReq -> Double -> Double -> Bool
sizeReqValid SizeReq
sizeReq Double
offset Double
value = Double -> Double -> Double -> Bool
doubleInRange Double
minSize Double
maxSize Double
value where
  minSize :: Double
minSize = Double
offset forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqMin SizeReq
sizeReq
  maxSize :: Double
maxSize = Double
offset forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqMax SizeReq
sizeReq

-- | Adds border/padding size to a SizeReq pair.
sizeReqAddStyle :: StyleState -> (SizeReq, SizeReq) -> (SizeReq, SizeReq)
sizeReqAddStyle :: StyleState -> SizeReqUpdater
sizeReqAddStyle StyleState
style (SizeReq
reqW, SizeReq
reqH) = (SizeReq
newReqW, SizeReq
newReqH) where
  Size Double
w Double
h = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Size -> Maybe Size
addOuterSize StyleState
style forall a. Default a => a
def)
  realReqW :: SizeReq
realReqW = forall a. a -> Maybe a -> a
fromMaybe SizeReq
reqW (StyleState -> Maybe SizeReq
_sstSizeReqW StyleState
style)
  realReqH :: SizeReq
realReqH = forall a. a -> Maybe a -> a
fromMaybe SizeReq
reqH (StyleState -> Maybe SizeReq
_sstSizeReqH StyleState
style)
  newReqW :: SizeReq
newReqW = SizeReq -> (Double -> Double) -> SizeReq
modifySizeReq SizeReq
realReqW (forall a. Num a => a -> a -> a
+Double
w)
  newReqH :: SizeReq
newReqH = SizeReq -> (Double -> Double) -> SizeReq
modifySizeReq SizeReq
realReqH (forall a. Num a => a -> a -> a
+Double
h)

-- | Returns the minimum valid value for a SizeReq.
sizeReqMin :: SizeReq -> Double
sizeReqMin :: SizeReq -> Double
sizeReqMin SizeReq
req = SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed

-- | Returns the maximum valid value for a SizeReq. This can be unbounded if
--   extra field is not zero.
sizeReqMax :: SizeReq -> Double
sizeReqMax :: SizeReq -> Double
sizeReqMax SizeReq
req
  | SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasExtra s a => Lens' s a
L.extra forall a. Ord a => a -> a -> Bool
> Double
0 = forall a. RealFloat a => a
maxNumericValue
  | Bool
otherwise = SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed forall a. Num a => a -> a -> a
+ SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasFlex s a => Lens' s a
L.flex

-- | Returns the maximum, bounded, valid value for a SizeReq. Extra is ignored.
sizeReqMaxBounded :: SizeReq -> Double
sizeReqMaxBounded :: SizeReq -> Double
sizeReqMaxBounded SizeReq
req = SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed forall a. Num a => a -> a -> a
+ SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasFlex s a => Lens' s a
L.flex

-- | Returns the fixed size of a SizeReq.
sizeReqFixed :: SizeReq -> Double
sizeReqFixed :: SizeReq -> Double
sizeReqFixed SizeReq
req = SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed

-- | Returns the flex size of a SizeReq.
sizeReqFlex :: SizeReq -> Double
sizeReqFlex :: SizeReq -> Double
sizeReqFlex SizeReq
req = SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasFlex s a => Lens' s a
L.flex

-- | Returns the extra size of a SizeReq.
sizeReqExtra :: SizeReq -> Double
sizeReqExtra :: SizeReq -> Double
sizeReqExtra SizeReq
req = SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasExtra s a => Lens' s a
L.extra

-- | Returns the resize factor of a SizeReq.
sizeReqFactor :: SizeReq -> Double
sizeReqFactor :: SizeReq -> Double
sizeReqFactor SizeReq
req = SizeReq
req forall s a. s -> Getting a s a -> a
^. forall s a. HasFactor s a => Lens' s a
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 :: SizeReq -> SizeReq -> SizeReq
sizeReqMergeSum SizeReq
req1 SizeReq
req2 = SizeReq
newReq where
  newReq :: SizeReq
newReq = SizeReq {
    _szrFixed :: Double
_szrFixed = SizeReq -> Double
_szrFixed SizeReq
req1 forall a. Num a => a -> a -> a
+ SizeReq -> Double
_szrFixed SizeReq
req2,
    _szrFlex :: Double
_szrFlex = SizeReq -> Double
_szrFlex SizeReq
req1 forall a. Num a => a -> a -> a
+ SizeReq -> Double
_szrFlex SizeReq
req2,
    _szrExtra :: Double
_szrExtra = SizeReq -> Double
_szrExtra SizeReq
req1 forall a. Num a => a -> a -> a
+ SizeReq -> Double
_szrExtra SizeReq
req2,
    _szrFactor :: Double
_szrFactor = forall a. Ord a => a -> a -> a
max (SizeReq -> Double
_szrFactor SizeReq
req1) (SizeReq -> Double
_szrFactor SizeReq
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 :: SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax SizeReq
req1 SizeReq
req2 = SizeReq
newReq where
  isFixedReq1 :: Bool
isFixedReq1 = forall a b. (RealFrac a, Integral b) => a -> b
round (SizeReq
req1 forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed) forall a. Ord a => a -> a -> Bool
> Integer
0
  isFixedReq2 :: Bool
isFixedReq2 = forall a b. (RealFrac a, Integral b) => a -> b
round (SizeReq
req2 forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed) forall a. Ord a => a -> a -> Bool
> Integer
0
  flexReq1 :: Double
flexReq1 = SizeReq
req1 forall s a. s -> Getting a s a -> a
^. forall s a. HasFlex s a => Lens' s a
L.flex
  flexReq2 :: Double
flexReq2 = SizeReq
req2 forall s a. s -> Getting a s a -> a
^. forall s a. HasFlex s a => Lens' s a
L.flex
  newFixed :: Double
newFixed = forall a. Ord a => a -> a -> a
max (SizeReq
req1 forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed) (SizeReq
req2 forall s a. s -> Getting a s a -> a
^. forall s a. HasFixed s a => Lens' s a
L.fixed)
  newFlex :: Double
newFlex
    | Bool -> Bool
not (Bool
isFixedReq1 forall a. Bits a => a -> a -> a
`xor` Bool
isFixedReq2) = forall a. Ord a => a -> a -> a
max Double
flexReq1 Double
flexReq2
    | Bool
isFixedReq1 Bool -> Bool -> Bool
&& Double
flexReq1 forall a. Ord a => a -> a -> Bool
> Double
flexReq2 = Double
flexReq1
    | Bool
isFixedReq2 Bool -> Bool -> Bool
&& Double
flexReq2 forall a. Ord a => a -> a -> Bool
> Double
flexReq1 = Double
flexReq2
    | Bool
otherwise = forall a. Ord a => a -> a -> a
max Double
0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Double
flexReq1 Double
flexReq2 forall a. Num a => a -> a -> a
- Double
newFixed
  newReq :: SizeReq
newReq = SizeReq {
    _szrFixed :: Double
_szrFixed = Double
newFixed,
    _szrFlex :: Double
_szrFlex = Double
newFlex,
    _szrExtra :: Double
_szrExtra = forall a. Ord a => a -> a -> a
max (SizeReq
req1 forall s a. s -> Getting a s a -> a
^. forall s a. HasExtra s a => Lens' s a
L.extra) (SizeReq
req2 forall s a. s -> Getting a s a -> a
^. forall s a. HasExtra s a => Lens' s a
L.extra),
    _szrFactor :: Double
_szrFactor = forall a. Ord a => a -> a -> a
max (SizeReq
req1 forall s a. s -> Getting a s a -> a
^. forall s a. HasFactor s a => Lens' s a
L.factor) (SizeReq
req2 forall s a. s -> Getting a s a -> a
^. forall s a. HasFactor s a => Lens' s a
L.factor)
  }

modifySizeReq :: SizeReq -> (Double -> Double) -> SizeReq
modifySizeReq :: SizeReq -> (Double -> Double) -> SizeReq
modifySizeReq (SizeReq Double
fixed Double
flex Double
extra Double
factor) Double -> Double
fn = SizeReq {
    _szrFixed :: Double
_szrFixed = if Double
fixed forall a. Ord a => a -> a -> Bool
> Double
0 then Double -> Double
fn Double
fixed else Double
0,
    _szrFlex :: Double
_szrFlex = if Double
flex forall a. Ord a => a -> a -> Bool
> Double
0 then Double -> Double
fn Double
flex else Double
0,
    _szrExtra :: Double
_szrExtra = if Double
extra forall a. Ord a => a -> a -> Bool
> Double
0 then Double -> Double
fn Double
extra else Double
0,
    _szrFactor :: Double
_szrFactor = Double
factor
  }

doubleInRange :: Double -> Double -> Double -> Bool
doubleInRange :: Double -> Double -> Double -> Bool
doubleInRange Double
minValue Double
maxValue Double
curValue = Bool
validMin Bool -> Bool -> Bool
&& Bool
validMax where
  minDiff :: Double
minDiff = Double
curValue forall a. Num a => a -> a -> a
- Double
minValue
  maxDiff :: Double
maxDiff = Double
maxValue forall a. Num a => a -> a -> a
- Double
curValue
  -- Some calculations may leave small differences in otherwise valid results
  validMin :: Bool
validMin = Double
minDiff forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
|| forall a. Num a => a -> a
abs Double
minDiff forall a. Ord a => a -> a -> Bool
< Double
0.0001
  validMax :: Bool
validMax = Double
maxDiff forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
|| forall a. Num a => a -> a
abs Double
maxDiff forall a. Ord a => a -> a -> Bool
< Double
0.0001