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

Layout container which distributes space evenly along the main axis. For the
secondary axis children will receive as much space as available for the grid
widget itself.

In the same way as with hstack and vstack, 'hgrid' and 'vgrid' can be combined
to create more complex layouts.

The hgrid widget requests maxWidth * elements as its width, and the max height
as its height. The inverse happens for vgrid.

@
hgrid [
    label "Third 1",
    label "Third 2",
    label "Third 3"
  ]
@
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Containers.Grid (
  -- * Configuration
  GridCfg,
  -- * Constructors
  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

{-|
Configuration options for grid:

- 'childSpacing': spacing between the child widgets.
- 'sizeReqUpdater': allows modifying the 'SizeReq' generated by the grid.
-}
data GridCfg = GridCfg {
  GridCfg -> Maybe Double
_grcChildSpacing :: Maybe Double,
  GridCfg -> [SizeReqUpdater]
_grcSizeReqUpdater :: [SizeReqUpdater]
}

instance Default GridCfg where
  def :: GridCfg
def = GridCfg {
    _grcChildSpacing :: Maybe Double
_grcChildSpacing = forall a. Maybe a
Nothing,
    _grcSizeReqUpdater :: [SizeReqUpdater]
_grcSizeReqUpdater = []
  }

instance Semigroup GridCfg where
  <> :: GridCfg -> GridCfg -> GridCfg
(<>) GridCfg
s1 GridCfg
s2 = GridCfg {
    _grcChildSpacing :: Maybe Double
_grcChildSpacing = GridCfg -> Maybe Double
_grcChildSpacing GridCfg
s2 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 forall a. Semigroup a => a -> a -> a
<> GridCfg -> [SizeReqUpdater]
_grcSizeReqUpdater GridCfg
s2
  }

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

instance CmbChildSpacing GridCfg where
  childSpacing_ :: Double -> GridCfg
childSpacing_ Double
spacing = forall a. Default a => a
def {
    _grcChildSpacing :: Maybe Double
_grcChildSpacing = forall a. a -> Maybe a
Just Double
spacing
  }

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

-- | Creates a grid of items with the same width.
hgrid :: Traversable t => t (WidgetNode s e) -> WidgetNode s e
hgrid :: forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
hgrid t (WidgetNode s e)
children = forall (t :: * -> *) s e.
Traversable t =>
[GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
hgrid_ forall a. Default a => a
def t (WidgetNode s e)
children

-- | Creates a grid of items with the same width. Accepts config.
hgrid_ :: Traversable t => [GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
hgrid_ :: forall (t :: * -> *) s e.
Traversable t =>
[GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
hgrid_ [GridCfg]
configs t (WidgetNode s e)
children = WidgetNode s e
newNode where
  config :: GridCfg
config = forall a. Monoid a => [a] -> a
mconcat [GridCfg]
configs
  newNode :: WidgetNode s e
newNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"hgrid" (forall s e. Bool -> GridCfg -> Widget s e
makeFixedGrid Bool
True GridCfg
config)
    forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Seq a -> a -> Seq a
(|>) forall a. Seq a
Empty t (WidgetNode s e)
children

-- | Creates a grid of items with the same height.
vgrid :: Traversable t => t (WidgetNode s e) -> WidgetNode s e
vgrid :: forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
vgrid t (WidgetNode s e)
children = forall (t :: * -> *) s e.
Traversable t =>
[GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
vgrid_ forall a. Default a => a
def t (WidgetNode s e)
children

-- | Creates a grid of items with the same height. Accepts config.
vgrid_ :: Traversable t => [GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
vgrid_ :: forall (t :: * -> *) s e.
Traversable t =>
[GridCfg] -> t (WidgetNode s e) -> WidgetNode s e
vgrid_ [GridCfg]
configs t (WidgetNode s e)
children = WidgetNode s e
newNode where
  config :: GridCfg
config = forall a. Monoid a => [a] -> a
mconcat [GridCfg]
configs
  newNode :: WidgetNode s e
newNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"vgrid" (forall s e. Bool -> GridCfg -> Widget s e
makeFixedGrid Bool
False GridCfg
config)
    forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Seq a -> a -> Seq a
(|>) forall a. Seq a
Empty t (WidgetNode s e)
children

makeFixedGrid :: Bool -> GridCfg -> Widget s e
makeFixedGrid :: forall s e. Bool -> GridCfg -> Widget s e
makeFixedGrid Bool
isHorizontal GridCfg
config = forall {s} {e}. Widget s e
widget where
  widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer () forall a. Default a => a
def {
    containerLayoutDirection :: LayoutDirection
containerLayoutDirection = Bool -> LayoutDirection
getLayoutDirection Bool
isHorizontal,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = forall {p} {p} {s} {e}.
p -> p -> Seq (WidgetNode s e) -> (SizeReq, SizeReq)
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = 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 = 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 = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNodeInfo -> Bool
_wniVisible forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children
    newSizeReqW :: SizeReq
newSizeReqW = forall {a}. Bool -> (a -> SizeReq) -> Seq a -> SizeReq
getDimSizeReq Bool
isHorizontal (WidgetNodeInfo -> SizeReq
_wniSizeReqW forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
vchildren
    newSizeReqH :: SizeReq
newSizeReqH = forall {a}. Bool -> (a -> SizeReq) -> Seq a -> SizeReq
getDimSizeReq Bool
isVertical (WidgetNodeInfo -> SizeReq
_wniSizeReqH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
vchildren
    newSizeReq :: (SizeReq, SizeReq)
newSizeReq = 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
    | forall a. Seq a -> Bool
Seq.null Seq SizeReq
vreqs = Double -> SizeReq
fixedSize Double
0
    | Bool
mainAxis = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeSum (forall a. Int -> a -> Seq a
Seq.replicate Int
nreqs SizeReq
maxSize) forall a b. a -> (a -> b) -> b
& forall s a. HasFixed s a => Lens' s a
L.fixed forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Num a => a -> a -> a
+ Double
totalSpacing)
    | Bool
otherwise = SizeReq
maxSize
    where
      vreqs :: Seq SizeReq
vreqs = a -> SizeReq
accesor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq a
vchildren
      nreqs :: Int
nreqs = forall a. Seq a -> Int
Seq.length Seq SizeReq
vreqs
      ~SizeReq
maxSize = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax Seq SizeReq
vreqs
      totalSpacing :: Double
totalSpacing = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nreqs forall a. Num a => a -> a -> a
- Int
1) 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 = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    contentArea :: Rect
contentArea = forall a. a -> Maybe a -> a
fromMaybe 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 = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (WidgetNodeInfo -> Bool
_wniVisible forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo) Seq (WidgetNode s e)
children

    totalSpacingW :: Double
totalSpacingW = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Ord a => a -> a -> a
max Int
0 (Int
cols forall a. Num a => a -> a -> a
- Int
1)) forall a. Num a => a -> a -> a
* Double
childSpacing
    totalSpacingH :: Double
totalSpacingH = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Ord a => a -> a -> a
max Int
0 (Int
rows forall a. Num a => a -> a -> a
- Int
1)) forall a. Num a => a -> a -> a
* Double
childSpacing

    cols :: Int
cols = if Bool
isHorizontal then 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 forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (WidgetNode s e)
vchildren

    cw :: Double
cw = if Int
cols forall a. Ord a => a -> a -> Bool
> Int
0 then (Double
w forall a. Num a => a -> a -> a
- Double
totalSpacingW) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols else Double
0
    ch :: Double
ch = if Int
rows forall a. Ord a => a -> a -> Bool
> Int
0 then (Double
h forall a. Num a => a -> a -> a
- Double
totalSpacingH) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rows else Double
0

    cx :: a -> Double
cx a
i
      | Int
rows forall a. Eq a => a -> a -> Bool
== Int
0 = Double
0
      | Bool
isHorizontal = Double
l forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i forall a. Num a => a -> a -> a
* Double
cw forall a. Num a => a -> a -> a
+ forall {a}. Integral a => a -> Double
spacingOffset a
i
      | Bool
otherwise = Double
l
    cy :: a -> Double
cy a
i
      | Int
cols forall a. Eq a => a -> a -> Bool
== Int
0 = Double
0
      | Bool
isVertical = Double
t forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i forall a. Num a => a -> a -> a
* Double
ch forall a. Num a => a -> a -> a
+ forall {a}. Integral a => a -> Double
spacingOffset a
i
      | Bool
otherwise = Double
t
    spacingOffset :: a -> Double
spacingOffset a
i =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i forall a. Num a => a -> a -> a
* Double
childSpacing

    foldHelper :: (Seq Rect, b) -> p -> (Seq Rect, b)
foldHelper (Seq Rect
currAreas, b
index) p
child = (Seq Rect
newAreas, b
newIndex) where
      (b
newIndex, Rect
newViewport)
        | p
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible = (b
index forall a. Num a => a -> a -> a
+ b
1, forall {a}. Integral a => a -> Rect
calcViewport b
index)
        | Bool
otherwise = (b
index, forall a. Default a => a
def)
      newArea :: Rect
newArea = Rect
newViewport
      newAreas :: Seq Rect
newAreas = Seq Rect
currAreas forall a. Seq a -> a -> Seq a
|> Rect
newArea
    calcViewport :: a -> Rect
calcViewport a
i = Double -> Double -> Double -> Double -> Rect
Rect (forall {a}. Integral a => a -> Double
cx a
i) (forall {a}. Integral a => a -> Double
cy a
i) Double
cw Double
ch

    assignedAreas :: Seq Rect
assignedAreas = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {p} {a} {b}.
(HasInfo p a, HasVisible a Bool, Integral b) =>
(Seq Rect, b) -> p -> (Seq Rect, b)
foldHelper (forall a. Seq a
Seq.empty, Integer
0) Seq (WidgetNode s e)
children
    resized :: (WidgetResult s e, Seq Rect)
resized = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq Rect
assignedAreas)