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

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

Messages:

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

module Monomer.Widgets.Animation.Slide (
  -- * Configuration
  SlideCfg,
  -- * Constructors
  animSlideIn,
  animSlideIn_,
  animSlideOut,
  animSlideOut_,
  slideLeft,
  slideRight,
  slideTop,
  slideBottom
) where

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

import qualified Data.Sequence as Seq

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

import qualified Monomer.Lens as L

data SlideDirection
  = SlideLeft
  | SlideRight
  | SlideUp
  | SlideDown
  deriving (SlideDirection -> SlideDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlideDirection -> SlideDirection -> Bool
$c/= :: SlideDirection -> SlideDirection -> Bool
== :: SlideDirection -> SlideDirection -> Bool
$c== :: SlideDirection -> SlideDirection -> Bool
Eq, Int -> SlideDirection -> ShowS
[SlideDirection] -> ShowS
SlideDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlideDirection] -> ShowS
$cshowList :: [SlideDirection] -> ShowS
show :: SlideDirection -> String
$cshow :: SlideDirection -> String
showsPrec :: Int -> SlideDirection -> ShowS
$cshowsPrec :: Int -> SlideDirection -> ShowS
Show)

{-|
Configuration options for slide:

- '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.
- Individual combinators for direction.
-}
data SlideCfg e = SlideCfg {
  forall e. SlideCfg e -> Maybe SlideDirection
_slcDirection :: Maybe SlideDirection,
  forall e. SlideCfg e -> Maybe Bool
_slcAutoStart :: Maybe Bool,
  forall e. SlideCfg e -> Maybe Millisecond
_slcDuration :: Maybe Millisecond,
  forall e. SlideCfg e -> [e]
_slcOnFinished :: [e]
} deriving (SlideCfg e -> SlideCfg e -> Bool
forall e. Eq e => SlideCfg e -> SlideCfg e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlideCfg e -> SlideCfg e -> Bool
$c/= :: forall e. Eq e => SlideCfg e -> SlideCfg e -> Bool
== :: SlideCfg e -> SlideCfg e -> Bool
$c== :: forall e. Eq e => SlideCfg e -> SlideCfg e -> Bool
Eq, Int -> SlideCfg e -> ShowS
forall e. Show e => Int -> SlideCfg e -> ShowS
forall e. Show e => [SlideCfg e] -> ShowS
forall e. Show e => SlideCfg e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlideCfg e] -> ShowS
$cshowList :: forall e. Show e => [SlideCfg e] -> ShowS
show :: SlideCfg e -> String
$cshow :: forall e. Show e => SlideCfg e -> String
showsPrec :: Int -> SlideCfg e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> SlideCfg e -> ShowS
Show)

instance Default (SlideCfg e) where
  def :: SlideCfg e
def = SlideCfg {
    _slcDirection :: Maybe SlideDirection
_slcDirection = forall a. Maybe a
Nothing,
    _slcAutoStart :: Maybe Bool
_slcAutoStart = forall a. Maybe a
Nothing,
    _slcDuration :: Maybe Millisecond
_slcDuration = forall a. Maybe a
Nothing,
    _slcOnFinished :: [e]
_slcOnFinished = []
  }

instance Semigroup (SlideCfg e) where
  <> :: SlideCfg e -> SlideCfg e -> SlideCfg e
(<>) SlideCfg e
fc1 SlideCfg e
fc2 = SlideCfg {
    _slcDirection :: Maybe SlideDirection
_slcDirection = forall e. SlideCfg e -> Maybe SlideDirection
_slcDirection SlideCfg e
fc2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e. SlideCfg e -> Maybe SlideDirection
_slcDirection SlideCfg e
fc1,
    _slcAutoStart :: Maybe Bool
_slcAutoStart = forall e. SlideCfg e -> Maybe Bool
_slcAutoStart SlideCfg e
fc2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e. SlideCfg e -> Maybe Bool
_slcAutoStart SlideCfg e
fc1,
    _slcDuration :: Maybe Millisecond
_slcDuration = forall e. SlideCfg e -> Maybe Millisecond
_slcDuration SlideCfg e
fc2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e. SlideCfg e -> Maybe Millisecond
_slcDuration SlideCfg e
fc1,
    _slcOnFinished :: [e]
_slcOnFinished = forall e. SlideCfg e -> [e]
_slcOnFinished SlideCfg e
fc1 forall a. Semigroup a => a -> a -> a
<> forall e. SlideCfg e -> [e]
_slcOnFinished SlideCfg e
fc2
  }

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

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

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

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

-- | Slide from/to left.
slideLeft :: SlideCfg e
slideLeft :: forall e. SlideCfg e
slideLeft = forall a. Default a => a
def { _slcDirection :: Maybe SlideDirection
_slcDirection = forall a. a -> Maybe a
Just SlideDirection
SlideLeft }

-- | Slide from/to right.
slideRight :: SlideCfg e
slideRight :: forall e. SlideCfg e
slideRight = forall a. Default a => a
def { _slcDirection :: Maybe SlideDirection
_slcDirection = forall a. a -> Maybe a
Just SlideDirection
SlideRight }

-- | Slide from/to top.
slideTop :: SlideCfg e
slideTop :: forall e. SlideCfg e
slideTop = forall a. Default a => a
def { _slcDirection :: Maybe SlideDirection
_slcDirection = forall a. a -> Maybe a
Just SlideDirection
SlideUp }

-- | Slide from/to bottom.
slideBottom :: SlideCfg e
slideBottom :: forall e. SlideCfg e
slideBottom = forall a. Default a => a
def { _slcDirection :: Maybe SlideDirection
_slcDirection = forall a. a -> Maybe a
Just SlideDirection
SlideDown }

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

instance Default SlideState where
  def :: SlideState
def = SlideState {
    _slsRunning :: Bool
_slsRunning = Bool
False,
    _slsStartTs :: Millisecond
_slsStartTs = Millisecond
0
  }

-- | Animates a widget from the left to fully visible.
animSlideIn :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
animSlideIn :: forall e s. WidgetEvent e => WidgetNode s e -> WidgetNode s e
animSlideIn WidgetNode s e
managed = forall e s.
WidgetEvent e =>
[SlideCfg e] -> WidgetNode s e -> WidgetNode s e
animSlideIn_ forall a. Default a => a
def WidgetNode s e
managed

-- | Animates a widget from the provided direction to fully visible (defaults
--   to left). Accepts config.
animSlideIn_ :: WidgetEvent e => [SlideCfg e] -> WidgetNode s e -> WidgetNode s e
animSlideIn_ :: forall e s.
WidgetEvent e =>
[SlideCfg e] -> WidgetNode s e -> WidgetNode s e
animSlideIn_ [SlideCfg e]
configs WidgetNode s e
managed = forall e s.
WidgetEvent e =>
WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode WidgetType
"animSlideIn" forall {s}. Widget s e
widget WidgetNode s e
managed where
  config :: SlideCfg e
config = forall a. Monoid a => [a] -> a
mconcat [SlideCfg e]
configs
  widget :: Widget s e
widget = forall e s.
WidgetEvent e =>
Bool -> SlideCfg e -> SlideState -> Widget s e
makeSlide Bool
True SlideCfg e
config forall a. Default a => a
def

-- | Animates a widget to the left from visible to not visible.
animSlideOut :: WidgetEvent e => WidgetNode s e -> WidgetNode s e
animSlideOut :: forall e s. WidgetEvent e => WidgetNode s e -> WidgetNode s e
animSlideOut WidgetNode s e
managed = forall e s.
WidgetEvent e =>
[SlideCfg e] -> WidgetNode s e -> WidgetNode s e
animSlideOut_ forall a. Default a => a
def WidgetNode s e
managed

-- | Animates a widget to the the provided direction from visible to not
--   visible (defaults to left). Accepts config.
animSlideOut_ :: WidgetEvent e => [SlideCfg e] -> WidgetNode s e -> WidgetNode s e
animSlideOut_ :: forall e s.
WidgetEvent e =>
[SlideCfg e] -> WidgetNode s e -> WidgetNode s e
animSlideOut_ [SlideCfg e]
configs WidgetNode s e
managed = forall e s.
WidgetEvent e =>
WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode WidgetType
"animSlideOut" forall {s}. Widget s e
widget WidgetNode s e
managed where
  config :: SlideCfg e
config = forall a. Monoid a => [a] -> a
mconcat [SlideCfg e]
configs
  widget :: Widget s e
widget = forall e s.
WidgetEvent e =>
Bool -> SlideCfg e -> SlideState -> Widget s e
makeSlide Bool
False SlideCfg e
config forall a. Default a => a
def

makeNode
  :: WidgetEvent e => WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: forall e s.
WidgetEvent e =>
WidgetType -> Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode WidgetType
wType Widget s e
widget WidgetNode s e
managedWidget = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
wType Widget s e
widget
  forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
  forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Seq a
Seq.singleton WidgetNode s e
managedWidget

makeSlide :: WidgetEvent e => Bool -> SlideCfg e -> SlideState -> Widget s e
makeSlide :: forall e s.
WidgetEvent e =>
Bool -> SlideCfg e -> SlideState -> Widget s e
makeSlide Bool
isSlideIn SlideCfg e
config SlideState
state = forall {s}. Widget s e
widget where
  widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer SlideState
state forall a. Default a => a
def {
    containerUseScissor :: Bool
containerUseScissor = Bool
True,
    containerInit :: ContainerInitHandler s e
containerInit = forall {p} {s}.
HasTimestamp p Millisecond =>
p -> WidgetNode s e -> WidgetResult s e
init,
    containerMerge :: ContainerMergeHandler s e SlideState
containerMerge = forall {p} {s} {p}.
p -> WidgetNode s e -> p -> SlideState -> WidgetResult s e
merge,
    containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = forall {p} {p} {s} {p}.
(Typeable p, HasTimestamp p Millisecond) =>
p -> WidgetNode s e -> p -> p -> Maybe (WidgetResult s e)
handleMessage,
    containerRender :: ContainerRenderHandler s e
containerRender = forall {p} {p} {a} {a}.
(HasTimestamp p Millisecond, HasInfo p a, HasViewport a a,
 HasW a Double, HasH a Double) =>
p -> p -> Renderer -> IO ()
render,
    containerRenderAfter :: ContainerRenderHandler s e
containerRenderAfter = forall {p} {p}. p -> p -> Renderer -> IO ()
renderPost
  }

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

  finishedReq :: WidgetNode s e -> WidgetRequest s e
finishedReq WidgetNode s e
node = 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 -> p -> WidgetRequest s e
renderReq p
wenv p
node = forall {s} {e}. WidgetRequest s e
req where
    widgetId :: WidgetId
widgetId = p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
    req :: WidgetRequest s e
req = forall s e.
WidgetId -> Millisecond -> Maybe Int -> WidgetRequest s e
RenderEvery WidgetId
widgetId Millisecond
period (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 forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SlideCfg e -> SlideState -> Widget s e
makeSlide Bool
isSlideIn SlideCfg e
config (Bool -> Millisecond -> SlideState
SlideState Bool
True Millisecond
ts)
    result :: WidgetResult s e
result
      | Bool
autoStart = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [forall {s} {e}. WidgetNode s e -> WidgetRequest s e
finishedReq WidgetNode s e
node, forall {p} {a} {p} {s} {e}.
(HasInfo p a, HasWidgetId a WidgetId) =>
p -> p -> WidgetRequest s e
renderReq p
wenv WidgetNode s e
node]
      | Bool
otherwise = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

  merge :: p -> WidgetNode s e -> p -> SlideState -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode SlideState
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
    newNode :: WidgetNode s e
newNode = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SlideCfg e -> SlideState -> Widget s e
makeSlide Bool
isSlideIn SlideCfg e
config SlideState
oldState

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

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

    newNode :: SlideState -> WidgetNode s e
newNode SlideState
newState = WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SlideCfg e -> SlideState -> Widget s e
makeSlide Bool
isSlideIn SlideCfg e
config SlideState
newState
    result :: WidgetResult s e
result = case AnimationMsg
msg of
      AnimationMsg
AnimationStart -> forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs (forall {s}.
HasWidget (WidgetNode s e) (Widget s e) =>
SlideState -> WidgetNode s e
newNode SlideState
startState) [WidgetRequest s e]
startReqs
      AnimationMsg
AnimationStop -> forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs (forall {s}.
HasWidget (WidgetNode s e) (Widget s e) =>
SlideState -> WidgetNode s e
newNode forall a. Default a => a
def) [forall s e. WidgetId -> WidgetRequest s e
RenderStop WidgetId
widgetId]
      AnimationMsg
AnimationFinished
        | SlideState -> Bool
_slsRunning SlideState
state -> forall e s. Typeable e => WidgetNode s e -> [e] -> WidgetResult s e
resultEvts WidgetNode s e
node (forall e. SlideCfg e -> [e]
_slcOnFinished SlideCfg e
config)
        | Bool
otherwise -> forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

  render :: p -> p -> Renderer -> IO ()
render p
wenv p
node Renderer
renderer = do
    Renderer -> IO ()
saveContext Renderer
renderer
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
running forall a b. (a -> b) -> a -> b
$
      Renderer -> Point -> IO ()
setTranslation Renderer
renderer (Double -> Double -> Point
Point Double
offsetX Double
offsetY)
    where
      viewport :: a
viewport = p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
      ts :: Millisecond
ts = p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
      dir :: SlideDirection
dir = forall a. a -> Maybe a -> a
fromMaybe SlideDirection
SlideLeft (forall e. SlideCfg e -> Maybe SlideDirection
_slcDirection SlideCfg e
config)

      bwdStep :: Double
bwdStep = forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
1 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Millisecond
ts forall a. Num a => a -> a -> a
- Millisecond
start) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Millisecond
duration
      fwdStep :: Double
fwdStep = Double
1 forall a. Num a => a -> a -> a
- Double
bwdStep

      offsetX :: Double
offsetX
        | SlideDirection
dir forall a. Eq a => a -> a -> Bool
== SlideDirection
SlideLeft Bool -> Bool -> Bool
&& Bool
isSlideIn = -Double
1 forall a. Num a => a -> a -> a
* Double
fwdStep forall a. Num a => a -> a -> a
* a
viewport forall s a. s -> Getting a s a -> a
^. forall s a. HasW s a => Lens' s a
L.w
        | SlideDirection
dir forall a. Eq a => a -> a -> Bool
== SlideDirection
SlideLeft = -Double
1 forall a. Num a => a -> a -> a
* Double
bwdStep forall a. Num a => a -> a -> a
* a
viewport forall s a. s -> Getting a s a -> a
^. forall s a. HasW s a => Lens' s a
L.w
        | SlideDirection
dir forall a. Eq a => a -> a -> Bool
== SlideDirection
SlideRight Bool -> Bool -> Bool
&& Bool
isSlideIn = Double
fwdStep forall a. Num a => a -> a -> a
* a
viewport forall s a. s -> Getting a s a -> a
^. forall s a. HasW s a => Lens' s a
L.w
        | SlideDirection
dir forall a. Eq a => a -> a -> Bool
== SlideDirection
SlideRight = Double
bwdStep forall a. Num a => a -> a -> a
* a
viewport forall s a. s -> Getting a s a -> a
^. forall s a. HasW s a => Lens' s a
L.w
        | Bool
otherwise = Double
0
      offsetY :: Double
offsetY
        | SlideDirection
dir forall a. Eq a => a -> a -> Bool
== SlideDirection
SlideUp Bool -> Bool -> Bool
&& Bool
isSlideIn = -Double
1 forall a. Num a => a -> a -> a
* Double
fwdStep forall a. Num a => a -> a -> a
* a
viewport forall s a. s -> Getting a s a -> a
^. forall s a. HasH s a => Lens' s a
L.h
        | SlideDirection
dir forall a. Eq a => a -> a -> Bool
== SlideDirection
SlideUp = -Double
1 forall a. Num a => a -> a -> a
* Double
bwdStep forall a. Num a => a -> a -> a
* a
viewport forall s a. s -> Getting a s a -> a
^. forall s a. HasH s a => Lens' s a
L.h
        | SlideDirection
dir forall a. Eq a => a -> a -> Bool
== SlideDirection
SlideDown Bool -> Bool -> Bool
&& Bool
isSlideIn = Double
fwdStep forall a. Num a => a -> a -> a
* a
viewport forall s a. s -> Getting a s a -> a
^. forall s a. HasH s a => Lens' s a
L.h
        | SlideDirection
dir forall a. Eq a => a -> a -> Bool
== SlideDirection
SlideDown = Double
bwdStep forall a. Num a => a -> a -> a
* a
viewport forall s a. s -> Getting a s a -> a
^. forall s a. HasH s a => Lens' s a
L.h
        | Bool
otherwise = Double
0

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