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

Container for a single item.

Useful in different layout situations, since it provides alignment options. This
allows for the inner widget to keep its size while being positioned more
explicitly, while the box takes up the complete space assigned by its parent (in
particular for containers which do not follow SizeReq restriccions, such as
Grid).

Can be used to add padding to an inner widget with a border. This is equivalent
to the margin property in CSS.

Also useful to handle click events in complex widget structures (for example, a
label with an image at its side).
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Containers.Box (
  -- * Configuration
  BoxCfg,
  -- * Constructors
  box,
  box_,
  expandContent
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~))
import Data.Default
import Data.Maybe

import qualified Data.Sequence as Seq

import Monomer.Helper (applyFnList)
import Monomer.Widgets.Container
import Monomer.Widgets.Containers.Stack

import qualified Monomer.Lens as L

{-|
Configuration options for box:

- 'mergeRequired': function called during merge that receives the old and new
  model, returning True in case the child widget needs to be merged. Since by
  default merge is required, this function can be used to restrict merging when
  it would be expensive and it is not necessary. For example, a list of widgets
  representing search result only needs to be updated when the list of results
  changes, not while the user inputs new search criteria (which also triggers a
  model change and, hence, the merge process).
- 'ignoreEmptyArea': when the inner widget does not use all the available space,
  ignoring the unassigned space allows for mouse events to pass through. This is
  useful in zstack layers.
- 'sizeReqUpdater': allows modifying the 'SizeReq' generated by the inner
  widget.
- 'alignLeft': aligns the inner widget to the left.
- 'alignCenter': aligns the inner widget to the horizontal center.
- 'alignRight': aligns the inner widget to the right.
- 'alignTop': aligns the inner widget to the top.
- 'alignMiddle': aligns the inner widget to the left.
- 'alignBottom': aligns the inner widget to the bottom.
- 'onClick': click event.
- 'onClickReq': generates a WidgetRequest on click.
- 'onClickEmpty': click event on empty area.
- 'onClickEmptyReq': generates a WidgetRequest on click in empty area.
- 'expandContent': if the inner widget should use all the available space. To be
  able to use alignment options, this must be False (the default).
-}
data BoxCfg s e = BoxCfg {
  BoxCfg s e -> Maybe Bool
_boxExpandContent :: Maybe Bool,
  BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea :: Maybe Bool,
  BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater :: [SizeReqUpdater],
  BoxCfg s e -> Maybe (s -> s -> Bool)
_boxMergeRequired :: Maybe (s -> s -> Bool),
  BoxCfg s e -> Maybe AlignH
_boxAlignH :: Maybe AlignH,
  BoxCfg s e -> Maybe AlignV
_boxAlignV :: Maybe AlignV,
  BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq :: [Path -> WidgetRequest s e],
  BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq :: [Path -> WidgetRequest s e],
  BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq :: [WidgetRequest s e],
  BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq :: [WidgetRequest s e],
  BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq :: [WidgetRequest s e],
  BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq :: [WidgetRequest s e],
  BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e],
  BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
}

instance Default (BoxCfg s e) where
  def :: BoxCfg s e
def = BoxCfg :: forall s e.
Maybe Bool
-> Maybe Bool
-> [SizeReqUpdater]
-> Maybe (s -> s -> Bool)
-> Maybe AlignH
-> Maybe AlignV
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [WidgetRequest s e]
-> [WidgetRequest s e]
-> [WidgetRequest s e]
-> [WidgetRequest s e]
-> [Button -> Int -> WidgetRequest s e]
-> [Button -> Int -> WidgetRequest s e]
-> BoxCfg s e
BoxCfg {
    _boxExpandContent :: Maybe Bool
_boxExpandContent = Maybe Bool
forall a. Maybe a
Nothing,
    _boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = Maybe Bool
forall a. Maybe a
Nothing,
    _boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = [],
    _boxMergeRequired :: Maybe (s -> s -> Bool)
_boxMergeRequired = Maybe (s -> s -> Bool)
forall a. Maybe a
Nothing,
    _boxAlignH :: Maybe AlignH
_boxAlignH = Maybe AlignH
forall a. Maybe a
Nothing,
    _boxAlignV :: Maybe AlignV
_boxAlignV = Maybe AlignV
forall a. Maybe a
Nothing,
    _boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [],
    _boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [],
    _boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [],
    _boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [],
    _boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [],
    _boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [],
    _boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [],
    _boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = []
  }

instance Semigroup (BoxCfg s e) where
  <> :: BoxCfg s e -> BoxCfg s e -> BoxCfg s e
(<>) BoxCfg s e
t1 BoxCfg s e
t2 = BoxCfg :: forall s e.
Maybe Bool
-> Maybe Bool
-> [SizeReqUpdater]
-> Maybe (s -> s -> Bool)
-> Maybe AlignH
-> Maybe AlignV
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [WidgetRequest s e]
-> [WidgetRequest s e]
-> [WidgetRequest s e]
-> [WidgetRequest s e]
-> [Button -> Int -> WidgetRequest s e]
-> [Button -> Int -> WidgetRequest s e]
-> BoxCfg s e
BoxCfg {
    _boxExpandContent :: Maybe Bool
_boxExpandContent = BoxCfg s e -> Maybe Bool
forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BoxCfg s e -> Maybe Bool
forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
t1,
    _boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = BoxCfg s e -> Maybe Bool
forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BoxCfg s e -> Maybe Bool
forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
t1,
    _boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = BoxCfg s e -> [SizeReqUpdater]
forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
t1 [SizeReqUpdater] -> [SizeReqUpdater] -> [SizeReqUpdater]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [SizeReqUpdater]
forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
t2,
    _boxMergeRequired :: Maybe (s -> s -> Bool)
_boxMergeRequired = BoxCfg s e -> Maybe (s -> s -> Bool)
forall s e. BoxCfg s e -> Maybe (s -> s -> Bool)
_boxMergeRequired BoxCfg s e
t2 Maybe (s -> s -> Bool)
-> Maybe (s -> s -> Bool) -> Maybe (s -> s -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BoxCfg s e -> Maybe (s -> s -> Bool)
forall s e. BoxCfg s e -> Maybe (s -> s -> Bool)
_boxMergeRequired BoxCfg s e
t1,
    _boxAlignH :: Maybe AlignH
_boxAlignH = BoxCfg s e -> Maybe AlignH
forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
t2 Maybe AlignH -> Maybe AlignH -> Maybe AlignH
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BoxCfg s e -> Maybe AlignH
forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
t1,
    _boxAlignV :: Maybe AlignV
_boxAlignV = BoxCfg s e -> Maybe AlignV
forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
t2 Maybe AlignV -> Maybe AlignV -> Maybe AlignV
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BoxCfg s e -> Maybe AlignV
forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
t1,
    _boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = BoxCfg s e -> [Path -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [Path -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
t2,
    _boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = BoxCfg s e -> [Path -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [Path -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
t2,
    _boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
t1 [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
t2,
    _boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
t1 [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
t2,
    _boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
t1 [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
t2,
    _boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
t1 [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
t2,
    _boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
t1 [Button -> Int -> WidgetRequest s e]
-> [Button -> Int -> WidgetRequest s e]
-> [Button -> Int -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
t2,
    _boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
t1 [Button -> Int -> WidgetRequest s e]
-> [Button -> Int -> WidgetRequest s e]
-> [Button -> Int -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
t2
  }

instance Monoid (BoxCfg s e) where
  mempty :: BoxCfg s e
mempty = BoxCfg s e
forall a. Default a => a
def

instance CmbIgnoreEmptyArea (BoxCfg s e) where
  ignoreEmptyArea_ :: Bool -> BoxCfg s e
ignoreEmptyArea_ Bool
ignore = BoxCfg s e
forall a. Default a => a
def {
    _boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
ignore
  }

instance CmbSizeReqUpdater (BoxCfg s e) where
  sizeReqUpdater :: SizeReqUpdater -> BoxCfg s e
sizeReqUpdater SizeReqUpdater
updater = BoxCfg s e
forall a. Default a => a
def {
    _boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = [SizeReqUpdater
updater]
  }

instance CmbMergeRequired (BoxCfg s e) s where
  mergeRequired :: (s -> s -> Bool) -> BoxCfg s e
mergeRequired s -> s -> Bool
fn = BoxCfg s e
forall a. Default a => a
def {
    _boxMergeRequired :: Maybe (s -> s -> Bool)
_boxMergeRequired = (s -> s -> Bool) -> Maybe (s -> s -> Bool)
forall a. a -> Maybe a
Just s -> s -> Bool
fn
  }

instance CmbAlignLeft (BoxCfg s e) where
  alignLeft_ :: Bool -> BoxCfg s e
alignLeft_ Bool
False = BoxCfg s e
forall a. Default a => a
def
  alignLeft_ Bool
True = BoxCfg s e
forall a. Default a => a
def {
    _boxAlignH :: Maybe AlignH
_boxAlignH = AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ALeft
  }

instance CmbAlignCenter (BoxCfg s e) where
  alignCenter_ :: Bool -> BoxCfg s e
alignCenter_ Bool
False = BoxCfg s e
forall a. Default a => a
def
  alignCenter_ Bool
True = BoxCfg s e
forall a. Default a => a
def {
    _boxAlignH :: Maybe AlignH
_boxAlignH = AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ACenter
  }

instance CmbAlignRight (BoxCfg s e) where
  alignRight_ :: Bool -> BoxCfg s e
alignRight_ Bool
False = BoxCfg s e
forall a. Default a => a
def
  alignRight_ Bool
True = BoxCfg s e
forall a. Default a => a
def {
    _boxAlignH :: Maybe AlignH
_boxAlignH = AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ARight
  }

instance CmbAlignTop (BoxCfg s e) where
  alignTop_ :: Bool -> BoxCfg s e
alignTop_ Bool
False = BoxCfg s e
forall a. Default a => a
def
  alignTop_ Bool
True = BoxCfg s e
forall a. Default a => a
def {
    _boxAlignV :: Maybe AlignV
_boxAlignV = AlignV -> Maybe AlignV
forall a. a -> Maybe a
Just AlignV
ATop
  }

instance CmbAlignMiddle (BoxCfg s e) where
  alignMiddle_ :: Bool -> BoxCfg s e
alignMiddle_ Bool
False = BoxCfg s e
forall a. Default a => a
def
  alignMiddle_ Bool
True = BoxCfg s e
forall a. Default a => a
def {
    _boxAlignV :: Maybe AlignV
_boxAlignV = AlignV -> Maybe AlignV
forall a. a -> Maybe a
Just AlignV
AMiddle
  }

instance CmbAlignBottom (BoxCfg s e) where
  alignBottom_ :: Bool -> BoxCfg s e
alignBottom_ Bool
False = BoxCfg s e
forall a. Default a => a
def
  alignBottom_ Bool
True = BoxCfg s e
forall a. Default a => a
def {
    _boxAlignV :: Maybe AlignV
_boxAlignV = AlignV -> Maybe AlignV
forall a. a -> Maybe a
Just AlignV
ABottom
  }

instance WidgetEvent e => CmbOnFocus (BoxCfg s e) e Path where
  onFocus :: (Path -> e) -> BoxCfg s e
onFocus Path -> e
handler = BoxCfg s e
forall a. Default a => a
def {
    _boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
handler]
  }

instance CmbOnFocusReq (BoxCfg s e) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> BoxCfg s e
onFocusReq Path -> WidgetRequest s e
req = BoxCfg s e
forall a. Default a => a
def {
    _boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (BoxCfg s e) e Path where
  onBlur :: (Path -> e) -> BoxCfg s e
onBlur Path -> e
handler = BoxCfg s e
forall a. Default a => a
def {
    _boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
handler]
  }

instance CmbOnBlurReq (BoxCfg s e) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> BoxCfg s e
onBlurReq Path -> WidgetRequest s e
req = BoxCfg s e
forall a. Default a => a
def {
    _boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBtnPressed (BoxCfg s e) e where
  onBtnPressed :: (Button -> Int -> e) -> BoxCfg s e
onBtnPressed Button -> Int -> e
handler = BoxCfg s e
forall a. Default a => a
def {
    _boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [(e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> (Int -> e) -> Int -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> e) -> Int -> WidgetRequest s e)
-> (Button -> Int -> e) -> Button -> Int -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Button -> Int -> e
handler]
  }

instance CmbOnBtnPressedReq (BoxCfg s e) s e where
  onBtnPressedReq :: (Button -> Int -> WidgetRequest s e) -> BoxCfg s e
onBtnPressedReq Button -> Int -> WidgetRequest s e
req = BoxCfg s e
forall a. Default a => a
def {
    _boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [Button -> Int -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBtnReleased (BoxCfg s e) e where
  onBtnReleased :: (Button -> Int -> e) -> BoxCfg s e
onBtnReleased Button -> Int -> e
handler = BoxCfg s e
forall a. Default a => a
def {
    _boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = [(e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> (Int -> e) -> Int -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> e) -> Int -> WidgetRequest s e)
-> (Button -> Int -> e) -> Button -> Int -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Button -> Int -> e
handler]
  }

instance CmbOnBtnReleasedReq (BoxCfg s e) s e where
  onBtnReleasedReq :: (Button -> Int -> WidgetRequest s e) -> BoxCfg s e
onBtnReleasedReq Button -> Int -> WidgetRequest s e
req = BoxCfg s e
forall a. Default a => a
def {
    _boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = [Button -> Int -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnClick (BoxCfg s e) e where
  onClick :: e -> BoxCfg s e
onClick e
handler = BoxCfg s e
forall a. Default a => a
def {
    _boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnClickReq (BoxCfg s e) s e where
  onClickReq :: WidgetRequest s e -> BoxCfg s e
onClickReq WidgetRequest s e
req = BoxCfg s e
forall a. Default a => a
def {
    _boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnClickEmpty (BoxCfg s e) e where
  onClickEmpty :: e -> BoxCfg s e
onClickEmpty e
handler = BoxCfg s e
forall a. Default a => a
def {
    _boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnClickEmptyReq (BoxCfg s e) s e where
  onClickEmptyReq :: WidgetRequest s e -> BoxCfg s e
onClickEmptyReq WidgetRequest s e
req = BoxCfg s e
forall a. Default a => a
def {
    _boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnEnter (BoxCfg s e) e where
  onEnter :: e -> BoxCfg s e
onEnter e
handler = BoxCfg s e
forall a. Default a => a
def {
    _boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnEnterReq (BoxCfg s e) s e where
  onEnterReq :: WidgetRequest s e -> BoxCfg s e
onEnterReq WidgetRequest s e
req = BoxCfg s e
forall a. Default a => a
def {
    _boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnLeave (BoxCfg s e) e where
  onLeave :: e -> BoxCfg s e
onLeave e
handler = BoxCfg s e
forall a. Default a => a
def {
    _boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
  }

instance CmbOnLeaveReq (BoxCfg s e) s e where
  onLeaveReq :: WidgetRequest s e -> BoxCfg s e
onLeaveReq WidgetRequest s e
req = BoxCfg s e
forall a. Default a => a
def {
    _boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [WidgetRequest s e
req]
  }

-- | Assigns all the available space to its contained child.
expandContent :: BoxCfg s e
expandContent :: BoxCfg s e
expandContent = BoxCfg s e
forall a. Default a => a
def {
  _boxExpandContent :: Maybe Bool
_boxExpandContent = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
}

newtype BoxState s = BoxState {
  BoxState s -> Maybe s
_bxsModel :: Maybe s
}

-- | Creates a box widget with a single node as child.
box :: (WidgetModel s, WidgetEvent e) => WidgetNode s e -> WidgetNode s e
box :: WidgetNode s e -> WidgetNode s e
box WidgetNode s e
managed = [BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [BoxCfg s e]
forall a. Default a => a
def WidgetNode s e
managed

-- | Creates a box widget with a single node as child. Accepts config.
box_
  :: (WidgetModel s, WidgetEvent e)
  => [BoxCfg s e]
  -> WidgetNode s e
  -> WidgetNode s e
box_ :: [BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [BoxCfg s e]
configs WidgetNode s e
managed = Widget s e -> WidgetNode s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (BoxCfg s e -> BoxState s -> Widget s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
forall s. BoxState s
state) WidgetNode s e
managed where
  config :: BoxCfg s e
config = [BoxCfg s e] -> BoxCfg s e
forall a. Monoid a => [a] -> a
mconcat [BoxCfg s e]
configs
  state :: BoxState s
state = Maybe s -> BoxState s
forall s. Maybe s -> BoxState s
BoxState Maybe s
forall a. Maybe a
Nothing

makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
managedWidget = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"box" Widget s e
widget
  WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
  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
.~ WidgetNode s e -> Seq (WidgetNode s e)
forall a. a -> Seq a
Seq.singleton WidgetNode s e
managedWidget

makeBox
  :: (WidgetModel s, WidgetEvent e)
  => BoxCfg s e
  -> BoxState s
  -> Widget s e
makeBox :: BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
state = Widget s e
widget where
  widget :: Widget s e
widget = BoxState s -> Container s e (BoxState s) -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer BoxState s
state Container s e (BoxState s)
forall a. Default a => a
def {
    containerIgnoreEmptyArea :: Bool
containerIgnoreEmptyArea = Bool
ignoreEmptyArea Bool -> Bool -> Bool
&& Int
emptyHandlersCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0,
    containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = ContainerGetCurrentStyle s e
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle,
    containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
forall s. HasModel s s => s -> WidgetNode s e -> WidgetResult s e
init,
    containerMergeChildrenReq :: ContainerMergeChildrenReqHandler s e (BoxState s)
containerMergeChildrenReq = ContainerMergeChildrenReqHandler s e (BoxState s)
forall s p p. HasModel s s => s -> p -> p -> BoxState s -> Bool
mergeRequired,
    containerMerge :: ContainerMergeHandler s e (BoxState s)
containerMerge = ContainerMergeHandler s e (BoxState s)
forall s p p.
HasModel s s =>
s -> WidgetNode s e -> p -> p -> WidgetResult s e
merge,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall p p.
p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
forall s e. ContainerGetSizeReqHandler s e
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
  }

  ignoreEmptyArea :: Bool
ignoreEmptyArea = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCfg s e -> Maybe Bool
forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
config
  emptyHandlersCount :: Int
emptyHandlersCount = [WidgetRequest s e] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config)

  init :: s -> WidgetNode s e -> WidgetResult s e
init s
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newState :: BoxState s
newState = Maybe s -> BoxState s
forall s. Maybe s -> BoxState s
BoxState (s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ s
wenv s -> Getting s s s -> s
forall s a. s -> Getting a s a -> a
^. Getting s s s
forall s a. HasModel s a => Lens' s a
L.model)
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BoxCfg s e -> BoxState s -> Widget s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
newState

  mergeRequired :: s -> p -> p -> BoxState s -> Bool
mergeRequired s
wenv p
node p
oldNode BoxState s
oldState = Bool
required where
    newModel :: s
newModel = s
wenv s -> Getting s s s -> s
forall s a. s -> Getting a s a -> a
^. Getting s s s
forall s a. HasModel s a => Lens' s a
L.model
    required :: Bool
required = case (BoxCfg s e -> Maybe (s -> s -> Bool)
forall s e. BoxCfg s e -> Maybe (s -> s -> Bool)
_boxMergeRequired BoxCfg s e
config, BoxState s -> Maybe s
forall s. BoxState s -> Maybe s
_bxsModel BoxState s
oldState) of
      (Just s -> s -> Bool
mergeReqFn, Just s
oldModel) -> s -> s -> Bool
mergeReqFn s
oldModel s
newModel
      (Maybe (s -> s -> Bool), Maybe s)
_ -> Bool
True

  merge :: s -> WidgetNode s e -> p -> p -> WidgetResult s e
merge s
wenv WidgetNode s e
node p
oldNode p
oldState = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newState :: BoxState s
newState = Maybe s -> BoxState s
forall s. Maybe s -> BoxState s
BoxState (s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ s
wenv s -> Getting s s s -> s
forall s a. s -> Getting a s a -> a
^. Getting s s s
forall s a. HasModel s a => Lens' s a
L.model)
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BoxCfg s e -> BoxState s -> Widget s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
newState

  getCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle = CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ CurrentStyleCfg s e
currentStyleConfig where
    currentStyleConfig :: CurrentStyleCfg s e
currentStyleConfig = CurrentStyleCfg s e
forall a. Default a => a
def
      CurrentStyleCfg s e
-> (CurrentStyleCfg s e -> CurrentStyleCfg s e)
-> CurrentStyleCfg s e
forall a b. a -> (a -> b) -> b
& ((WidgetEnv s e -> WidgetNode s e -> Bool)
 -> Identity (WidgetEnv s e -> WidgetNode s e -> Bool))
-> CurrentStyleCfg s e -> Identity (CurrentStyleCfg s e)
forall s a. HasIsActive s a => Lens' s a
L.isActive (((WidgetEnv s e -> WidgetNode s e -> Bool)
  -> Identity (WidgetEnv s e -> WidgetNode s e -> Bool))
 -> CurrentStyleCfg s e -> Identity (CurrentStyleCfg s e))
-> (WidgetEnv s e -> WidgetNode s e -> Bool)
-> CurrentStyleCfg s e
-> CurrentStyleCfg s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTreeActive

  handleEvent :: p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent p
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    Focus Path
prev -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev (BoxCfg s e -> [Path -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
config)
    Blur Path
next -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (BoxCfg s e -> [Path -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
config)

    Enter Point
point
      | Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    Leave Point
point
      | Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    Click Point
point Button
btn Int
_
      | Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    Click Point
point Button
btn Int
_
      | Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
inChildVp Point
point) -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
      | Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
config [Button -> Int -> WidgetRequest s e]
-> [Button] -> [Int -> WidgetRequest s e]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Button -> [Button]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn [Int -> WidgetRequest s e] -> [Int] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
config [Button -> Int -> WidgetRequest s e]
-> [Button] -> [Int -> WidgetRequest s e]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Button -> [Button]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn [Int -> WidgetRequest s e] -> [Int] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
        reqsA :: [WidgetRequest s e]
reqsA = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
config
        reqsB :: [WidgetRequest s e]
reqsB = BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
config [Button -> Int -> WidgetRequest s e]
-> [Button] -> [Int -> WidgetRequest s e]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Button -> [Button]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn [Int -> WidgetRequest s e] -> [Int] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
        reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
reqsA [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> [WidgetRequest s e]
reqsB
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
      | Int
clicks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([WidgetRequest s e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
inChildVp Point
point) -> Maybe (WidgetResult s e)
result where
        reqs :: [WidgetRequest s e]
reqs = BoxCfg s e -> [WidgetRequest s e]
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config
        result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)

    SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
    where
      child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children) Int
0
      inChildVp :: Point -> Bool
inChildVp Point
point  = Point -> Rect -> Bool
pointInRect Point
point (WidgetNode s e
child WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport)

  getSizeReq :: ContainerGetSizeReqHandler s e
  getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq, SizeReq)
newSizeReq where
    sizeReqFns :: [SizeReqUpdater]
sizeReqFns = BoxCfg s e -> [SizeReqUpdater]
forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
config
    child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    newReqW :: SizeReq
newReqW = WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    newReqH :: SizeReq
newReqH = WidgetNode s e
child WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
    newSizeReq :: (SizeReq, SizeReq)
newSizeReq = [SizeReqUpdater] -> SizeReqUpdater
forall a. [a -> a] -> a -> a
applyFnList [SizeReqUpdater]
sizeReqFns (SizeReq
newReqW, SizeReq
newReqH)

  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
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
    child :: WidgetNode s e
child = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    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
cx Double
cy Double
cw Double
ch = Rect
contentArea

    contentW :: Double
contentW = (Seq Rect, Double) -> Double
forall a b. (a, b) -> b
snd ((Seq Rect, Double) -> Double) -> (Seq Rect, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
forall s e.
Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
True Rect
contentArea Seq (WidgetNode s e)
children
    contentH :: Double
contentH = (Seq Rect, Double) -> Double
forall a b. (a, b) -> b
snd ((Seq Rect, Double) -> Double) -> (Seq Rect, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
forall s e.
Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
False Rect
contentArea Seq (WidgetNode s e)
children

    raChild :: Rect
raChild = Double -> Double -> Double -> Double -> Rect
Rect Double
cx Double
cy (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
cw Double
contentW) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
ch Double
contentH)
    ah :: AlignH
ah = AlignH -> Maybe AlignH -> AlignH
forall a. a -> Maybe a -> a
fromMaybe AlignH
ACenter (BoxCfg s e -> Maybe AlignH
forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
config)
    av :: AlignV
av = AlignV -> Maybe AlignV -> AlignV
forall a. a -> Maybe a -> a
fromMaybe AlignV
AMiddle (BoxCfg s e -> Maybe AlignV
forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
config)
    raAligned :: Rect
raAligned = Rect -> Rect -> AlignH -> AlignV -> Rect
alignInRect Rect
contentArea Rect
raChild AlignH
ah AlignV
av

    expand :: Bool
expand = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (BoxCfg s e -> Maybe Bool
forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
config)
    resized :: (WidgetResult s e, Seq Rect)
resized
      | Bool
expand = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Rect -> Seq Rect
forall a. a -> Seq a
Seq.singleton Rect
contentArea)
      | Bool
otherwise = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Rect -> Seq Rect
forall a. a -> Seq a
Seq.singleton Rect
raAligned)