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

Container which stacks its children along a main axis. The layout algorithm
considers the different type of size requirements and assigns space according to
the logic defined in 'SizeReq'. If the requested fixed space is larger that the
viewport of the stack, the content will overflow.
-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Containers.Stack (
  -- * Configuration
  StackCfg,
  -- * Constructors
  hstack,
  hstack_,
  vstack,
  vstack_,
  -- * Helpers
  assignStackAreas
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~))
import Data.Default
import Data.Foldable (toList)
import Data.List (foldl')
import Data.Maybe
import Data.Sequence (Seq(..), (<|), (|>))

import qualified Data.Sequence as Seq

import Monomer.Helper (applyFnList)
import Monomer.Widgets.Container

import qualified Monomer.Lens as L

{-|
Configuration options for stack:

- 'ignoreEmptyArea': when the widgets do not use all the available space,
  ignoring the unassigned space allows for mouse events to pass through. This is
  useful in zstack layers.
- 'sizeReqUpdater': allows modifying the 'SizeReq' generated by the stack.
-}
data StackCfg = StackCfg {
  StackCfg -> Maybe Bool
_stcIgnoreEmptyArea :: Maybe Bool,
  StackCfg -> [SizeReqUpdater]
_stcSizeReqUpdater :: [SizeReqUpdater]
}

instance Default StackCfg where
  def :: StackCfg
def = StackCfg :: Maybe Bool -> [SizeReqUpdater] -> StackCfg
StackCfg {
    _stcIgnoreEmptyArea :: Maybe Bool
_stcIgnoreEmptyArea = Maybe Bool
forall a. Maybe a
Nothing,
    _stcSizeReqUpdater :: [SizeReqUpdater]
_stcSizeReqUpdater = []
  }

instance Semigroup StackCfg where
  <> :: StackCfg -> StackCfg -> StackCfg
(<>) StackCfg
s1 StackCfg
s2 = StackCfg :: Maybe Bool -> [SizeReqUpdater] -> StackCfg
StackCfg {
    _stcIgnoreEmptyArea :: Maybe Bool
_stcIgnoreEmptyArea = StackCfg -> Maybe Bool
_stcIgnoreEmptyArea StackCfg
s2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StackCfg -> Maybe Bool
_stcIgnoreEmptyArea StackCfg
s1,
    _stcSizeReqUpdater :: [SizeReqUpdater]
_stcSizeReqUpdater = StackCfg -> [SizeReqUpdater]
_stcSizeReqUpdater StackCfg
s1 [SizeReqUpdater] -> [SizeReqUpdater] -> [SizeReqUpdater]
forall a. Semigroup a => a -> a -> a
<> StackCfg -> [SizeReqUpdater]
_stcSizeReqUpdater StackCfg
s2
  }

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

instance CmbIgnoreEmptyArea StackCfg where
  ignoreEmptyArea_ :: Bool -> StackCfg
ignoreEmptyArea_ Bool
ignore = StackCfg
forall a. Default a => a
def {
    _stcIgnoreEmptyArea :: Maybe Bool
_stcIgnoreEmptyArea = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
ignore
  }

instance CmbSizeReqUpdater StackCfg where
  sizeReqUpdater :: SizeReqUpdater -> StackCfg
sizeReqUpdater SizeReqUpdater
updater = StackCfg
forall a. Default a => a
def {
    _stcSizeReqUpdater :: [SizeReqUpdater]
_stcSizeReqUpdater = [SizeReqUpdater
updater]
  }

-- | Creates a horizontal stack.
hstack :: (Traversable t) => t (WidgetNode s e) -> WidgetNode s e
hstack :: t (WidgetNode s e) -> WidgetNode s e
hstack t (WidgetNode s e)
children = [StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
forall (t :: * -> *) s e.
Traversable t =>
[StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
hstack_ [StackCfg]
forall a. Default a => a
def t (WidgetNode s e)
children

-- | Creates a horizontal stack. Accepts config.
hstack_
  :: (Traversable t)
  => [StackCfg]
  -> t (WidgetNode s e)
  -> WidgetNode s e
hstack_ :: [StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
hstack_ [StackCfg]
configs t (WidgetNode s e)
children = WidgetNode s e
newNode where
  config :: StackCfg
config = [StackCfg] -> StackCfg
forall a. Monoid a => [a] -> a
mconcat [StackCfg]
configs
  newNode :: WidgetNode s e
newNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"hstack" (Bool -> StackCfg -> Widget s e
forall s e. Bool -> StackCfg -> Widget s e
makeStack Bool
True StackCfg
config)
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Seq (WidgetNode s e) -> WidgetNode s e -> Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
-> t (WidgetNode s e)
-> Seq (WidgetNode s e)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq (WidgetNode s e) -> WidgetNode s e -> Seq (WidgetNode s e)
forall a. Seq a -> a -> Seq a
(|>) Seq (WidgetNode s e)
forall a. Seq a
Empty t (WidgetNode s e)
children

-- | Creates a vertical stack.
vstack :: (Traversable t) => t (WidgetNode s e) -> WidgetNode s e
vstack :: t (WidgetNode s e) -> WidgetNode s e
vstack t (WidgetNode s e)
children = [StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
forall (t :: * -> *) s e.
Traversable t =>
[StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
vstack_ [StackCfg]
forall a. Default a => a
def t (WidgetNode s e)
children

-- | Creates a vertical stack. Accepts config.
vstack_
  :: (Traversable t)
  => [StackCfg]
  -> t (WidgetNode s e)
  -> WidgetNode s e
vstack_ :: [StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
vstack_ [StackCfg]
configs t (WidgetNode s e)
children = WidgetNode s e
newNode where
  config :: StackCfg
config = [StackCfg] -> StackCfg
forall a. Monoid a => [a] -> a
mconcat [StackCfg]
configs
  newNode :: WidgetNode s e
newNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"vstack" (Bool -> StackCfg -> Widget s e
forall s e. Bool -> StackCfg -> Widget s e
makeStack Bool
False StackCfg
config)
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Seq (WidgetNode s e) -> WidgetNode s e -> Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
-> t (WidgetNode s e)
-> Seq (WidgetNode s e)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq (WidgetNode s e) -> WidgetNode s e -> Seq (WidgetNode s e)
forall a. Seq a -> a -> Seq a
(|>) Seq (WidgetNode s e)
forall a. Seq a
Empty t (WidgetNode s e)
children

makeStack :: Bool -> StackCfg -> Widget s e
makeStack :: Bool -> StackCfg -> Widget s e
makeStack Bool
isHorizontal StackCfg
config = Widget s e
forall s e. Widget s e
widget where
  widget :: Widget s e
widget = () -> Container s e () -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer () Container s e ()
forall a. Default a => a
def {
    containerIgnoreEmptyArea :: Bool
containerIgnoreEmptyArea = Bool
ignoreEmptyArea,
    containerLayoutDirection :: LayoutDirection
containerLayoutDirection = Bool -> LayoutDirection
getLayoutDirection Bool
isHorizontal,
    containerUseCustomSize :: Bool
containerUseCustomSize = Bool
True,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
forall p p s e.
p -> p -> Seq (WidgetNode s e) -> (SizeReq, SizeReq)
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall s e s e.
WidgetEnv s e
-> WidgetNode s e
-> Rect
-> Seq (WidgetNode s e)
-> (WidgetResult s e, Seq Rect)
resize
  }

  isVertical :: Bool
isVertical = Bool -> Bool
not Bool
isHorizontal
  ignoreEmptyArea :: Bool
ignoreEmptyArea = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (StackCfg -> Maybe Bool
_stcIgnoreEmptyArea StackCfg
config)

  getSizeReq :: p -> p -> Seq (WidgetNode s e) -> (SizeReq, SizeReq)
getSizeReq p
wenv p
node Seq (WidgetNode s e)
children = (SizeReq, SizeReq)
newSizeReq where
    sizeReqFns :: [SizeReqUpdater]
sizeReqFns = StackCfg -> [SizeReqUpdater]
_stcSizeReqUpdater StackCfg
config
    vchildren :: Seq (WidgetNode s e)
vchildren = (WidgetNode s e -> Bool)
-> Seq (WidgetNode s e) -> Seq (WidgetNode s e)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNodeInfo -> Bool
_wniVisible (WidgetNodeInfo -> Bool)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children
    newSizeReqW :: SizeReq
newSizeReqW = Bool
-> (WidgetNode s e -> SizeReq) -> Seq (WidgetNode s e) -> SizeReq
forall a. Bool -> (a -> SizeReq) -> Seq a -> SizeReq
getDimSizeReq Bool
isHorizontal (WidgetNodeInfo -> SizeReq
_wniSizeReqW (WidgetNodeInfo -> SizeReq)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
vchildren
    newSizeReqH :: SizeReq
newSizeReqH = Bool
-> (WidgetNode s e -> SizeReq) -> Seq (WidgetNode s e) -> SizeReq
forall a. Bool -> (a -> SizeReq) -> Seq a -> SizeReq
getDimSizeReq Bool
isVertical (WidgetNodeInfo -> SizeReq
_wniSizeReqH (WidgetNodeInfo -> SizeReq)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
vchildren
    newSizeReq :: (SizeReq, SizeReq)
newSizeReq = [SizeReqUpdater] -> SizeReqUpdater
forall a. [a -> a] -> a -> a
applyFnList [SizeReqUpdater]
sizeReqFns (SizeReq
newSizeReqW, SizeReq
newSizeReqH)

  getDimSizeReq :: Bool -> (a -> SizeReq) -> Seq a -> SizeReq
getDimSizeReq Bool
mainAxis a -> SizeReq
accesor Seq a
vchildren
    | Seq SizeReq -> Bool
forall a. Seq a -> Bool
Seq.null Seq SizeReq
vreqs = Double -> SizeReq
fixedSize Double
0
    | Bool
mainAxis = (SizeReq -> SizeReq -> SizeReq) -> Seq SizeReq -> SizeReq
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeSum Seq SizeReq
vreqs
    | Bool
otherwise = (SizeReq -> SizeReq -> SizeReq) -> Seq SizeReq -> SizeReq
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax Seq SizeReq
vreqs
    where
      vreqs :: Seq SizeReq
vreqs = a -> SizeReq
accesor (a -> SizeReq) -> Seq a -> Seq SizeReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq a
vchildren

  resize :: WidgetEnv s e
-> WidgetNode s e
-> Rect
-> Seq (WidgetNode s e)
-> (WidgetResult s e, Seq Rect)
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Seq (WidgetNode s e)
children = (WidgetResult s e, Seq Rect)
resized where
    style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    contentArea :: Rect
contentArea = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
    (Seq Rect
newVps, Double
newDim) = Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
forall s e.
Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
isHorizontal Rect
contentArea Seq (WidgetNode s e)
children
    newCa :: Rect
newCa
      | Bool
isHorizontal = Rect
contentArea Rect -> (Rect -> Rect) -> Rect
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> Rect -> Identity Rect
forall s a. HasW s a => Lens' s a
L.w ((Double -> Identity Double) -> Rect -> Identity Rect)
-> Double -> Rect -> Rect
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
newDim
      | Bool
otherwise = Rect
contentArea Rect -> (Rect -> Rect) -> Rect
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> Rect -> Identity Rect
forall s a. HasH s a => Lens' s a
L.h ((Double -> Identity Double) -> Rect -> Identity Rect)
-> Double -> Rect -> Rect
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
newDim
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Rect -> Identity Rect)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Rect -> Identity Rect)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Identity Rect)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport ((Rect -> Identity Rect)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Rect -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
newCa (StyleState -> Rect -> Maybe Rect
addOuterBounds StyleState
style Rect
newCa)
    resized :: (WidgetResult s e, Seq Rect)
resized = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode, Seq Rect
newVps)

{-|
Assigns space from rect to each of the provided widgets based on their size
requirements.
-}
assignStackAreas
  :: Bool                 -- ^ True if horizontal, False for vertical.
  -> Rect                 -- ^ The available space to assign.
  -> Seq (WidgetNode s e) -- ^ The widgets that will be assigned space.
  -> (Seq Rect, Double)   -- ^ The assigned areas and used space in main axis.
assignStackAreas :: Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
isHorizontal Rect
contentArea Seq (WidgetNode s e)
children = (Seq Rect, Double)
result where
  Rect Double
x Double
y Double
w Double
h = Rect
contentArea
  mainSize :: Double
mainSize = if Bool
isHorizontal then Double
w else Double
h
  mainStart :: Double
mainStart = if Bool
isHorizontal then Double
x else Double
y
  rectSelector :: Rect -> Double
rectSelector
    | Bool
isHorizontal = Rect -> Double
_rW
    | Bool
otherwise = Rect -> Double
_rH
  vchildren :: Seq (WidgetNode s e)
vchildren = (WidgetNode s e -> Bool)
-> Seq (WidgetNode s e) -> Seq (WidgetNode s e)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNodeInfo -> Bool
_wniVisible (WidgetNodeInfo -> Bool)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children
  reqs :: Seq SizeReq
reqs = (WidgetNode s e -> SizeReq) -> Seq (WidgetNode s e) -> Seq SizeReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> WidgetNode s e -> SizeReq
forall s e. Bool -> WidgetNode s e -> SizeReq
mainReqSelector Bool
isHorizontal) Seq (WidgetNode s e)
vchildren

  sumSizes :: (Double, Double, Double, Double)
-> SizeReq -> (Double, Double, Double, Double)
sumSizes (Double, Double, Double, Double)
accum SizeReq
req = (Double, Double, Double, Double)
newStep where
    (Double
cFixed, Double
cFlex, Double
cFlexFac, Double
cExtraFac) = (Double, Double, Double, Double)
accum
    newFixed :: Double
newFixed = Double
cFixed Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqFixed SizeReq
req
    newFlex :: Double
newFlex = Double
cFlex Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqFlex SizeReq
req
    newFlexFac :: Double
newFlexFac = Double
cFlexFac Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqFlex SizeReq
req Double -> Double -> Double
forall a. Num a => a -> a -> a
* SizeReq -> Double
sizeReqFactor SizeReq
req
    newExtraFac :: Double
newExtraFac = Double
cExtraFac Double -> Double -> Double
forall a. Num a => a -> a -> a
+ SizeReq -> Double
sizeReqExtra SizeReq
req Double -> Double -> Double
forall a. Num a => a -> a -> a
* SizeReq -> Double
sizeReqFactor SizeReq
req
    newStep :: (Double, Double, Double, Double)
newStep = (Double
newFixed, Double
newFlex, Double
newFlexFac, Double
newExtraFac)

  (Double
fixed, Double
flex, Double
flexFac, Double
extraFac) = ((Double, Double, Double, Double)
 -> SizeReq -> (Double, Double, Double, Double))
-> (Double, Double, Double, Double)
-> Seq SizeReq
-> (Double, Double, Double, Double)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Double, Double, Double, Double)
-> SizeReq -> (Double, Double, Double, Double)
sumSizes (Double, Double, Double, Double)
forall a. Default a => a
def Seq SizeReq
reqs
  flexAvail :: Double
flexAvail = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
flex (Double
mainSize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fixed)
  extraAvail :: Double
extraAvail = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double
mainSize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fixed Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
flexAvail)

  -- flexCoeff can only be negative
  flexCoeff :: Double
flexCoeff
    | Double
flexAvail Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
flex Bool -> Bool -> Bool
&& Double
flexFac Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = (Double
flexAvail Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
flex) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
flexFac
    | Bool
otherwise = Double
0
  extraCoeff :: Double
extraCoeff
    | Double
extraAvail Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
extraFac Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double
extraAvail Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
extraFac
    | Bool
otherwise = Double
0

  foldHelper :: (Seq Rect, Double) -> WidgetNode s e -> (Seq Rect, Double)
foldHelper (Seq Rect
accum, Double
offset) WidgetNode s e
child = (Seq Rect
newAccum, Double
newOffset) where
    newRect :: Rect
newRect = Bool
-> Rect -> Double -> Double -> Double -> WidgetNode s e -> Rect
forall s e.
Bool
-> Rect -> Double -> Double -> Double -> WidgetNode s e -> Rect
resizeChild Bool
isHorizontal Rect
contentArea Double
flexCoeff Double
extraCoeff Double
offset WidgetNode s e
child
    newAccum :: Seq Rect
newAccum = Seq Rect
accum Seq Rect -> Rect -> Seq Rect
forall a. Seq a -> a -> Seq a
|> Rect
newRect
    newOffset :: Double
newOffset = Double
offset Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Rect -> Double
rectSelector Rect
newRect

  (Seq Rect
areas, Double
usedDim) = ((Seq Rect, Double) -> WidgetNode s e -> (Seq Rect, Double))
-> (Seq Rect, Double) -> Seq (WidgetNode s e) -> (Seq Rect, Double)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq Rect, Double) -> WidgetNode s e -> (Seq Rect, Double)
forall s e.
(Seq Rect, Double) -> WidgetNode s e -> (Seq Rect, Double)
foldHelper (Seq Rect
forall a. Seq a
Seq.empty, Double
mainStart) Seq (WidgetNode s e)
children
  result :: (Seq Rect, Double)
result = (Seq Rect
areas, Double
usedDim Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mainStart)

resizeChild :: Bool -> Rect -> Factor -> Factor -> Double -> WidgetNode s e -> Rect
resizeChild :: Bool
-> Rect -> Double -> Double -> Double -> WidgetNode s e -> Rect
resizeChild Bool
horizontal Rect
contentArea Double
flexCoeff Double
extraCoeff Double
offset WidgetNode s e
child = Rect
result where
  Rect Double
l Double
t Double
w Double
h = Rect
contentArea
  emptyRect :: Rect
emptyRect = Double -> Double -> Double -> Double -> Rect
Rect Double
l Double
t Double
0 Double
0
  -- Either flex or extra is active (flex is negative or extra is >= 0)
  SizeReq Double
fixed Double
flex Double
extra Double
factor = Bool -> WidgetNode s e -> SizeReq
forall s e. Bool -> WidgetNode s e -> SizeReq
mainReqSelector Bool
horizontal WidgetNode s e
child

  tempMainSize :: Double
tempMainSize = Double
fixed
    Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
flexCoeff Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
factor) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
flex
    Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
extraCoeff Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
extra
  mainSize :: Double
mainSize = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 Double
tempMainSize

  hRect :: Rect
hRect = Double -> Double -> Double -> Double -> Rect
Rect Double
offset Double
t Double
mainSize Double
h
  vRect :: Rect
vRect = Double -> Double -> Double -> Double -> Rect
Rect Double
l Double
offset Double
w Double
mainSize
  result :: Rect
result
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (WidgetNodeInfo -> Bool
_wniVisible (WidgetNodeInfo -> Bool)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) WidgetNode s e
child = Rect
emptyRect
    | Bool
horizontal = Rect
hRect
    | Bool
otherwise = Rect
vRect

mainReqSelector :: Bool -> WidgetNode s e -> SizeReq
mainReqSelector :: Bool -> WidgetNode s e -> SizeReq
mainReqSelector Bool
isHorizontal
  | Bool
isHorizontal = WidgetNodeInfo -> SizeReq
_wniSizeReqW (WidgetNodeInfo -> SizeReq)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo
  | Bool
otherwise = WidgetNodeInfo -> SizeReq
_wniSizeReqH (WidgetNodeInfo -> SizeReq)
-> (WidgetNode s e -> WidgetNodeInfo) -> WidgetNode s e -> SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo