1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
-- |
-- 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 = mkPure $ \_ x -> (Left mempty, loop x)
where
loop x' =
mkPure $ \ds x ->
let dt = realToFrac (dtime ds)
dx = (x - x') / dt
mdx | isNaN dx = Right 0
| isInfinite dx = Left mempty
| otherwise = Right dx
in mdx `seq` (mdx, loop 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 x' =
mkPure $ \ds dx ->
let dt = realToFrac (dtime ds)
in x' `seq` (Right x', integral (x' + dt*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 correct = loop
where
loop x' =
mkPure $ \ds (dx, w) ->
let dt = realToFrac (dtime ds)
x = correct w (x' + dt*dx)
in x' `seq` (Right x', loop x)
|
