-- |
-- 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 :: 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
$ \_ x :: 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 t e (m :: * -> *).
(HasTime a s, RealFloat t, Monoid e) =>
t -> Wire s e m t t
loop a
x)
    where
    loop :: t -> Wire s e m t t
loop x' :: t
x' =
        (s -> t -> (Either e t, Wire s e m t t)) -> Wire s e m t t
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 -> t -> (Either e t, Wire s e m t t)) -> Wire s e m t t)
-> (s -> t -> (Either e t, Wire s e m t t)) -> Wire s e m t t
forall a b. (a -> b) -> a -> b
$ \ds :: s
ds x :: t
x ->
            let dt :: t
dt  = a -> t
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> a
forall t s. HasTime t s => s -> t
dtime s
ds)
                dx :: t
dx  = (t
x t -> t -> t
forall a. Num a => a -> a -> a
- t
x') t -> t -> t
forall a. Fractional a => a -> a -> a
/ t
dt
                mdx :: Either e t
mdx | t -> Bool
forall a. RealFloat a => a -> Bool
isNaN t
dx      = t -> Either e t
forall a b. b -> Either a b
Right 0
                    | t -> Bool
forall a. RealFloat a => a -> Bool
isInfinite t
dx = e -> Either e t
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
                    | Bool
otherwise     = t -> Either e t
forall a b. b -> Either a b
Right t
dx
            in Either e t
mdx Either e t
-> (Either e t, Wire s e m t t) -> (Either e t, Wire s e m t t)
forall a b. a -> b -> b
`seq` (Either e t
mdx, t -> Wire s e m t t
loop t
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 :: a -> Wire s e m a a
integral x' :: 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
$ \ds :: s
ds dx :: 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)
forall a b. a -> b -> b
`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 :: (w -> a -> a) -> a -> Wire s e m (a, w) a
integralWith correct :: 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 x' :: 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
$ \ds :: s
ds (dx :: a
dx, w :: 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)
forall a b. a -> b -> b
`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)