{-# LANGUAGE OverloadedStrings #-}

module NanoUI.Widgets.Layout
  ( panel
  , panelWith
  , panel'
  , callout
  , calloutWith
  , row
  , rowWith
  , row'
  , column
  , columnWith
  , column'
  , hstack
  , vstack
  , label
  , label'
  , labelWith
  , labelWith'
  , labelEx
  , separator
  , spacer
  , flex
  , scroll
  , scrollWith
  , scroll'
  , scroll2D
  , scroll2DWith
  , scroll2D'
  , scrollArea
  , scrollArea2D
  , scrollConfigured
  , scrollAreaIdConfigured
  , grid
  , gridWith
  , grid'
  , responsive
  , responsiveRowCol
  , center
  )
where

import Control.Monad (void)
import Data.IORef (readIORef)
import Data.Text (Text)
import Effectful (Eff, type (:>))
import NanoUI.Context (Context (..), setScrollConfig)
import NanoUI.Frame.Scroll.Geometry
  ( ScrollConfig (..)
  , defaultScrollConfig
  , encodeScrollConfig
  , scrollDefault1D
  )
import NanoUI.Id (WidgetId)
import NanoUI.Layout.Arena
  ( DirTag (..)
  , NodeIdx
  , NodeType (..)
  , addNodeFromLayout
  , getDirection
  , setStyleIdx
  , setWidgetId
  )
import NanoUI.Input (Input (inputWindowSize))
import NanoUI.Monad (Ui, askContext, askDefaultLayout, askInput, nextId, styled, uiIO)
import NanoUI.Style
  ( AlignX (..)
  , Direction (..)
  , Layout (..)
  , Sizing (..)
  , alignMid
  , fillW
  , gap
  , grow
  , padXY
  , panelStyle
  )
import NanoUI.Style qualified as Style
import NanoUI.Types (Color (..), Size (..), lerpColor)
import NanoUI.Widgets.Node
  ( Response
  , addSizingLeafNode
  , addWidget
  , container

  , parentIdx
  , withContainerNode
  )

-- =============================================================================
-- Internal Ambient Helpers
-- =============================================================================

{-# INLINE withDefault #-}
withDefault :: Ui :> es => (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefault :: forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefault = (Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefaultWith Layout -> Layout
forall a. a -> a
id

{-# INLINE withDefaultWith #-}
withDefaultWith :: Ui :> es => (Layout -> Layout) -> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefaultWith :: forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefaultWith Layout -> Layout
f Layout -> Eff es a -> Eff es r
c Eff es a
child = do
  base <- Eff es Layout
forall (es :: [Effect]). (Ui :> es) => Eff es Layout
askDefaultLayout
  c (f base) child

-- =============================================================================
-- Panel
-- =============================================================================

{-# INLINE panel #-}
panel :: Ui :> es => Eff es a -> Eff es a
panel :: forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
panel = (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefault Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
panel'

{-# INLINE panelWith #-}
panelWith :: Ui :> es => (Layout -> Layout) -> Eff es a -> Eff es a
panelWith :: forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
panelWith = ((Layout -> Layout)
-> (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
`withDefaultWith` Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
panel')

{-# INLINE panel' #-}
panel' :: Ui :> es => Layout -> Eff es a -> Eff es a
panel' :: forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
panel' = NodeType -> Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
NodeType -> Layout -> Eff es a -> Eff es a
container NodeType
NodePanel

{-# INLINE callout #-}
callout :: Ui :> es => Color -> Eff es a -> Eff es a
callout :: forall (es :: [Effect]) a.
(Ui :> es) =>
Color -> Eff es a -> Eff es a
callout Color
borderCol = Color -> (Layout -> Layout) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Color -> (Layout -> Layout) -> Eff es a -> Eff es a
calloutWith Color
borderCol Layout -> Layout
forall a. a -> a
id

-- | A panel tinted with @col@: a border in it and a faint wash of it over the
-- panel colour. The tint applies to the callout's own panel and to panels
-- nested in it.
{-# INLINE calloutWith #-}
calloutWith :: Ui :> es => Color -> (Layout -> Layout) -> Eff es a -> Eff es a
calloutWith :: forall (es :: [Effect]) a.
(Ui :> es) =>
Color -> (Layout -> Layout) -> Eff es a -> Eff es a
calloutWith Color
col Layout -> Layout
f =
  (Theme -> Theme) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
(Theme -> Theme) -> Eff es a -> Eff es a
styled
    (\Theme
t -> (Style -> Style) -> Theme -> Theme
panelStyle (Color -> Style -> Style
Style.background (Color -> Color -> Float -> Color
lerpColor Color
col (Style -> Color
Style.styleBg (Theme -> Style
Style.themePanel Theme
t)) Float
0.88) (Style -> Style) -> (Style -> Style) -> Style -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Style -> Style
Style.borderColor Color
col) Theme
t)
    (Eff es a -> Eff es a)
-> (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Layout -> Layout) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
panelWith (Layout -> Layout
f (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Layout -> Layout
padXY Float
10 Float
6 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Layout -> Layout
gap Float
8 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW)

-- =============================================================================
-- Row
-- =============================================================================

{-# INLINE row #-}
row :: Ui :> es => Eff es a -> Eff es a
row :: forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
row = (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefault Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row'

{-# INLINE rowWith #-}
rowWith :: Ui :> es => (Layout -> Layout) -> Eff es a -> Eff es a
rowWith :: forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
rowWith = ((Layout -> Layout)
-> (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
`withDefaultWith` Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row')

{-# INLINE row' #-}
row' :: Ui :> es => Layout -> Eff es a -> Eff es a
row' :: forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row' Layout
layout = NodeType -> Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
NodeType -> Layout -> Eff es a -> Eff es a
container NodeType
NodeContainer (Layout
layout {layoutDirection = Row})

-- =============================================================================
-- Column
-- =============================================================================

{-# INLINE column #-}
column :: Ui :> es => Eff es a -> Eff es a
column :: forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
column = (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefault Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
column'

{-# INLINE columnWith #-}
columnWith :: Ui :> es => (Layout -> Layout) -> Eff es a -> Eff es a
columnWith :: forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
columnWith = ((Layout -> Layout)
-> (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
`withDefaultWith` Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
column')

{-# INLINE column' #-}
column' :: Ui :> es => Layout -> Eff es a -> Eff es a
column' :: forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
column' Layout
layout = NodeType -> Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
NodeType -> Layout -> Eff es a -> Eff es a
container NodeType
NodeContainer (Layout
layout {layoutDirection = Column})

-- =============================================================================
-- Collection stacks
-- =============================================================================

-- | Run a collection of widgets side by side, as in @hstack (map label names)@.
{-# INLINE hstack #-}
hstack :: (Foldable f, Ui :> es) => f (Eff es ()) -> Eff es ()
hstack :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f (Eff es ()) -> Eff es ()
hstack = Eff es () -> Eff es ()
forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
row (Eff es () -> Eff es ())
-> (f (Eff es ()) -> Eff es ()) -> f (Eff es ()) -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Eff es ()) -> Eff es ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_

-- | Run a collection of widgets top to bottom.
{-# INLINE vstack #-}
vstack :: (Foldable f, Ui :> es) => f (Eff es ()) -> Eff es ()
vstack :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f (Eff es ()) -> Eff es ()
vstack = Eff es () -> Eff es ()
forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
column (Eff es () -> Eff es ())
-> (f (Eff es ()) -> Eff es ()) -> f (Eff es ()) -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Eff es ()) -> Eff es ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_

-- =============================================================================
-- Grid
-- =============================================================================

{-# INLINE grid #-}
grid :: Ui :> es => Int -> Eff es a -> Eff es a
grid :: forall (es :: [Effect]) a.
(Ui :> es) =>
Int -> Eff es a -> Eff es a
grid Int
n = (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefault (Int -> Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Int -> Layout -> Eff es a -> Eff es a
grid' Int
n)

{-# INLINE gridWith #-}
gridWith :: Ui :> es => Int -> (Layout -> Layout) -> Eff es a -> Eff es a
gridWith :: forall (es :: [Effect]) a.
(Ui :> es) =>
Int -> (Layout -> Layout) -> Eff es a -> Eff es a
gridWith Int
n Layout -> Layout
f = (Layout -> Layout)
-> (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefaultWith Layout -> Layout
f (Int -> Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Int -> Layout -> Eff es a -> Eff es a
grid' Int
n)

{-# INLINE grid' #-}
grid' :: Ui :> es => Int -> Layout -> Eff es a -> Eff es a
grid' :: forall (es :: [Effect]) a.
(Ui :> es) =>
Int -> Layout -> Eff es a -> Eff es a
grid' Int
n Layout
layout = NodeType -> Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
NodeType -> Layout -> Eff es a -> Eff es a
container NodeType
NodeContainer (Layout
layout {layoutGridCols = max 1 n})

-- =============================================================================
-- Responsive
-- =============================================================================

-- | Choose between two container builders based on window width.
{-# INLINE responsive #-}
responsive :: Ui :> es => Float -> (Eff es a -> Eff es a) -> (Eff es a -> Eff es a) -> Eff es a -> Eff es a
responsive :: forall (es :: [Effect]) a.
(Ui :> es) =>
Float
-> (Eff es a -> Eff es a)
-> (Eff es a -> Eff es a)
-> Eff es a
-> Eff es a
responsive Float
breakpoint Eff es a -> Eff es a
wideContainer Eff es a -> Eff es a
narrowContainer Eff es a
child = do
  inp <- Eff es Input
forall (es :: [Effect]). (Ui :> es) => Eff es Input
askInput
  let w = Size -> Float
sizeW (Input -> Size
inputWindowSize Input
inp)
  if w >= breakpoint then wideContainer child else narrowContainer child

-- | A row while the window is at least @breakpoint@ wide, a column below it.
{-# INLINE responsiveRowCol #-}
responsiveRowCol :: Ui :> es => Float -> (Layout -> Layout) -> Eff es a -> Eff es a
responsiveRowCol :: forall (es :: [Effect]) a.
(Ui :> es) =>
Float -> (Layout -> Layout) -> Eff es a -> Eff es a
responsiveRowCol Float
breakpoint Layout -> Layout
f Eff es a
child = do
  inp <- Eff es Input
forall (es :: [Effect]). (Ui :> es) => Eff es Input
askInput
  base <- askDefaultLayout
  let w = Size -> Float
sizeW (Input -> Size
inputWindowSize Input
inp)
      dir = if Float
w Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
breakpoint then Direction
Row else Direction
Column
  container NodeContainer ((f base) {layoutDirection = dir}) child

-- | A line of text. Newlines start new lines.
{-# INLINE label #-}
label :: Ui :> es => Text -> Eff es ()
label :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
label Text
txt = Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Eff es Response
forall (es :: [Effect]). (Ui :> es) => Text -> Eff es Response
label' Text
txt)

-- | 'label' returning its 'Response', for a tooltip or an anchored popup.
{-# INLINE label' #-}
label' :: Ui :> es => Text -> Eff es Response
label' :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es Response
label' Text
txt = do
  base <- Eff es Layout
forall (es :: [Effect]). (Ui :> es) => Eff es Layout
askDefaultLayout
  labelEx base txt

-- | 'label' with a layout modifier, for example @labelWith fontMono@.
{-# INLINE labelWith #-}
labelWith :: Ui :> es => (Layout -> Layout) -> Text -> Eff es ()
labelWith :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
labelWith Layout -> Layout
f Text
txt = Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Layout -> Layout) -> Text -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es Response
labelWith' Layout -> Layout
f Text
txt)

{-# INLINE labelWith' #-}
labelWith' :: Ui :> es => (Layout -> Layout) -> Text -> Eff es Response
labelWith' :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es Response
labelWith' Layout -> Layout
f Text
txt = do
  base <- Eff es Layout
forall (es :: [Effect]). (Ui :> es) => Eff es Layout
askDefaultLayout
  labelEx (f base) txt

{-# INLINE labelEx #-}
labelEx :: Ui :> es => Layout -> Text -> Eff es Response
labelEx :: forall (es :: [Effect]).
(Ui :> es) =>
Layout -> Text -> Eff es Response
labelEx Layout
layout Text
txt = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  addWidget wid NodeText txt 0 layout

-- | Takes up the remaining space along the parent's direction.
{-# INLINE flex #-}
flex :: Ui :> es => Eff es ()
flex :: forall (es :: [Effect]). (Ui :> es) => Eff es ()
flex = Sizing -> Sizing -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
Sizing -> Sizing -> Eff es ()
spacer (Float -> Sizing
Grow Float
1) Sizing
Fit

-- | A one-pixel rule: horizontal in a column, vertical in a row.
separator :: Ui :> es => Eff es ()
separator :: forall (es :: [Effect]). (Ui :> es) => Eff es ()
separator = Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es Response -> Eff es ()) -> Eff es Response -> Eff es ()
forall a b. (a -> b) -> a -> b
$ do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  ctx <- askContext
  inp <- askInput
  uiIO $ do
    stack <- readIORef (ctxContainerStack ctx)
    let
      parent = [Int] -> Int
parentIdx [Int]
stack
    parentDir <-
      if parent < 0
        then pure DirColumn
        else getDirection (ctxNodeArena ctx) parent
    let
      (dir, wSiz, hSiz) =
        case parentDir of
          DirTag
DirColumn -> (Direction
Column, Float -> Sizing
Grow Float
1, Float -> Sizing
Fixed Float
1)
          DirTag
DirRow -> (Direction
Row, Float -> Sizing
Fixed Float
1, Float -> Sizing
Grow Float
1)
    addSizingLeafNode ctx inp wid NodeSeparator dir wSiz hSiz

-- | Empty space with the given sizing on each axis.
{-# INLINE spacer #-}
spacer :: Ui :> es => Sizing -> Sizing -> Eff es ()
spacer :: forall (es :: [Effect]).
(Ui :> es) =>
Sizing -> Sizing -> Eff es ()
spacer Sizing
w Sizing
h = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  ctx <- askContext
  inp <- askInput
  void (uiIO $ addSizingLeafNode ctx inp wid NodeSpacer Row w h)

{-# INLINE scroll #-}
scroll :: Ui :> es => Eff es a -> Eff es a
scroll :: forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
scroll = (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefault Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
scroll'

{-# INLINE scrollWith #-}
scrollWith :: Ui :> es => (Layout -> Layout) -> Eff es a -> Eff es a
scrollWith :: forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
scrollWith = ((Layout -> Layout)
-> (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
`withDefaultWith` Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
scroll')

{-# INLINE scroll' #-}
scroll' :: Ui :> es => Layout -> Eff es a -> Eff es a
scroll' :: forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
scroll' Layout
layout Eff es a
child =
  (WidgetId, a) -> a
forall a b. (a, b) -> b
snd ((WidgetId, a) -> a) -> Eff es (WidgetId, a) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScrollConfig -> Layout -> Eff es a -> Eff es (WidgetId, a)
forall (es :: [Effect]) a.
(Ui :> es) =>
ScrollConfig -> Layout -> Eff es a -> Eff es (WidgetId, a)
scrollConfigured (Direction -> ScrollConfig
scrollDefault1D (Layout -> Direction
layoutDirection Layout
layout)) Layout
layout Eff es a
child

{-# INLINE center #-}
center :: Ui :> es => Eff es a -> Eff es a
center :: forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
center = (Layout -> Layout) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
columnWith (Layout -> Layout
grow (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
alignMid (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Layout
l -> Layout
l { layoutAlignX = AlignCenter }))

-- | Push a scroll container node, run the child inside it, then pop.
{-# INLINE scrollContainerWith #-}
scrollContainerWith :: Ui :> es => WidgetId -> (NodeIdx -> IO ()) -> Layout -> Eff es a -> Eff es a
scrollContainerWith :: forall (es :: [Effect]) a.
(Ui :> es) =>
WidgetId -> (Int -> IO ()) -> Layout -> Eff es a -> Eff es a
scrollContainerWith WidgetId
wid Int -> IO ()
setup Layout
layout Eff es a
child = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  idx <- uiIO $ do
    stack <- readIORef (ctxContainerStack ctx)
    idx <- addNodeFromLayout (ctxNodeArena ctx) NodeScrollContainer (parentIdx stack) layout
    setWidgetId (ctxNodeArena ctx) idx wid
    setup idx
    pure idx
  -- Unscoped: a scroll container's children keep their parent's id scope.
  withContainerNode False idx child

-- | Style index + context scroll config for a container with a chosen config.
{-# INLINE configureScrollContainer #-}
configureScrollContainer :: Context -> WidgetId -> ScrollConfig -> NodeIdx -> IO ()
configureScrollContainer :: Context -> WidgetId -> ScrollConfig -> Int -> IO ()
configureScrollContainer Context
ctx WidgetId
wid ScrollConfig
cfg Int
idx = do
  NodeArena -> Int -> Int -> IO ()
setStyleIdx (Context -> NodeArena
ctxNodeArena Context
ctx) Int
idx (ScrollConfig -> Int
encodeScrollConfig ScrollConfig
cfg)
  Context -> WidgetId -> ScrollConfig -> IO ()
setScrollConfig Context
ctx WidgetId
wid ScrollConfig
cfg

-- | 'scrollWith' that also returns the container's widget id, which keys its
-- scroll offset.
{-# INLINE scrollArea #-}
scrollArea :: Ui :> es => (Layout -> Layout) -> Eff es a -> Eff es (WidgetId, a)
scrollArea :: forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es (WidgetId, a)
scrollArea Layout -> Layout
f Eff es a
child = do
  layout <- Layout -> Layout
f (Layout -> Layout) -> Eff es Layout -> Eff es Layout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es Layout
forall (es :: [Effect]). (Ui :> es) => Eff es Layout
askDefaultLayout
  scrollConfigured (scrollDefault1D (layoutDirection layout)) layout child

{-# INLINE scrollAreaIdConfigured #-}
scrollAreaIdConfigured :: Ui :> es => WidgetId -> Layout -> ScrollConfig -> Eff es a -> Eff es a
scrollAreaIdConfigured :: forall (es :: [Effect]) a.
(Ui :> es) =>
WidgetId -> Layout -> ScrollConfig -> Eff es a -> Eff es a
scrollAreaIdConfigured WidgetId
wid Layout
layout ScrollConfig
cfg Eff es a
child = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  scrollContainerWith wid (configureScrollContainer ctx wid cfg) layout child

-- | Scroll container on both axes.
{-# INLINE scroll2D #-}
scroll2D :: Ui :> es => Eff es a -> Eff es a
scroll2D :: forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
scroll2D = (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
withDefault Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
scroll2D'

{-# INLINE scroll2DWith #-}
scroll2DWith :: Ui :> es => (Layout -> Layout) -> Eff es a -> Eff es a
scroll2DWith :: forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
scroll2DWith = ((Layout -> Layout)
-> (Layout -> Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall (es :: [Effect]) a r.
(Ui :> es) =>
(Layout -> Layout)
-> (Layout -> Eff es a -> Eff es r) -> Eff es a -> Eff es r
`withDefaultWith` Layout -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
scroll2D')

{-# INLINE scroll2D' #-}
scroll2D' :: Ui :> es => Layout -> Eff es a -> Eff es a
scroll2D' :: forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
scroll2D' Layout
layout Eff es a
child = ((WidgetId, a) -> a) -> Eff es (WidgetId, a) -> Eff es a
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WidgetId, a) -> a
forall a b. (a, b) -> b
snd (ScrollConfig -> Layout -> Eff es a -> Eff es (WidgetId, a)
forall (es :: [Effect]) a.
(Ui :> es) =>
ScrollConfig -> Layout -> Eff es a -> Eff es (WidgetId, a)
scrollConfigured ScrollConfig
defaultScrollConfig Layout
layout Eff es a
child)

-- | 'scroll2DWith' that also returns the container's widget id.
{-# INLINE scrollArea2D #-}
scrollArea2D :: Ui :> es => (Layout -> Layout) -> Eff es a -> Eff es (WidgetId, a)
scrollArea2D :: forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es (WidgetId, a)
scrollArea2D Layout -> Layout
f Eff es a
child = do
  layout <- Layout -> Layout
f (Layout -> Layout) -> Eff es Layout -> Eff es Layout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es Layout
forall (es :: [Effect]). (Ui :> es) => Eff es Layout
askDefaultLayout
  scrollConfigured defaultScrollConfig layout child

{-# INLINE scrollConfigured #-}
scrollConfigured :: Ui :> es => ScrollConfig -> Layout -> Eff es a -> Eff es (WidgetId, a)
scrollConfigured :: forall (es :: [Effect]) a.
(Ui :> es) =>
ScrollConfig -> Layout -> Eff es a -> Eff es (WidgetId, a)
scrollConfigured ScrollConfig
cfg Layout
layout Eff es a
child = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  wid <- nextId
  r <- scrollContainerWith wid (configureScrollContainer ctx wid cfg) layout child
  pure (wid, r)