{-|
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 DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}

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

import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~), (%~), at)
import Control.Monad (when)
import Data.Default
import Data.Maybe
import Data.Text (Text)
import Data.Typeable (cast)
import GHC.Generics

import qualified Data.Sequence as Seq

import Monomer.Widgets.Container
import Monomer.Widgets.Animation.Types

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.
-}
data FadeCfg e = FadeCfg {
  FadeCfg e -> Maybe Bool
_fdcAutoStart :: Maybe Bool,
  FadeCfg e -> Maybe Millisecond
_fdcDuration :: Maybe Millisecond,
  FadeCfg e -> [e]
_fdcOnFinished :: [e]
} deriving (FadeCfg e -> FadeCfg e -> Bool
(FadeCfg e -> FadeCfg e -> Bool)
-> (FadeCfg e -> FadeCfg e -> Bool) -> Eq (FadeCfg e)
forall e. Eq e => FadeCfg e -> FadeCfg e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FadeCfg e -> FadeCfg e -> Bool
$c/= :: forall e. Eq e => FadeCfg e -> FadeCfg e -> Bool
== :: FadeCfg e -> FadeCfg e -> Bool
$c== :: forall e. Eq e => FadeCfg e -> FadeCfg e -> Bool
Eq, Int -> FadeCfg e -> ShowS
[FadeCfg e] -> ShowS
FadeCfg e -> String
(Int -> FadeCfg e -> ShowS)
-> (FadeCfg e -> String)
-> ([FadeCfg e] -> ShowS)
-> Show (FadeCfg e)
forall e. Show e => Int -> FadeCfg e -> ShowS
forall e. Show e => [FadeCfg e] -> ShowS
forall e. Show e => FadeCfg e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FadeCfg e] -> ShowS
$cshowList :: forall e. Show e => [FadeCfg e] -> ShowS
show :: FadeCfg e -> String
$cshow :: forall e. Show e => FadeCfg e -> String
showsPrec :: Int -> FadeCfg e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> FadeCfg e -> ShowS
Show)

instance Default (FadeCfg e) where
  def :: FadeCfg e
def = FadeCfg :: forall e. Maybe Bool -> Maybe Millisecond -> [e] -> FadeCfg e
FadeCfg {
    _fdcAutoStart :: Maybe Bool
_fdcAutoStart = Maybe Bool
forall a. Maybe a
Nothing,
    _fdcDuration :: Maybe Millisecond
_fdcDuration = Maybe Millisecond
forall a. Maybe a
Nothing,
    _fdcOnFinished :: [e]
_fdcOnFinished = []
  }

instance Semigroup (FadeCfg e) where
  <> :: FadeCfg e -> FadeCfg e -> FadeCfg e
(<>) FadeCfg e
fc1 FadeCfg e
fc2 = FadeCfg :: forall e. Maybe Bool -> Maybe Millisecond -> [e] -> FadeCfg e
FadeCfg {
    _fdcAutoStart :: Maybe Bool
_fdcAutoStart = FadeCfg e -> Maybe Bool
forall e. FadeCfg e -> Maybe Bool
_fdcAutoStart FadeCfg e
fc2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FadeCfg e -> Maybe Bool
forall e. FadeCfg e -> Maybe Bool
_fdcAutoStart FadeCfg e
fc1,
    _fdcDuration :: Maybe Millisecond
_fdcDuration = FadeCfg e -> Maybe Millisecond
forall e. FadeCfg e -> Maybe Millisecond
_fdcDuration FadeCfg e
fc2 Maybe Millisecond -> Maybe Millisecond -> Maybe Millisecond
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FadeCfg e -> Maybe Millisecond
forall e. FadeCfg e -> Maybe Millisecond
_fdcDuration FadeCfg e
fc1,
    _fdcOnFinished :: [e]
_fdcOnFinished = FadeCfg e -> [e]
forall e. FadeCfg e -> [e]
_fdcOnFinished FadeCfg e
fc1 [e] -> [e] -> [e]
forall a. Semigroup a => a -> a -> a
<> FadeCfg e -> [e]
forall e. FadeCfg e -> [e]
_fdcOnFinished FadeCfg e
fc2
  }

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

instance CmbAutoStart (FadeCfg e) where
  autoStart_ :: Bool -> FadeCfg e
autoStart_ Bool
start = FadeCfg e
forall a. Default a => a
def {
    _fdcAutoStart :: Maybe Bool
_fdcAutoStart = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
start
  }

instance CmbDuration (FadeCfg e) Millisecond where
  duration :: Millisecond -> FadeCfg e
duration Millisecond
dur = FadeCfg e
forall a. Default a => a
def {
    _fdcDuration :: Maybe Millisecond
_fdcDuration = Millisecond -> Maybe Millisecond
forall a. a -> Maybe a
Just Millisecond
dur
  }

instance CmbOnFinished (FadeCfg e) e where
  onFinished :: e -> FadeCfg e
onFinished e
fn = FadeCfg Any
forall a. Default a => a
def {
    _fdcOnFinished :: [e]
_fdcOnFinished = [e
fn]
  }

data FadeState = FadeState {
  FadeState -> Bool
_fdsRunning :: Bool,
  FadeState -> Millisecond
_fdsStartTs :: Millisecond
} deriving (FadeState -> FadeState -> Bool
(FadeState -> FadeState -> Bool)
-> (FadeState -> FadeState -> Bool) -> Eq FadeState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FadeState -> FadeState -> Bool
$c/= :: FadeState -> FadeState -> Bool
== :: FadeState -> FadeState -> Bool
$c== :: FadeState -> FadeState -> Bool
Eq, Int -> FadeState -> ShowS
[FadeState] -> ShowS
FadeState -> String
(Int -> FadeState -> ShowS)
-> (FadeState -> String)
-> ([FadeState] -> ShowS)
-> Show FadeState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FadeState] -> ShowS
$cshowList :: [FadeState] -> ShowS
show :: FadeState -> String
$cshow :: FadeState -> String
showsPrec :: Int -> FadeState -> ShowS
$cshowsPrec :: Int -> FadeState -> ShowS
Show, (forall x. FadeState -> Rep FadeState x)
-> (forall x. Rep FadeState x -> FadeState) -> Generic FadeState
forall x. Rep FadeState x -> FadeState
forall x. FadeState -> Rep FadeState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FadeState x -> FadeState
$cfrom :: forall x. FadeState -> Rep FadeState x
Generic)

instance Default FadeState where
  def :: FadeState
def = FadeState :: Bool -> Millisecond -> FadeState
FadeState {
    _fdsRunning :: Bool
_fdsRunning = Bool
False,
    _fdsStartTs :: Millisecond
_fdsStartTs = Millisecond
0
  }

-- | Animates a widget from not visible state to fully visible.
animFadeIn :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
animFadeIn :: WidgetNode s e -> WidgetNode s e
animFadeIn WidgetNode s e
managed = [FadeCfg e] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[FadeCfg e] -> WidgetNode s e -> WidgetNode s e
animFadeIn_ [FadeCfg 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 e] -> WidgetNode s e -> WidgetNode s e
animFadeIn_ :: [FadeCfg e] -> WidgetNode s e -> WidgetNode s e
animFadeIn_ [FadeCfg e]
configs WidgetNode s e
managed = WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode WidgetType
"animFadeIn" Widget s e
forall s. Widget s e
widget WidgetNode s e
managed where
  config :: FadeCfg e
config = [FadeCfg e] -> FadeCfg e
forall a. Monoid a => [a] -> a
mconcat [FadeCfg e]
configs
  widget :: Widget s e
widget = Bool -> FadeCfg e -> FadeState -> Widget s e
forall e s.
WidgetEvent e =>
Bool -> FadeCfg e -> FadeState -> Widget s e
makeFade Bool
True FadeCfg e
config FadeState
forall a. Default a => a
def

-- | Animates a widget from visible state to not visible.
animFadeOut :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
animFadeOut :: WidgetNode s e -> WidgetNode s e
animFadeOut WidgetNode s e
managed = [FadeCfg e] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[FadeCfg e] -> WidgetNode s e -> WidgetNode s e
animFadeOut_ [FadeCfg 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 e] -> WidgetNode s e -> WidgetNode s e
animFadeOut_ :: [FadeCfg e] -> WidgetNode s e -> WidgetNode s e
animFadeOut_ [FadeCfg e]
configs WidgetNode s e
managed = WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode WidgetType
"animFadeOut" Widget s e
forall s. Widget s e
widget WidgetNode s e
managed where
  config :: FadeCfg e
config = [FadeCfg e] -> FadeCfg e
forall a. Monoid a => [a] -> a
mconcat [FadeCfg e]
configs
  widget :: Widget s e
widget = Bool -> FadeCfg e -> FadeState -> Widget s e
forall e s.
WidgetEvent e =>
Bool -> FadeCfg e -> FadeState -> Widget s e
makeFade Bool
False FadeCfg e
config FadeState
forall a. Default a => a
def

makeNode
  :: WidgetEvent e => WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode WidgetType
wType 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
wType 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

makeFade :: WidgetEvent e => Bool -> FadeCfg e -> FadeState -> Widget s e
makeFade :: Bool -> FadeCfg e -> FadeState -> Widget s e
makeFade Bool
isFadeIn FadeCfg e
config FadeState
state = Widget s e
forall s. Widget s e
widget where
  widget :: Widget s e
widget = FadeState -> Container s e FadeState -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer FadeState
state Container s e FadeState
forall a. Default a => a
def {
    containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
forall p s.
HasTimestamp p Millisecond =>
p -> WidgetNode s e -> WidgetResult s e
init,
    containerMerge :: ContainerMergeHandler s e FadeState
containerMerge = ContainerMergeHandler s e FadeState
forall p s p.
p -> WidgetNode s e -> p -> FadeState -> WidgetResult s e
merge,
    containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = ContainerMessageHandler s e
forall a s s p.
(Typeable a, HasTimestamp s Millisecond) =>
s -> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage,
    containerRender :: ContainerRenderHandler s e
containerRender = ContainerRenderHandler s e
forall s p.
HasTimestamp s Millisecond =>
s -> p -> Renderer -> IO ()
render,
    containerRenderAfter :: ContainerRenderHandler s e
containerRenderAfter = ContainerRenderHandler s e
forall p p. p -> p -> Renderer -> IO ()
renderPost
  }

  FadeState Bool
running Millisecond
start = FadeState
state
  autoStart :: Bool
autoStart = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (FadeCfg e -> Maybe Bool
forall e. FadeCfg e -> Maybe Bool
_fdcAutoStart FadeCfg e
config)
  duration :: Millisecond
duration = Millisecond -> Maybe Millisecond -> Millisecond
forall a. a -> Maybe a -> a
fromMaybe Millisecond
500 (FadeCfg e -> Maybe Millisecond
forall e. FadeCfg e -> Maybe Millisecond
_fdcDuration FadeCfg e
config)
  period :: Millisecond
period = Millisecond
20
  steps :: Int
steps = Millisecond -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Millisecond -> Int) -> Millisecond -> Int
forall a b. (a -> b) -> a -> b
$ Millisecond
duration Millisecond -> Millisecond -> Millisecond
forall a. Integral a => a -> a -> a
`div` Millisecond
period

  finishedReq :: WidgetNode s e -> WidgetRequest s e
finishedReq WidgetNode s e
node = WidgetNode s e -> AnimationMsg -> Millisecond -> WidgetRequest s e
forall i s e.
Typeable i =>
WidgetNode s e -> i -> Millisecond -> WidgetRequest s e
delayedMessage WidgetNode s e
node AnimationMsg
AnimationFinished Millisecond
duration
  renderReq :: p -> s -> WidgetRequest s e
renderReq p
wenv s
node = WidgetRequest s e
forall s e. WidgetRequest s e
req where
    widgetId :: WidgetId
widgetId = s
node s -> Getting WidgetId s WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (a -> Const WidgetId a) -> s -> Const WidgetId s
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const WidgetId a) -> s -> Const WidgetId s)
-> ((WidgetId -> Const WidgetId WidgetId) -> a -> Const WidgetId a)
-> Getting WidgetId s WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId) -> a -> Const WidgetId a
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    req :: WidgetRequest s e
req = WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
period (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
steps)

  init :: p -> WidgetNode s e -> WidgetResult s e
init p
wenv WidgetNode s e
node = WidgetResult s e
result where
    ts :: Millisecond
ts = p
wenv p -> Getting Millisecond p Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond p Millisecond
forall s a. HasTimestamp s a => Lens' s a
L.timestamp
    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
.~ Bool -> FadeCfg e -> FadeState -> Widget s e
forall e s.
WidgetEvent e =>
Bool -> FadeCfg e -> FadeState -> Widget s e
makeFade Bool
isFadeIn FadeCfg e
config (Bool -> Millisecond -> FadeState
FadeState Bool
True Millisecond
ts)
    result :: WidgetResult s e
result
      | Bool
autoStart = 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
newNode [WidgetNode s e -> WidgetRequest s e
forall s e. WidgetNode s e -> WidgetRequest s e
finishedReq WidgetNode s e
node, p -> WidgetNode s e -> WidgetRequest s e
forall s a p s e.
(HasInfo s a, HasWidgetId a WidgetId) =>
p -> s -> WidgetRequest s e
renderReq p
wenv WidgetNode s e
node]
      | Bool
otherwise = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

  merge :: p -> WidgetNode s e -> p -> FadeState -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode FadeState
oldState = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    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
.~ Bool -> FadeCfg e -> FadeState -> Widget s e
forall e s.
WidgetEvent e =>
Bool -> FadeCfg e -> FadeState -> Widget s e
makeFade Bool
isFadeIn FadeCfg e
config FadeState
oldState

  handleMessage :: s -> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage s
wenv WidgetNode s e
node p
target a
message = Maybe (WidgetResult s e)
result where
    result :: Maybe (WidgetResult s e)
result = a -> Maybe AnimationMsg
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
message Maybe AnimationMsg
-> (AnimationMsg -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> (AnimationMsg -> WidgetResult s e)
-> AnimationMsg
-> Maybe (WidgetResult s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> WidgetNode s e -> AnimationMsg -> WidgetResult s e
forall s s.
HasTimestamp s Millisecond =>
s -> WidgetNode s e -> AnimationMsg -> WidgetResult s e
handleAnimateMsg s
wenv WidgetNode s e
node

  handleAnimateMsg :: s -> WidgetNode s e -> AnimationMsg -> WidgetResult s e
handleAnimateMsg s
wenv WidgetNode s e
node AnimationMsg
msg = WidgetResult s e
result where
    widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    ts :: Millisecond
ts = s
wenv s -> Getting Millisecond s Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond s Millisecond
forall s a. HasTimestamp s a => Lens' s a
L.timestamp
    startState :: FadeState
startState = Bool -> Millisecond -> FadeState
FadeState Bool
True Millisecond
ts
    startReqs :: [WidgetRequest s e]
startReqs = [WidgetNode s e -> WidgetRequest s e
forall s e. WidgetNode s e -> WidgetRequest s e
finishedReq WidgetNode s e
node, s -> WidgetNode s e -> WidgetRequest s e
forall s a p s e.
(HasInfo s a, HasWidgetId a WidgetId) =>
p -> s -> WidgetRequest s e
renderReq s
wenv WidgetNode s e
node]

    newNode :: FadeState -> WidgetNode s e
newNode FadeState
newState = 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
.~ Bool -> FadeCfg e -> FadeState -> Widget s e
forall e s.
WidgetEvent e =>
Bool -> FadeCfg e -> FadeState -> Widget s e
makeFade Bool
isFadeIn FadeCfg e
config FadeState
newState
    result :: WidgetResult s e
result = case AnimationMsg
msg of
      AnimationMsg
AnimationStart -> WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs (FadeState -> WidgetNode s e
forall s.
HasWidget (WidgetNode s e) (Widget s e) =>
FadeState -> WidgetNode s e
newNode FadeState
startState) [WidgetRequest s e]
startReqs
      AnimationMsg
AnimationStop -> WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs (FadeState -> WidgetNode s e
forall s.
HasWidget (WidgetNode s e) (Widget s e) =>
FadeState -> WidgetNode s e
newNode FadeState
forall a. Default a => a
def) [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId]
      AnimationMsg
AnimationFinished
        | FadeState -> Bool
_fdsRunning FadeState
state -> WidgetNode s e -> [e] -> WidgetResult s e
forall e s. Typeable e => WidgetNode s e -> [e] -> WidgetResult s e
resultEvts WidgetNode s e
node (FadeCfg e -> [e]
forall e. FadeCfg e -> [e]
_fdcOnFinished FadeCfg e
config)
        | Bool
otherwise -> WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

  render :: s -> p -> Renderer -> IO ()
render s
wenv p
node Renderer
renderer = do
    Renderer -> IO ()
saveContext Renderer
renderer
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
running (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Double -> IO ()
setGlobalAlpha Renderer
renderer Double
alpha
    where
      ts :: Millisecond
ts = s
wenv s -> Getting Millisecond s Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond s Millisecond
forall s a. HasTimestamp s a => Lens' s a
L.timestamp
      currStep :: Double
currStep = Double -> Double
clampAlpha (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Millisecond -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Millisecond
ts Millisecond -> Millisecond -> Millisecond
forall a. Num a => a -> a -> a
- Millisecond
start) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Millisecond -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Millisecond
duration
      alpha :: Double
alpha
        | Bool
isFadeIn = Double
currStep
        | Bool
otherwise = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
currStep

  renderPost :: p -> p -> Renderer -> IO ()
renderPost p
wenv p
node Renderer
renderer = do
    Renderer -> IO ()
restoreContext Renderer
renderer