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

Fade animation widget. Wraps a child widget whose content will be animated.

Messages:

- Accepts an 'AnimationMsg', used to control the state of the animation.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Animation.Fade (
  -- * Configuration
  FadeCfg,
  -- * Constructors
  animFadeIn,
  animFadeIn_,
  animFadeOut,
  animFadeOut_
) where

import Control.Lens ((&), (.~))
import Data.Default
import Data.Maybe

import Monomer.Widgets.Container
import Monomer.Widgets.Animation.Transform

import qualified Monomer.Lens as L

{-|
Configuration options for fade:

- 'autoStart': whether the first time the widget is added, animation should run.
- 'duration': how long the animation lasts in ms.
- 'onFinished': event to raise when animation is complete.
- 'onFinishedReq': 'WidgetRequest' to generate when animation is complete.
-}
newtype FadeCfg s e = FadeCfg {
  forall s e. FadeCfg s e -> TransformCfg s e
_fdcTransformCfg :: TransformCfg s e
} deriving (FadeCfg s e -> FadeCfg s e -> Bool
(FadeCfg s e -> FadeCfg s e -> Bool)
-> (FadeCfg s e -> FadeCfg s e -> Bool) -> Eq (FadeCfg s e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s e. Eq e => FadeCfg s e -> FadeCfg s e -> Bool
$c== :: forall s e. Eq e => FadeCfg s e -> FadeCfg s e -> Bool
== :: FadeCfg s e -> FadeCfg s e -> Bool
$c/= :: forall s e. Eq e => FadeCfg s e -> FadeCfg s e -> Bool
/= :: FadeCfg s e -> FadeCfg s e -> Bool
Eq, Int -> FadeCfg s e -> ShowS
[FadeCfg s e] -> ShowS
FadeCfg s e -> String
(Int -> FadeCfg s e -> ShowS)
-> (FadeCfg s e -> String)
-> ([FadeCfg s e] -> ShowS)
-> Show (FadeCfg s e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s e. Int -> FadeCfg s e -> ShowS
forall s e. [FadeCfg s e] -> ShowS
forall s e. FadeCfg s e -> String
$cshowsPrec :: forall s e. Int -> FadeCfg s e -> ShowS
showsPrec :: Int -> FadeCfg s e -> ShowS
$cshow :: forall s e. FadeCfg s e -> String
show :: FadeCfg s e -> String
$cshowList :: forall s e. [FadeCfg s e] -> ShowS
showList :: [FadeCfg s e] -> ShowS
Show)

instance Default (FadeCfg s e) where
  def :: FadeCfg s e
def = FadeCfg {
    _fdcTransformCfg :: TransformCfg s e
_fdcTransformCfg = TransformCfg s e
forall a. Default a => a
def
  }

instance Semigroup (FadeCfg s e) where
  <> :: FadeCfg s e -> FadeCfg s e -> FadeCfg s e
(<>) FadeCfg s e
fc1 FadeCfg s e
fc2 = FadeCfg {
    _fdcTransformCfg :: TransformCfg s e
_fdcTransformCfg = FadeCfg s e -> TransformCfg s e
forall s e. FadeCfg s e -> TransformCfg s e
_fdcTransformCfg FadeCfg s e
fc1 TransformCfg s e -> TransformCfg s e -> TransformCfg s e
forall a. Semigroup a => a -> a -> a
<> FadeCfg s e -> TransformCfg s e
forall s e. FadeCfg s e -> TransformCfg s e
_fdcTransformCfg FadeCfg s e
fc2
  }

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

instance CmbAutoStart (FadeCfg s e) where
  autoStart_ :: Bool -> FadeCfg s e
autoStart_ Bool
start = FadeCfg Any Any
forall a. Default a => a
def {
    _fdcTransformCfg = autoStart_ start
  }

instance CmbDuration (FadeCfg s e) Millisecond where
  duration :: Millisecond -> FadeCfg s e
duration Millisecond
dur = FadeCfg Any Any
forall a. Default a => a
def {
    _fdcTransformCfg = duration dur
  }

instance WidgetEvent e => CmbOnFinished (FadeCfg s e) e where
  onFinished :: e -> FadeCfg s e
onFinished e
handler = FadeCfg Any Any
forall a. Default a => a
def {
    _fdcTransformCfg = onFinished handler
  }

instance CmbOnFinishedReq (FadeCfg s e) s e where
  onFinishedReq :: WidgetRequest s e -> FadeCfg s e
onFinishedReq WidgetRequest s e
req = FadeCfg Any Any
forall a. Default a => a
def {
    _fdcTransformCfg = onFinishedReq req
  }

-- | Animates a widget from not visible state to fully visible.
animFadeIn
  :: WidgetEvent e
  => WidgetNode s e  -- ^ The child node.
  -> WidgetNode s e  -- ^ The created animation container.
animFadeIn :: forall e s. WidgetEvent e => WidgetNode s e -> WidgetNode s e
animFadeIn WidgetNode s e
managed = [FadeCfg s e] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[FadeCfg s e] -> WidgetNode s e -> WidgetNode s e
animFadeIn_ [FadeCfg s e]
forall a. Default a => a
def WidgetNode s e
managed

-- | Animates a widget from not visible state to fully visible. Accepts config.
animFadeIn_
  :: WidgetEvent e
  => [FadeCfg s e]     -- ^ The config options.
  -> WidgetNode s e  -- ^ The child node.
  -> WidgetNode s e  -- ^ The created animation container.
animFadeIn_ :: forall e s.
WidgetEvent e =>
[FadeCfg s e] -> WidgetNode s e -> WidgetNode s e
animFadeIn_ [FadeCfg s e]
configs WidgetNode s e
managed = [FadeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
forall e s.
WidgetEvent e =>
[FadeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [FadeCfg s e]
configs WidgetNode s e
managed Bool
True
  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
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((WidgetType -> Identity WidgetType)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (WidgetType -> Identity WidgetType)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetType -> Identity WidgetType)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasWidgetType s a => Lens' s a
Lens' WidgetNodeInfo WidgetType
L.widgetType ((WidgetType -> Identity WidgetType)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetType -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetType
"animFadeIn"

-- | Animates a widget from visible state to not visible.
animFadeOut
  :: WidgetEvent e
  => WidgetNode s e  -- ^ The child node.
  -> WidgetNode s e  -- ^ The created animation container.
animFadeOut :: forall e s. WidgetEvent e => WidgetNode s e -> WidgetNode s e
animFadeOut WidgetNode s e
managed = [FadeCfg s e] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[FadeCfg s e] -> WidgetNode s e -> WidgetNode s e
animFadeOut_ [FadeCfg s e]
forall a. Default a => a
def WidgetNode s e
managed

-- | Animates a widget from visible state to not visible. Accepts config.
animFadeOut_
  :: WidgetEvent e
  => [FadeCfg s e]     -- ^ The config options.
  -> WidgetNode s e  -- ^ The child node.
  -> WidgetNode s e  -- ^ The created animation container.
animFadeOut_ :: forall e s.
WidgetEvent e =>
[FadeCfg s e] -> WidgetNode s e -> WidgetNode s e
animFadeOut_ [FadeCfg s e]
configs WidgetNode s e
managed = [FadeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
forall e s.
WidgetEvent e =>
[FadeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [FadeCfg s e]
configs WidgetNode s e
managed Bool
False
  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
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((WidgetType -> Identity WidgetType)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (WidgetType -> Identity WidgetType)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetType -> Identity WidgetType)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasWidgetType s a => Lens' s a
Lens' WidgetNodeInfo WidgetType
L.widgetType ((WidgetType -> Identity WidgetType)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetType -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetType
"animFadeOut"

makeNode
  :: WidgetEvent e
  => [FadeCfg s e]
  -> WidgetNode s e
  -> Bool
  -> WidgetNode s e
makeNode :: forall e s.
WidgetEvent e =>
[FadeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [FadeCfg s e]
configs WidgetNode s e
managed Bool
isFadeIn = WidgetNode s e
node where
  node :: WidgetNode s e
node = [TransformCfg s e]
-> Transformer -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[TransformCfg s e]
-> Transformer -> WidgetNode s e -> WidgetNode s e
animTransform_ [TransformCfg s e
_fdcTransformCfg] Transformer
forall {p}. Double -> p -> [RenderTransform]
f WidgetNode s e
managed
  f :: Double -> p -> [RenderTransform]
f Double
t p
_ = [Double -> RenderTransform
animGlobalAlpha (Double -> RenderTransform) -> Double -> RenderTransform
forall a b. (a -> b) -> a -> b
$ Double -> Double
alpha Double
t]
  alpha :: Double -> Double
alpha Double
t = if Bool
isFadeIn
    then (Double -> Double
currStep Double
t)
    else Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-(Double -> Double
currStep Double
t)
  currStep :: Double -> Double
currStep Double
t = Double -> Double
clampAlpha (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
tDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Millisecond -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Millisecond
dur)
  dur :: Millisecond
dur = Millisecond -> Maybe Millisecond -> Millisecond
forall a. a -> Maybe a -> a
fromMaybe Millisecond
500 Maybe Millisecond
_tfcDuration
  TransformCfg{[WidgetRequest s e]
Maybe Bool
Maybe Millisecond
_tfcDuration :: Maybe Millisecond
_tfcAutoStart :: Maybe Bool
_tfcOnFinishedReq :: [WidgetRequest s e]
_tfcAutoStart :: forall s e. TransformCfg s e -> Maybe Bool
_tfcDuration :: forall s e. TransformCfg s e -> Maybe Millisecond
_tfcOnFinishedReq :: forall s e. TransformCfg s e -> [WidgetRequest s e]
..} = TransformCfg s e
_fdcTransformCfg
  FadeCfg{TransformCfg s e
_fdcTransformCfg :: forall s e. FadeCfg s e -> TransformCfg s e
_fdcTransformCfg :: TransformCfg s e
..} = [FadeCfg s e] -> FadeCfg s e
forall a. Monoid a => [a] -> a
mconcat [FadeCfg s e]
configs