{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Animation.Wipe (
WipeCfg,
wipeLeft,
wipeRight,
wipeTop,
wipeBottom,
wipeDoorH,
wipeDoorV,
wipeRect,
animWipeIn,
animWipeIn_,
animWipeOut,
animWipeOut_
) where
import Control.Applicative ((<|>))
import Control.Lens ((&), (.~))
import Data.Default
import Data.Maybe
import Monomer.Helper
import Monomer.Widgets.Container
import Monomer.Widgets.Animation.Transform
import qualified Monomer.Lens as L
data WipeDirection
= WipeLeft
| WipeRight
| WipeTop
| WipeBottom
| WipeDoorH
| WipeDoorV
| WipeRect
deriving (WipeDirection -> WipeDirection -> Bool
(WipeDirection -> WipeDirection -> Bool)
-> (WipeDirection -> WipeDirection -> Bool) -> Eq WipeDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WipeDirection -> WipeDirection -> Bool
== :: WipeDirection -> WipeDirection -> Bool
$c/= :: WipeDirection -> WipeDirection -> Bool
/= :: WipeDirection -> WipeDirection -> Bool
Eq, Int -> WipeDirection -> ShowS
[WipeDirection] -> ShowS
WipeDirection -> String
(Int -> WipeDirection -> ShowS)
-> (WipeDirection -> String)
-> ([WipeDirection] -> ShowS)
-> Show WipeDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WipeDirection -> ShowS
showsPrec :: Int -> WipeDirection -> ShowS
$cshow :: WipeDirection -> String
show :: WipeDirection -> String
$cshowList :: [WipeDirection] -> ShowS
showList :: [WipeDirection] -> ShowS
Show)
data WipeCfg s e = WipeCfg {
forall s e. WipeCfg s e -> Maybe WipeDirection
_wpcDirection :: Maybe WipeDirection,
forall s e. WipeCfg s e -> TransformCfg s e
_wpcTransformCfg :: TransformCfg s e
} deriving (WipeCfg s e -> WipeCfg s e -> Bool
(WipeCfg s e -> WipeCfg s e -> Bool)
-> (WipeCfg s e -> WipeCfg s e -> Bool) -> Eq (WipeCfg s e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s e. Eq e => WipeCfg s e -> WipeCfg s e -> Bool
$c== :: forall s e. Eq e => WipeCfg s e -> WipeCfg s e -> Bool
== :: WipeCfg s e -> WipeCfg s e -> Bool
$c/= :: forall s e. Eq e => WipeCfg s e -> WipeCfg s e -> Bool
/= :: WipeCfg s e -> WipeCfg s e -> Bool
Eq, Int -> WipeCfg s e -> ShowS
[WipeCfg s e] -> ShowS
WipeCfg s e -> String
(Int -> WipeCfg s e -> ShowS)
-> (WipeCfg s e -> String)
-> ([WipeCfg s e] -> ShowS)
-> Show (WipeCfg s e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s e. Int -> WipeCfg s e -> ShowS
forall s e. [WipeCfg s e] -> ShowS
forall s e. WipeCfg s e -> String
$cshowsPrec :: forall s e. Int -> WipeCfg s e -> ShowS
showsPrec :: Int -> WipeCfg s e -> ShowS
$cshow :: forall s e. WipeCfg s e -> String
show :: WipeCfg s e -> String
$cshowList :: forall s e. [WipeCfg s e] -> ShowS
showList :: [WipeCfg s e] -> ShowS
Show)
instance Default (WipeCfg s e) where
def :: WipeCfg s e
def = WipeCfg {
_wpcDirection :: Maybe WipeDirection
_wpcDirection = Maybe WipeDirection
forall a. Maybe a
Nothing,
_wpcTransformCfg :: TransformCfg s e
_wpcTransformCfg = TransformCfg s e
forall a. Default a => a
def
}
instance Semigroup (WipeCfg s e) where
<> :: WipeCfg s e -> WipeCfg s e -> WipeCfg s e
(<>) WipeCfg s e
wc1 WipeCfg s e
wc2 = WipeCfg {
_wpcDirection :: Maybe WipeDirection
_wpcDirection = WipeCfg s e -> Maybe WipeDirection
forall s e. WipeCfg s e -> Maybe WipeDirection
_wpcDirection WipeCfg s e
wc2 Maybe WipeDirection -> Maybe WipeDirection -> Maybe WipeDirection
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WipeCfg s e -> Maybe WipeDirection
forall s e. WipeCfg s e -> Maybe WipeDirection
_wpcDirection WipeCfg s e
wc1,
_wpcTransformCfg :: TransformCfg s e
_wpcTransformCfg = WipeCfg s e -> TransformCfg s e
forall s e. WipeCfg s e -> TransformCfg s e
_wpcTransformCfg WipeCfg s e
wc1 TransformCfg s e -> TransformCfg s e -> TransformCfg s e
forall a. Semigroup a => a -> a -> a
<> WipeCfg s e -> TransformCfg s e
forall s e. WipeCfg s e -> TransformCfg s e
_wpcTransformCfg WipeCfg s e
wc2
}
instance Monoid (WipeCfg s e) where
mempty :: WipeCfg s e
mempty = WipeCfg s e
forall a. Default a => a
def
instance CmbAutoStart (WipeCfg s e) where
autoStart_ :: Bool -> WipeCfg s e
autoStart_ Bool
start = WipeCfg Any Any
forall a. Default a => a
def {
_wpcTransformCfg = autoStart_ start
}
instance CmbDuration (WipeCfg s e) Millisecond where
duration :: Millisecond -> WipeCfg s e
duration Millisecond
dur = WipeCfg Any Any
forall a. Default a => a
def {
_wpcTransformCfg = duration dur
}
instance WidgetEvent e => CmbOnFinished (WipeCfg s e) e where
onFinished :: e -> WipeCfg s e
onFinished e
handler = WipeCfg Any Any
forall a. Default a => a
def {
_wpcTransformCfg = onFinished handler
}
instance CmbOnFinishedReq (WipeCfg s e) s e where
onFinishedReq :: WidgetRequest s e -> WipeCfg s e
onFinishedReq WidgetRequest s e
req = WipeCfg Any Any
forall a. Default a => a
def {
_wpcTransformCfg = onFinishedReq req
}
wipeLeft :: WipeCfg s e
wipeLeft :: forall s e. WipeCfg s e
wipeLeft = WipeCfg s e
forall a. Default a => a
def { _wpcDirection = Just WipeLeft }
wipeRight :: WipeCfg s e
wipeRight :: forall s e. WipeCfg s e
wipeRight = WipeCfg s e
forall a. Default a => a
def { _wpcDirection = Just WipeRight }
wipeTop :: WipeCfg s e
wipeTop :: forall s e. WipeCfg s e
wipeTop = WipeCfg s e
forall a. Default a => a
def { _wpcDirection = Just WipeTop }
wipeBottom :: WipeCfg s e
wipeBottom :: forall s e. WipeCfg s e
wipeBottom = WipeCfg s e
forall a. Default a => a
def { _wpcDirection = Just WipeBottom }
wipeDoorH :: WipeCfg s e
wipeDoorH :: forall s e. WipeCfg s e
wipeDoorH = WipeCfg s e
forall a. Default a => a
def { _wpcDirection = Just WipeDoorH }
wipeDoorV :: WipeCfg s e
wipeDoorV :: forall s e. WipeCfg s e
wipeDoorV = WipeCfg s e
forall a. Default a => a
def { _wpcDirection = Just WipeDoorV }
wipeRect :: WipeCfg s e
wipeRect :: forall s e. WipeCfg s e
wipeRect = WipeCfg s e
forall a. Default a => a
def { _wpcDirection = Just WipeRect }
animWipeIn
:: WidgetEvent e
=> WidgetNode s e
-> WidgetNode s e
animWipeIn :: forall e s. WidgetEvent e => WidgetNode s e -> WidgetNode s e
animWipeIn WidgetNode s e
managed = [WipeCfg s e] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[WipeCfg s e] -> WidgetNode s e -> WidgetNode s e
animWipeIn_ [WipeCfg s e]
forall a. Default a => a
def WidgetNode s e
managed
animWipeIn_
:: WidgetEvent e
=> [WipeCfg s e]
-> WidgetNode s e
-> WidgetNode s e
animWipeIn_ :: forall e s.
WidgetEvent e =>
[WipeCfg s e] -> WidgetNode s e -> WidgetNode s e
animWipeIn_ [WipeCfg s e]
configs WidgetNode s e
managed = [WipeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
forall e s.
WidgetEvent e =>
[WipeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [WipeCfg 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
"animWipeIn"
animWipeOut
:: WidgetEvent e
=> WidgetNode s e
-> WidgetNode s e
animWipeOut :: forall e s. WidgetEvent e => WidgetNode s e -> WidgetNode s e
animWipeOut WidgetNode s e
managed = [WipeCfg s e] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[WipeCfg s e] -> WidgetNode s e -> WidgetNode s e
animWipeOut_ [WipeCfg s e]
forall a. Default a => a
def WidgetNode s e
managed
animWipeOut_
:: WidgetEvent e
=> [WipeCfg s e]
-> WidgetNode s e
-> WidgetNode s e
animWipeOut_ :: forall e s.
WidgetEvent e =>
[WipeCfg s e] -> WidgetNode s e -> WidgetNode s e
animWipeOut_ [WipeCfg s e]
configs WidgetNode s e
managed = [WipeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
forall e s.
WidgetEvent e =>
[WipeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [WipeCfg 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
"animWipeOut"
makeNode
:: WidgetEvent e
=> [WipeCfg s e]
-> WidgetNode s e
-> Bool
-> WidgetNode s e
makeNode :: forall e s.
WidgetEvent e =>
[WipeCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [WipeCfg s e]
configs WidgetNode s e
managed Bool
isWipeIn = 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
_wpcTransformCfg] Transformer
f WidgetNode s e
managed
f :: Transformer
f Double
t (Rect Double
x Double
y Double
w Double
h) = [Rect -> RenderTransform
animScissor Rect
vp] where
vp :: Rect
vp = case WipeDirection
dir of
WipeDirection
WipeLeft -> Double -> Double -> Double -> Double -> Rect
Rect Double
x Double
y Double
dw Double
h
WipeDirection
WipeRight -> Double -> Double -> Double -> Double -> Rect
Rect (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+(Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-(Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
step Double
t))Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w) Double
y Double
dw Double
h
WipeDirection
WipeTop -> Double -> Double -> Double -> Double -> Rect
Rect Double
x Double
y Double
w Double
dh
WipeDirection
WipeBottom -> Double -> Double -> Double -> Double -> Rect
Rect Double
x (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+(Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-(Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
step Double
t))Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
h) Double
w Double
dh
WipeDirection
WipeDoorH -> Double -> Double -> Double -> Double -> Rect
Rect Double
dx Double
y Double
dw Double
h
WipeDirection
WipeDoorV -> Double -> Double -> Double -> Double -> Rect
Rect Double
x Double
dy Double
w Double
dh
WipeDirection
WipeRect -> Double -> Double -> Double -> Double -> Rect
Rect Double
dx Double
dy Double
dw Double
dh
(Double
dx, Double
dy) = (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+(Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-(Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
step Double
t))Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2, Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+(Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-(Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
step Double
t))Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
(Double
dw, Double
dh) = ((Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
step Double
t)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w, (Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
step Double
t)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
h)
step :: a -> a
step a
t = if Bool
isWipeIn
then a -> a
forall {a}. (Ord a, Fractional a) => a -> a
fwdStep a
t
else a
1a -> a -> a
forall a. Num a => a -> a -> a
-(a -> a
forall {a}. (Ord a, Fractional a) => a -> a
fwdStep a
t)
fwdStep :: a -> a
fwdStep a
t = a -> a -> a -> a
forall a. Ord a => a -> a -> a -> a
clamp a
0 a
1 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
ta -> a -> a
forall a. Fractional a => a -> a -> a
/(Millisecond -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Millisecond
dur)
dir :: WipeDirection
dir = WipeDirection -> Maybe WipeDirection -> WipeDirection
forall a. a -> Maybe a -> a
fromMaybe WipeDirection
WipeLeft Maybe WipeDirection
_wpcDirection
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
_wpcTransformCfg
WipeCfg{Maybe WipeDirection
TransformCfg s e
_wpcDirection :: forall s e. WipeCfg s e -> Maybe WipeDirection
_wpcTransformCfg :: forall s e. WipeCfg s e -> TransformCfg s e
_wpcTransformCfg :: TransformCfg s e
_wpcDirection :: Maybe WipeDirection
..} = [WipeCfg s e] -> WipeCfg s e
forall a. Monoid a => [a] -> a
mconcat [WipeCfg s e]
configs