module Chiasma.Ui.Measure where

import qualified Data.List.NonEmpty as NonEmpty (zip)
import GHC.Float (int2Float)

import Chiasma.Data.Maybe (orElse)
import Chiasma.Ui.Data.Measure (MLayout(..), MPane(..), MeasureTree, MeasureTreeSub, Measured(..))
import Chiasma.Ui.Data.RenderableTree (RLayout(..), RPane(..), Renderable(..), RenderableNode, RenderableTree)
import Chiasma.Ui.Data.Tree (Tree(..))
import qualified Chiasma.Ui.Data.Tree as Tree (Node(..))
import Chiasma.Ui.Data.ViewGeometry (ViewGeometry(minSize, maxSize, fixedSize))
import Chiasma.Ui.Data.ViewState (ViewState(ViewState))
import Chiasma.Ui.Measure.Balance (balanceSizes)
import Chiasma.Ui.Measure.Weights (viewWeights)

minimizedSizeOrDefault :: ViewGeometry -> Float
minimizedSizeOrDefault :: ViewGeometry -> Float
minimizedSizeOrDefault = Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
2 (Maybe Float -> Float)
-> (ViewGeometry -> Maybe Float) -> ViewGeometry -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewGeometry -> Maybe Float
minSize

effectiveFixedSize :: ViewState -> ViewGeometry -> Maybe Float
effectiveFixedSize :: ViewState -> ViewGeometry -> Maybe Float
effectiveFixedSize (ViewState Bool
minimized) ViewGeometry
viewGeom =
  if Bool
minimized then Float -> Maybe Float
forall a. a -> Maybe a
Just (ViewGeometry -> Float
minimizedSizeOrDefault ViewGeometry
viewGeom) else ViewGeometry -> Maybe Float
fixedSize ViewGeometry
viewGeom

actualSize :: (ViewGeometry -> Maybe Float) ->  ViewState -> ViewGeometry -> Maybe Float
actualSize :: (ViewGeometry -> Maybe Float)
-> ViewState -> ViewGeometry -> Maybe Float
actualSize ViewGeometry -> Maybe Float
getter ViewState
viewState ViewGeometry
viewGeom =
  Maybe Float -> Maybe Float -> Maybe Float
forall a. Maybe a -> Maybe a -> Maybe a
orElse (ViewGeometry -> Maybe Float
getter ViewGeometry
viewGeom) (ViewState -> ViewGeometry -> Maybe Float
effectiveFixedSize ViewState
viewState ViewGeometry
viewGeom)

actualMinSizes :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float
actualMinSizes :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float
actualMinSizes =
  ((ViewState, ViewGeometry) -> Float)
-> NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
0.0 (Maybe Float -> Float)
-> ((ViewState, ViewGeometry) -> Maybe Float)
-> (ViewState, ViewGeometry)
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViewState -> ViewGeometry -> Maybe Float)
-> (ViewState, ViewGeometry) -> Maybe Float
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ViewGeometry -> Maybe Float)
-> ViewState -> ViewGeometry -> Maybe Float
actualSize ViewGeometry -> Maybe Float
minSize))

actualMaxSizes :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty (Maybe Float)
actualMaxSizes :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty (Maybe Float)
actualMaxSizes =
  ((ViewState, ViewGeometry) -> Maybe Float)
-> NonEmpty (ViewState, ViewGeometry) -> NonEmpty (Maybe Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ViewState -> ViewGeometry -> Maybe Float)
-> (ViewState, ViewGeometry) -> Maybe Float
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ViewState -> ViewGeometry -> Maybe Float)
 -> (ViewState, ViewGeometry) -> Maybe Float)
-> (ViewState -> ViewGeometry -> Maybe Float)
-> (ViewState, ViewGeometry)
-> Maybe Float
forall a b. (a -> b) -> a -> b
$ (ViewGeometry -> Maybe Float)
-> ViewState -> ViewGeometry -> Maybe Float
actualSize ViewGeometry -> Maybe Float
maxSize)

isMinimized :: ViewState -> ViewGeometry -> Bool
isMinimized :: ViewState -> ViewGeometry -> Bool
isMinimized (ViewState Bool
minimized) ViewGeometry
_ = Bool
minimized

subMeasureData :: RenderableNode -> (ViewState, ViewGeometry)
subMeasureData :: RenderableNode -> (ViewState, ViewGeometry)
subMeasureData (Tree.Sub (Tree (Renderable ViewState
s ViewGeometry
g RLayout
_) NonEmpty RenderableNode
_)) = (ViewState
s, ViewGeometry
g)
subMeasureData (Tree.Leaf (Renderable ViewState
s ViewGeometry
g RPane
_)) = (ViewState
s, ViewGeometry
g)

measureLayoutViews :: Float -> NonEmpty RenderableNode -> NonEmpty Int
measureLayoutViews :: Float -> NonEmpty RenderableNode -> NonEmpty Int
measureLayoutViews Float
total NonEmpty RenderableNode
views =
  NonEmpty Float
-> NonEmpty (Maybe Float)
-> NonEmpty Float
-> NonEmpty Bool
-> Float
-> NonEmpty Int
balanceSizes NonEmpty Float
minSizes NonEmpty (Maybe Float)
maxSizes NonEmpty Float
weights NonEmpty Bool
minimized Float
cells
  where
    measureData :: NonEmpty (ViewState, ViewGeometry)
measureData = (RenderableNode -> (ViewState, ViewGeometry))
-> NonEmpty RenderableNode -> NonEmpty (ViewState, ViewGeometry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RenderableNode -> (ViewState, ViewGeometry)
subMeasureData NonEmpty RenderableNode
views
    paneSpacers :: Float
paneSpacers = Int -> Float
int2Float (NonEmpty RenderableNode -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty RenderableNode
views) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1.0
    cells :: Float
cells = Float
total Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
paneSpacers
    sizesInCells :: Float -> Float
sizesInCells Float
s = if Float
s Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
1 then Float
s else Float
s Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cells
    minSizes :: NonEmpty Float
minSizes = (Float -> Float) -> NonEmpty Float -> NonEmpty Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Float
sizesInCells (NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float
actualMinSizes NonEmpty (ViewState, ViewGeometry)
measureData)
    maxSizes :: NonEmpty (Maybe Float)
maxSizes = (Maybe Float -> Maybe Float)
-> NonEmpty (Maybe Float) -> NonEmpty (Maybe Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Float -> Float) -> Maybe Float -> Maybe Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Float
sizesInCells) (NonEmpty (ViewState, ViewGeometry) -> NonEmpty (Maybe Float)
actualMaxSizes NonEmpty (ViewState, ViewGeometry)
measureData)
    minimized :: NonEmpty Bool
minimized = ((ViewState, ViewGeometry) -> Bool)
-> NonEmpty (ViewState, ViewGeometry) -> NonEmpty Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ViewState -> ViewGeometry -> Bool)
-> (ViewState, ViewGeometry) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ViewState -> ViewGeometry -> Bool
isMinimized) NonEmpty (ViewState, ViewGeometry)
measureData
    weights :: NonEmpty Float
weights = NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float
viewWeights NonEmpty (ViewState, ViewGeometry)
measureData

measureSub :: Int -> Int -> Bool -> RenderableNode -> Int -> MeasureTreeSub
measureSub :: Int -> Int -> Bool -> RenderableNode -> Int -> MeasureTreeSub
measureSub Int
width Int
height Bool
vertical (Tree.Sub Tree NonEmpty RenderableLayout RenderablePane
tree) Int
size =
  Tree NonEmpty (Measured MLayout) (Measured MPane) -> MeasureTreeSub
forall (f :: * -> *) l p. Tree f l p -> Node f l p
Tree.Sub (Tree NonEmpty (Measured MLayout) (Measured MPane)
 -> MeasureTreeSub)
-> Tree NonEmpty (Measured MLayout) (Measured MPane)
-> MeasureTreeSub
forall a b. (a -> b) -> a -> b
$ Tree NonEmpty RenderableLayout RenderablePane
-> Int
-> Int
-> Bool
-> Tree NonEmpty (Measured MLayout) (Measured MPane)
measureLayout Tree NonEmpty RenderableLayout RenderablePane
tree Int
newWidth Int
newHeight Bool
vertical
  where
    (Int
newWidth, Int
newHeight) = if Bool
vertical then (Int
width, Int
size) else (Int
size, Int
height)
measureSub Int
_ Int
_ Bool
vertical (Tree.Leaf (Renderable ViewState
_ ViewGeometry
_ (RPane PaneId
paneId Int
top Int
left))) Int
size =
  Measured MPane -> MeasureTreeSub
forall (f :: * -> *) l p. p -> Node f l p
Tree.Leaf (Int -> MPane -> Measured MPane
forall a. Int -> a -> Measured a
Measured Int
size (PaneId -> Int -> Int -> MPane
MPane PaneId
paneId (if Bool
vertical then Int
top else Int
left) (if Bool
vertical then Int
left else Int
top)))

measureLayout :: RenderableTree -> Int -> Int -> Bool -> MeasureTree
measureLayout :: Tree NonEmpty RenderableLayout RenderablePane
-> Int
-> Int
-> Bool
-> Tree NonEmpty (Measured MLayout) (Measured MPane)
measureLayout (Tree (Renderable ViewState
_ ViewGeometry
_ (RLayout (RPane PaneId
refId Int
refTop Int
refLeft) Bool
vertical)) NonEmpty RenderableNode
sub) Int
width Int
height Bool
parentVertical =
  Measured MLayout
-> NonEmpty MeasureTreeSub
-> Tree NonEmpty (Measured MLayout) (Measured MPane)
forall (f :: * -> *) l p. l -> f (Node f l p) -> Tree f l p
Tree (Int -> MLayout -> Measured MLayout
forall a. Int -> a -> Measured a
Measured Int
sizeInParent (PaneId -> Int -> Int -> Bool -> MLayout
MLayout PaneId
refId Int
mainPos Int
offPos Bool
vertical)) NonEmpty MeasureTreeSub
measuredSub
  where
    sizeInParent :: Int
sizeInParent = if Bool
parentVertical then Int
height else Int
width
    mainPos :: Int
mainPos = if Bool
parentVertical then Int
refTop else Int
refLeft
    offPos :: Int
offPos = if Bool
parentVertical then Int
refLeft else Int
refTop
    subTotalSize :: Int
subTotalSize = if Bool
vertical then Int
height else Int
width
    sizes :: NonEmpty Int
sizes = Float -> NonEmpty RenderableNode -> NonEmpty Int
measureLayoutViews (Int -> Float
int2Float Int
subTotalSize) NonEmpty RenderableNode
sub
    measuredSub :: NonEmpty MeasureTreeSub
measuredSub = (RenderableNode -> Int -> MeasureTreeSub)
-> (RenderableNode, Int) -> MeasureTreeSub
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Int -> Bool -> RenderableNode -> Int -> MeasureTreeSub
measureSub Int
width Int
height Bool
vertical) ((RenderableNode, Int) -> MeasureTreeSub)
-> NonEmpty (RenderableNode, Int) -> NonEmpty MeasureTreeSub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty RenderableNode
-> NonEmpty Int -> NonEmpty (RenderableNode, Int)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip NonEmpty RenderableNode
sub NonEmpty Int
sizes

measureTree :: RenderableTree -> Int -> Int -> MeasureTree
measureTree :: Tree NonEmpty RenderableLayout RenderablePane
-> Int -> Int -> Tree NonEmpty (Measured MLayout) (Measured MPane)
measureTree Tree NonEmpty RenderableLayout RenderablePane
tree Int
width Int
height =
  Tree NonEmpty RenderableLayout RenderablePane
-> Int
-> Int
-> Bool
-> Tree NonEmpty (Measured MLayout) (Measured MPane)
measureLayout Tree NonEmpty RenderableLayout RenderablePane
tree Int
width Int
height Bool
False