{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Animation.Fade (
FadeCfg,
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
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
}
animFadeIn
:: WidgetEvent e
=> WidgetNode s e
-> WidgetNode s e
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
animFadeIn_
:: WidgetEvent e
=> [FadeCfg s e]
-> WidgetNode s e
-> WidgetNode s e
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"
animFadeOut
:: WidgetEvent e
=> WidgetNode s e
-> WidgetNode s e
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
animFadeOut_
:: WidgetEvent e
=> [FadeCfg s e]
-> WidgetNode s e
-> WidgetNode s e
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