{-|
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.
-}
module Monomer.Core.SizeReq (
  SizeReqUpdater(..),
  clearExtra,
  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 SizeReq.
clearExtra :: SizeReqUpdater
clearExtra :: SizeReqUpdater
clearExtra (SizeReq
req1, SizeReq
req2) = (SizeReq
req1 SizeReq -> (SizeReq -> SizeReq) -> SizeReq
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> SizeReq -> Identity SizeReq
forall s a. HasExtra s a => Lens' s a
L.extra ((Double -> Identity Double) -> SizeReq -> Identity SizeReq)
-> Double -> SizeReq -> SizeReq
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0, SizeReq
req2 SizeReq -> (SizeReq -> SizeReq) -> SizeReq
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> SizeReq -> Identity SizeReq
forall s a. HasExtra s a => Lens' s a
L.extra ((Double -> Identity Double) -> SizeReq -> Identity SizeReq)
-> Double -> SizeReq -> SizeReq
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0)

-- | 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 = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
minSize (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
maxSize Double
value) where
  minSize :: Double
minSize = Double
offset Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqMin SizeReq
sizeReq
  maxSize :: Double
maxSize = Double
offset Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqMin SizeReq
sizeReq
  maxSize :: Double
maxSize = Double
offset Double -> Double -> Double
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 = Size -> Maybe Size -> Size
forall a. a -> Maybe a -> a
fromMaybe Size
forall a. Default a => a
def (StyleState -> Size -> Maybe Size
addOuterSize StyleState
style Size
forall a. Default a => a
def)
  realReqW :: SizeReq
realReqW = SizeReq -> Maybe SizeReq -> SizeReq
forall a. a -> Maybe a -> a
fromMaybe SizeReq
reqW (StyleState -> Maybe SizeReq
_sstSizeReqW StyleState
style)
  realReqH :: SizeReq
realReqH = SizeReq -> Maybe SizeReq -> SizeReq
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 (Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
w)
  newReqH :: SizeReq
newReqH = SizeReq -> (Double -> Double) -> SizeReq
modifySizeReq SizeReq
realReqH (Double -> Double -> Double
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 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
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 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasExtra s a => Lens' s a
L.extra Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double
forall a. RealFloat a => a
maxNumericValue
  | Bool
otherwise = SizeReq
req SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFixed s a => Lens' s a
L.fixed Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq
req SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
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 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFixed s a => Lens' s a
L.fixed Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq
req SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
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 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
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 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
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 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
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 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
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 :: Double -> Double -> Double -> Double -> SizeReq
SizeReq {
    _szrFixed :: Double
_szrFixed = SizeReq -> Double
_szrFixed SizeReq
req1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
_szrFixed SizeReq
req2,
    _szrFlex :: Double
_szrFlex = SizeReq -> Double
_szrFlex SizeReq
req1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
_szrFlex SizeReq
req2,
    _szrExtra :: Double
_szrExtra = SizeReq -> Double
_szrExtra SizeReq
req1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
_szrExtra SizeReq
req2,
    _szrFactor :: Double
_szrFactor = Double -> Double -> Double
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 = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (SizeReq
req1 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFixed s a => Lens' s a
L.fixed) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
  isFixedReq2 :: Bool
isFixedReq2 = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (SizeReq
req2 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFixed s a => Lens' s a
L.fixed) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
  flexReq1 :: Double
flexReq1 = SizeReq
req1 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFlex s a => Lens' s a
L.flex
  flexReq2 :: Double
flexReq2 = SizeReq
req2 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFlex s a => Lens' s a
L.flex
  newFixed :: Double
newFixed = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (SizeReq
req1 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFixed s a => Lens' s a
L.fixed) (SizeReq
req2 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFixed s a => Lens' s a
L.fixed)
  newFlex :: Double
newFlex
    | Bool -> Bool
not (Bool
isFixedReq1 Bool -> Bool -> Bool
forall a. Bits a => a -> a -> a
`xor` Bool
isFixedReq2) = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
flexReq1 Double
flexReq2
    | Bool
isFixedReq1 Bool -> Bool -> Bool
&& Double
flexReq1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
flexReq2 = Double
flexReq1
    | Bool
isFixedReq2 Bool -> Bool -> Bool
&& Double
flexReq2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
flexReq1 = Double
flexReq2
    | Bool
otherwise = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
flexReq1 Double
flexReq2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
newFixed
  newReq :: SizeReq
newReq = SizeReq :: Double -> Double -> Double -> Double -> SizeReq
SizeReq {
    _szrFixed :: Double
_szrFixed = Double
newFixed,
    _szrFlex :: Double
_szrFlex = Double
newFlex,
    _szrExtra :: Double
_szrExtra = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (SizeReq
req1 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasExtra s a => Lens' s a
L.extra) (SizeReq
req2 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasExtra s a => Lens' s a
L.extra),
    _szrFactor :: Double
_szrFactor = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (SizeReq
req1 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
forall s a. HasFactor s a => Lens' s a
L.factor) (SizeReq
req2 SizeReq -> Getting Double SizeReq Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double SizeReq Double
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 :: Double -> Double -> Double -> Double -> SizeReq
SizeReq {
    _szrFixed :: Double
_szrFixed = if Double
fixed Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then Double -> Double
fn Double
fixed else Double
0,
    _szrFlex :: Double
_szrFlex = if Double
flex Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then Double -> Double
fn Double
flex else Double
0,
    _szrExtra :: Double
_szrExtra = if Double
extra Double -> Double -> Bool
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
minValue
  maxDiff :: Double
maxDiff = Double
maxValue Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
curValue
  -- Some calculations may leave small differences in otherwise valid results
  validMin :: Bool
validMin = Double
minDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
|| Double -> Double
forall a. Num a => a -> a
abs Double
minDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.0001
  validMax :: Bool
validMax = Double
maxDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
|| Double -> Double
forall a. Num a => a -> a
abs Double
maxDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.0001