module Chiasma.Ui.Measure where import qualified Data.List.NonEmpty as NonEmpty (zip) import qualified Chiasma.Data.Axis as Axis import Chiasma.Data.Axis (Axis (Horizontal, Vertical)) 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 (fixedSize, maxSize, minSize)) 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 = ViewGeometry -> Maybe Float getter ViewGeometry viewGeom Maybe Float -> Maybe Float -> Maybe Float forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> 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 forall a b. (Integral a, Num b) => a -> b fromIntegral (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 -> Axis -> RenderableNode -> Int -> MeasureTreeSub measureSub :: Int -> Int -> Axis -> RenderableNode -> Int -> MeasureTreeSub measureSub Int width Int height Axis axis (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 RenderableLayout RenderablePane -> Int -> Int -> Axis -> Tree NonEmpty (Measured MLayout) (Measured MPane) measureLayout Tree NonEmpty RenderableLayout RenderablePane tree Int newWidth Int newHeight Axis axis) where (Int newWidth, Int newHeight) = case Axis axis of Axis Vertical -> (Int width, Int size) Axis Horizontal -> (Int size, Int height) measureSub Int _ Int _ (Axis -> Bool Axis.vertical -> 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 -> Axis -> MeasureTree measureLayout :: Tree NonEmpty RenderableLayout RenderablePane -> Int -> Int -> Axis -> Tree NonEmpty (Measured MLayout) (Measured MPane) measureLayout (Tree (Renderable ViewState _ ViewGeometry _ (RLayout (RPane PaneId refId Int refTop Int refLeft) Axis axis)) NonEmpty RenderableNode sub) Int width Int height (Axis -> Bool Axis.vertical -> 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 -> Axis -> MLayout MLayout PaneId refId Int mainPos Int offPos Axis axis)) 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 Axis -> Bool Axis.vertical Axis axis then Int height else Int width sizes :: NonEmpty Int sizes = Float -> NonEmpty RenderableNode -> NonEmpty Int measureLayoutViews (Int -> Float forall a b. (Integral a, Num b) => a -> b fromIntegral 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 -> Axis -> RenderableNode -> Int -> MeasureTreeSub measureSub Int width Int height Axis axis) ((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 -> Axis -> Tree NonEmpty (Measured MLayout) (Measured MPane) measureLayout Tree NonEmpty RenderableLayout RenderablePane tree Int width Int height Axis Horizontal