{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Containers.Grid (
GridCfg,
hgrid,
hgrid_,
vgrid,
vgrid_
) where
import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~), (%~))
import Data.Default
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
data GridCfg = GridCfg {
GridCfg -> Maybe Double
_grcChildSpacing :: Maybe Double,
GridCfg -> [SizeReqUpdater]
_grcSizeReqUpdater :: [SizeReqUpdater]
}
instance Default GridCfg where
def :: GridCfg
def = GridCfg :: Maybe Double -> [SizeReqUpdater] -> GridCfg
GridCfg {
_grcChildSpacing :: Maybe Double
_grcChildSpacing = Maybe Double
forall a. Maybe a
Nothing,
_grcSizeReqUpdater :: [SizeReqUpdater]
_grcSizeReqUpdater = []
}
instance Semigroup GridCfg where
<> :: GridCfg -> GridCfg -> GridCfg
(<>) GridCfg
s1 GridCfg
s2 = GridCfg :: Maybe Double -> [SizeReqUpdater] -> GridCfg
GridCfg {
_grcChildSpacing :: Maybe Double
_grcChildSpacing = GridCfg -> Maybe Double
_grcChildSpacing GridCfg
s2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GridCfg -> Maybe Double
_grcChildSpacing GridCfg
s1,
_grcSizeReqUpdater :: [SizeReqUpdater]
_grcSizeReqUpdater = GridCfg -> [SizeReqUpdater]
_grcSizeReqUpdater GridCfg
s1 [SizeReqUpdater] -> [SizeReqUpdater] -> [SizeReqUpdater]
forall a. Semigroup a => a -> a -> a
<> GridCfg -> [SizeReqUpdater]
_grcSizeReqUpdater GridCfg
s2
}
instance Monoid GridCfg where
mempty :: GridCfg
mempty = GridCfg
forall a. Default a => a
def
instance CmbChildSpacing GridCfg where
childSpacing_ :: Double -> GridCfg
childSpacing_ Double
spacing = GridCfg
forall a. Default a => a
def {
_grcChildSpacing :: Maybe Double
_grcChildSpacing = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
spacing
}
instance CmbSizeReqUpdater GridCfg where
sizeReqUpdater :: SizeReqUpdater -> GridCfg
sizeReqUpdater SizeReqUpdater
updater = GridCfg
forall a. Default a => a
def {
_grcSizeReqUpdater :: [SizeReqUpdater]
_grcSizeReqUpdater = [SizeReqUpdater
updater]
}
hgrid :: Traversable t => t (WidgetNode s e) -> WidgetNode s e
hgrid :: t (WidgetNode s e) -> WidgetNode s e
hgrid t (WidgetNode s e)
children = [GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
forall (t :: * -> *) s e.
Traversable t =>
[GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
hgrid_ [GridCfg]
forall a. Default a => a
def t (WidgetNode s e)
children
hgrid_ :: Traversable t => [GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
hgrid_ :: [GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
hgrid_ [GridCfg]
configs t (WidgetNode s e)
children = WidgetNode s e
newNode where
config :: GridCfg
config = [GridCfg] -> GridCfg
forall a. Monoid a => [a] -> a
mconcat [GridCfg]
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
"hgrid" (Bool -> GridCfg -> Widget s e
forall s e. Bool -> GridCfg -> Widget s e
makeFixedGrid Bool
True GridCfg
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
vgrid :: Traversable t => t (WidgetNode s e) -> WidgetNode s e
vgrid :: t (WidgetNode s e) -> WidgetNode s e
vgrid t (WidgetNode s e)
children = [GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
forall (t :: * -> *) s e.
Traversable t =>
[GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
vgrid_ [GridCfg]
forall a. Default a => a
def t (WidgetNode s e)
children
vgrid_ :: Traversable t => [GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
vgrid_ :: [GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
vgrid_ [GridCfg]
configs t (WidgetNode s e)
children = WidgetNode s e
newNode where
config :: GridCfg
config = [GridCfg] -> GridCfg
forall a. Monoid a => [a] -> a
mconcat [GridCfg]
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
"vgrid" (Bool -> GridCfg -> Widget s e
forall s e. Bool -> GridCfg -> Widget s e
makeFixedGrid Bool
False GridCfg
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
makeFixedGrid :: Bool -> GridCfg -> Widget s e
makeFixedGrid :: Bool -> GridCfg -> Widget s e
makeFixedGrid Bool
isHorizontal GridCfg
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 {
containerLayoutDirection :: LayoutDirection
containerLayoutDirection = Bool -> LayoutDirection
getLayoutDirection Bool
isHorizontal,
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
childSpacing :: Double
childSpacing = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (GridCfg -> Maybe Double
_grcChildSpacing GridCfg
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 = GridCfg -> [SizeReqUpdater]
_grcSizeReqUpdater GridCfg
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 (Int -> SizeReq -> Seq SizeReq
forall a. Int -> a -> Seq a
Seq.replicate Int
nreqs SizeReq
maxSize) SizeReq -> (SizeReq -> SizeReq) -> SizeReq
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> SizeReq -> Identity SizeReq
forall s a. HasFixed s a => Lens' s a
L.fixed ((Double -> Identity Double) -> SizeReq -> Identity SizeReq)
-> (Double -> Double) -> SizeReq -> SizeReq
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
totalSpacing)
| Bool
otherwise = SizeReq
maxSize
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
nreqs :: Int
nreqs = Seq SizeReq -> Int
forall a. Seq a -> Int
Seq.length Seq SizeReq
vreqs
~SizeReq
maxSize = (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
totalSpacing :: Double
totalSpacing = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nreqs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
childSpacing
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)
Rect Double
l Double
t Double
w Double
h = Rect
contentArea
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
totalSpacingW :: Double
totalSpacingW = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
childSpacing
totalSpacingH :: Double
totalSpacingH = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
childSpacing
cols :: Int
cols = if Bool
isHorizontal then Seq (WidgetNode s e) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (WidgetNode s e)
vchildren else Int
1
rows :: Int
rows = if Bool
isHorizontal then Int
1 else Seq (WidgetNode s e) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (WidgetNode s e)
vchildren
cw :: Double
cw = if Int
cols Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
totalSpacingW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols else Double
0
ch :: Double
ch = if Int
rows Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
totalSpacingH) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rows else Double
0
cx :: a -> Double
cx a
i
| Int
rows Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Double
0
| Bool
isHorizontal = Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a. Integral a => a -> Double
spacingOffset a
i
| Bool
otherwise = Double
l
cy :: a -> Double
cy a
i
| Int
cols Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Double
0
| Bool
isVertical = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ch Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a. Integral a => a -> Double
spacingOffset a
i
| Bool
otherwise = Double
t
spacingOffset :: a -> Double
spacingOffset a
i =
a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
childSpacing
foldHelper :: (Seq Rect, b) -> s -> (Seq Rect, b)
foldHelper (Seq Rect
currAreas, b
index) s
child = (Seq Rect
newAreas, b
newIndex) where
(b
newIndex, Rect
newViewport)
| s
child s -> Getting Bool s Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (a -> Const Bool a) -> s -> Const Bool s
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Bool a) -> s -> Const Bool s)
-> ((Bool -> Const Bool Bool) -> a -> Const Bool a)
-> Getting Bool s Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> a -> Const Bool a
forall s a. HasVisible s a => Lens' s a
L.visible = (b
index b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, b -> Rect
forall a. Integral a => a -> Rect
calcViewport b
index)
| Bool
otherwise = (b
index, Rect
forall a. Default a => a
def)
newArea :: Rect
newArea = Rect
newViewport
newAreas :: Seq Rect
newAreas = Seq Rect
currAreas Seq Rect -> Rect -> Seq Rect
forall a. Seq a -> a -> Seq a
|> Rect
newArea
calcViewport :: a -> Rect
calcViewport a
i = Double -> Double -> Double -> Double -> Rect
Rect (a -> Double
forall a. Integral a => a -> Double
cx a
i) (a -> Double
forall a. Integral a => a -> Double
cy a
i) Double
cw Double
ch
assignedAreas :: Seq Rect
assignedAreas = (Seq Rect, Integer) -> Seq Rect
forall a b. (a, b) -> a
fst ((Seq Rect, Integer) -> Seq Rect)
-> (Seq Rect, Integer) -> Seq Rect
forall a b. (a -> b) -> a -> b
$ ((Seq Rect, Integer) -> WidgetNode s e -> (Seq Rect, Integer))
-> (Seq Rect, Integer)
-> Seq (WidgetNode s e)
-> (Seq Rect, Integer)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq Rect, Integer) -> WidgetNode s e -> (Seq Rect, Integer)
forall s a b.
(HasInfo s a, HasVisible a Bool, Integral b) =>
(Seq Rect, b) -> s -> (Seq Rect, b)
foldHelper (Seq Rect
forall a. Seq a
Seq.empty, Integer
0) Seq (WidgetNode s e)
children
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
node, Seq Rect
assignedAreas)