{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Animation.Zoom (
ZoomCfg,
animZoomIn,
animZoomIn_,
animZoomOut,
animZoomOut_
) where
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
newtype ZoomCfg s e = ZoomCfg {
forall s e. ZoomCfg s e -> TransformCfg s e
_zmcTransformCfg :: TransformCfg s e
} deriving (ZoomCfg s e -> ZoomCfg s e -> Bool
(ZoomCfg s e -> ZoomCfg s e -> Bool)
-> (ZoomCfg s e -> ZoomCfg s e -> Bool) -> Eq (ZoomCfg s e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s e. Eq e => ZoomCfg s e -> ZoomCfg s e -> Bool
$c== :: forall s e. Eq e => ZoomCfg s e -> ZoomCfg s e -> Bool
== :: ZoomCfg s e -> ZoomCfg s e -> Bool
$c/= :: forall s e. Eq e => ZoomCfg s e -> ZoomCfg s e -> Bool
/= :: ZoomCfg s e -> ZoomCfg s e -> Bool
Eq, Int -> ZoomCfg s e -> ShowS
[ZoomCfg s e] -> ShowS
ZoomCfg s e -> String
(Int -> ZoomCfg s e -> ShowS)
-> (ZoomCfg s e -> String)
-> ([ZoomCfg s e] -> ShowS)
-> Show (ZoomCfg s e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s e. Int -> ZoomCfg s e -> ShowS
forall s e. [ZoomCfg s e] -> ShowS
forall s e. ZoomCfg s e -> String
$cshowsPrec :: forall s e. Int -> ZoomCfg s e -> ShowS
showsPrec :: Int -> ZoomCfg s e -> ShowS
$cshow :: forall s e. ZoomCfg s e -> String
show :: ZoomCfg s e -> String
$cshowList :: forall s e. [ZoomCfg s e] -> ShowS
showList :: [ZoomCfg s e] -> ShowS
Show)
instance Default (ZoomCfg s e) where
def :: ZoomCfg s e
def = ZoomCfg {
_zmcTransformCfg :: TransformCfg s e
_zmcTransformCfg = TransformCfg s e
forall a. Default a => a
def
}
instance Semigroup (ZoomCfg s e) where
<> :: ZoomCfg s e -> ZoomCfg s e -> ZoomCfg s e
(<>) ZoomCfg s e
zc1 ZoomCfg s e
zc2 = ZoomCfg {
_zmcTransformCfg :: TransformCfg s e
_zmcTransformCfg = ZoomCfg s e -> TransformCfg s e
forall s e. ZoomCfg s e -> TransformCfg s e
_zmcTransformCfg ZoomCfg s e
zc1 TransformCfg s e -> TransformCfg s e -> TransformCfg s e
forall a. Semigroup a => a -> a -> a
<> ZoomCfg s e -> TransformCfg s e
forall s e. ZoomCfg s e -> TransformCfg s e
_zmcTransformCfg ZoomCfg s e
zc2
}
instance Monoid (ZoomCfg s e) where
mempty :: ZoomCfg s e
mempty = ZoomCfg s e
forall a. Default a => a
def
instance CmbAutoStart (ZoomCfg s e) where
autoStart_ :: Bool -> ZoomCfg s e
autoStart_ Bool
start = ZoomCfg Any Any
forall a. Default a => a
def {
_zmcTransformCfg = autoStart_ start
}
instance CmbDuration (ZoomCfg s e) Millisecond where
duration :: Millisecond -> ZoomCfg s e
duration Millisecond
dur = ZoomCfg Any Any
forall a. Default a => a
def {
_zmcTransformCfg = duration dur
}
instance WidgetEvent e => CmbOnFinished (ZoomCfg s e) e where
onFinished :: e -> ZoomCfg s e
onFinished e
handler = ZoomCfg Any Any
forall a. Default a => a
def {
_zmcTransformCfg = onFinished handler
}
instance CmbOnFinishedReq (ZoomCfg s e) s e where
onFinishedReq :: WidgetRequest s e -> ZoomCfg s e
onFinishedReq WidgetRequest s e
req = ZoomCfg Any Any
forall a. Default a => a
def {
_zmcTransformCfg = onFinishedReq req
}
animZoomIn
:: WidgetEvent e
=> WidgetNode s e
-> WidgetNode s e
animZoomIn :: forall e s. WidgetEvent e => WidgetNode s e -> WidgetNode s e
animZoomIn WidgetNode s e
managed = [ZoomCfg s e] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[ZoomCfg s e] -> WidgetNode s e -> WidgetNode s e
animZoomIn_ [ZoomCfg s e]
forall a. Default a => a
def WidgetNode s e
managed
animZoomIn_
:: WidgetEvent e
=> [ZoomCfg s e]
-> WidgetNode s e
-> WidgetNode s e
animZoomIn_ :: forall e s.
WidgetEvent e =>
[ZoomCfg s e] -> WidgetNode s e -> WidgetNode s e
animZoomIn_ [ZoomCfg s e]
configs WidgetNode s e
managed = [ZoomCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
forall e s.
WidgetEvent e =>
[ZoomCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [ZoomCfg 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
"animZoomIn"
animZoomOut
:: WidgetEvent e
=> WidgetNode s e
-> WidgetNode s e
animZoomOut :: forall e s. WidgetEvent e => WidgetNode s e -> WidgetNode s e
animZoomOut WidgetNode s e
managed = [ZoomCfg s e] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[ZoomCfg s e] -> WidgetNode s e -> WidgetNode s e
animZoomOut_ [ZoomCfg s e]
forall a. Default a => a
def WidgetNode s e
managed
animZoomOut_
:: WidgetEvent e
=> [ZoomCfg s e]
-> WidgetNode s e
-> WidgetNode s e
animZoomOut_ :: forall e s.
WidgetEvent e =>
[ZoomCfg s e] -> WidgetNode s e -> WidgetNode s e
animZoomOut_ [ZoomCfg s e]
configs WidgetNode s e
managed = [ZoomCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
forall e s.
WidgetEvent e =>
[ZoomCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [ZoomCfg 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
"animZoomOut"
makeNode
:: WidgetEvent e
=> [ZoomCfg s e]
-> WidgetNode s e
-> Bool
-> WidgetNode s e
makeNode :: forall e s.
WidgetEvent e =>
[ZoomCfg s e] -> WidgetNode s e -> Bool -> WidgetNode s e
makeNode [ZoomCfg s e]
configs WidgetNode s e
managed Bool
isZoomIn = 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
_zmcTransformCfg] Transformer
f WidgetNode s e
managed
f :: Transformer
f Double
t (Rect Double
_ Double
_ Double
w Double
h) =
[ Point -> RenderTransform
animTranslation (Point -> RenderTransform) -> Point -> RenderTransform
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point (Double -> Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a -> a
ft Double
t Double
w) (Double -> Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a -> a
ft Double
t Double
h)
, Point -> RenderTransform
animScale (Point -> RenderTransform) -> Point -> RenderTransform
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point (Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
fs Double
t) (Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
fs Double
t)
]
ft :: a -> a -> a
ft a
t a
s = (a
1a -> a -> a
forall a. Num a => a -> a -> a
-(a -> a
forall {a}. (Ord a, Fractional a) => a -> a
fs a
t))a -> a -> a
forall a. Num a => a -> a -> a
*a
sa -> a -> a
forall a. Fractional a => a -> a -> a
/a
2
fs :: a -> a
fs a
t = if Bool
isZoomIn
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)
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
_zmcTransformCfg
ZoomCfg{TransformCfg s e
_zmcTransformCfg :: forall s e. ZoomCfg s e -> TransformCfg s e
_zmcTransformCfg :: TransformCfg s e
..} = [ZoomCfg s e] -> ZoomCfg s e
forall a. Monoid a => [a] -> a
mconcat [ZoomCfg s e]
configs