-- |
-- Module:     FRP.Netwire.Move
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

module FRP.Netwire.Move
    ( -- * Calculus
      derivative,
      integral,
      integralWith
    )
    where

import Control.Wire


-- | Time derivative of the input signal.
--
-- * Depends: now.
--
-- * Inhibits: at singularities.

derivative ::
    (RealFloat a, HasTime t s, Monoid e)
    => Wire s e m a a
derivative :: forall a t s e (m :: * -> *).
(RealFloat a, HasTime t s, Monoid e) =>
Wire s e m a a
derivative = (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a)
-> (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \s
_ a
x -> (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, a -> Wire s e m a a
forall {s} {a} {b} {e} {m :: * -> *}.
(HasTime a s, RealFloat b, Monoid e) =>
b -> Wire s e m b b
loop a
x)
    where
    loop :: b -> Wire s e m b b
loop b
x' =
        (s -> b -> (Either e b, Wire s e m b b)) -> Wire s e m b b
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> b -> (Either e b, Wire s e m b b)) -> Wire s e m b b)
-> (s -> b -> (Either e b, Wire s e m b b)) -> Wire s e m b b
forall a b. (a -> b) -> a -> b
$ \s
ds b
x ->
            let dt :: b
dt  = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> a
forall t s. HasTime t s => s -> t
dtime s
ds)
                dx :: b
dx  = (b
x b -> b -> b
forall a. Num a => a -> a -> a
- b
x') b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
dt
                mdx :: Either e b
mdx | b -> Bool
forall a. RealFloat a => a -> Bool
isNaN b
dx      = b -> Either e b
forall a b. b -> Either a b
Right b
0
                    | b -> Bool
forall a. RealFloat a => a -> Bool
isInfinite b
dx = e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
                    | Bool
otherwise     = b -> Either e b
forall a b. b -> Either a b
Right b
dx
            in Either e b
mdx Either e b
-> (Either e b, Wire s e m b b) -> (Either e b, Wire s e m b b)
`seq` (Either e b
mdx, b -> Wire s e m b b
loop b
x)


-- | Integrate the input signal over time.
--
-- * Depends: before now.

integral ::
    (Fractional a, HasTime t s)
    => a  -- ^ Integration constant (aka start value).
    -> Wire s e m a a
integral :: forall a t s e (m :: * -> *).
(Fractional a, HasTime t s) =>
a -> Wire s e m a a
integral a
x' =
    (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a)
-> (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \s
ds a
dx ->
        let dt :: a
dt = t -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> t
forall t s. HasTime t s => s -> t
dtime s
ds)
        in a
x' a -> (Either e a, Wire s e m a a) -> (Either e a, Wire s e m a a)
`seq` (a -> Either e a
forall a b. b -> Either a b
Right a
x', a -> Wire s e m a a
forall a t s e (m :: * -> *).
(Fractional a, HasTime t s) =>
a -> Wire s e m a a
integral (a
x' a -> a -> a
forall a. Num a => a -> a -> a
+ a
dta -> a -> a
forall a. Num a => a -> a -> a
*a
dx))


-- | Integrate the left input signal over time, but apply the given
-- correction function to it.  This can be used to implement collision
-- detection/reaction.
--
-- The right signal of type @w@ is the /world value/.  It is just passed
-- to the correction function for reference and is not used otherwise.
--
-- The correction function must be idempotent with respect to the world
-- value: @f w (f w x) = f w x@.  This is necessary and sufficient to
-- protect time continuity.
--
-- * Depends: before now.

integralWith ::
    (Fractional a, HasTime t s)
    => (w -> a -> a)  -- ^ Correction function.
    -> a              -- ^ Integration constant (aka start value).
    -> Wire s e m (a, w) a
integralWith :: forall a t s w e (m :: * -> *).
(Fractional a, HasTime t s) =>
(w -> a -> a) -> a -> Wire s e m (a, w) a
integralWith w -> a -> a
correct = a -> Wire s e m (a, w) a
forall {s} {a} {e} {m :: * -> *}.
HasTime a s =>
a -> Wire s e m (a, w) a
loop
    where
    loop :: a -> Wire s e m (a, w) a
loop a
x' =
        (s -> (a, w) -> (Either e a, Wire s e m (a, w) a))
-> Wire s e m (a, w) a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> (a, w) -> (Either e a, Wire s e m (a, w) a))
 -> Wire s e m (a, w) a)
-> (s -> (a, w) -> (Either e a, Wire s e m (a, w) a))
-> Wire s e m (a, w) a
forall a b. (a -> b) -> a -> b
$ \s
ds (a
dx, w
w) ->
            let dt :: a
dt = a -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> a
forall t s. HasTime t s => s -> t
dtime s
ds)
                x :: a
x  = w -> a -> a
correct w
w (a
x' a -> a -> a
forall a. Num a => a -> a -> a
+ a
dta -> a -> a
forall a. Num a => a -> a -> a
*a
dx)
            in a
x' a
-> (Either e a, Wire s e m (a, w) a)
-> (Either e a, Wire s e m (a, w) a)
`seq` (a -> Either e a
forall a b. b -> Either a b
Right a
x', a -> Wire s e m (a, w) a
loop a
x)