module Control.Wire.Prefab.Move
(
integral,
integral_,
integralLim,
integralLim_,
integral1,
integral1_,
integralLim1,
integralLim1_,
derivative,
derivative_,
object,
object_,
ObjectState(..),
ObjectDiff(..)
)
where
import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Wire.Prefab.Accum
import Control.Wire.Prefab.Time
import Control.Wire.Wire
import Data.Data
import Data.VectorSpace
import Prelude hiding ((.), id)
data ObjectState a =
ObjectState {
objPosition :: a,
objVelocity :: a
}
deriving (Data, Eq, Ord, Read, Show, Typeable)
data ObjectDiff a
= Accelerate a
| Position a
| Velocity a
deriving (Data, Eq, Ord, Read, Show, Typeable)
derivative ::
(Eq dt, Fractional dt, VectorSpace b, Scalar b ~ dt)
=> (b -> dt -> b)
-> b
-> Wire e m (b, dt) b
derivative catch x0 =
mkPure $ \_ (x1, dt) ->
let dx = x1 ^-^ x0
d | dt == 0 = catch dx dt
| otherwise = dx ^/ dt
in (Right d, derivative catch x1)
derivative_ ::
(Monad m, VectorSpace b, Scalar b ~ Time)
=> (b -> Time -> b)
-> b
-> Wire e m b b
derivative_ catch x0 = derivative catch x0 . (id &&& dtime)
integral ::
(VectorSpace b)
=> b
-> Wire e m (b, Scalar b) b
integral = accum (\x (dx, dt) -> x ^+^ dt *^ dx)
integral1 ::
(VectorSpace b)
=> b
-> Wire e m (b, Scalar b) b
integral1 = accum1 (\x (dx, dt) -> x ^+^ dt *^ dx)
integral_ ::
(VectorSpace b, Scalar b ~ Time)
=> b
-> Wire e m b b
integral_ = accumT (\dt x dx -> x ^+^ dt *^ dx)
integral1_ ::
(Monad m, VectorSpace b, Scalar b ~ Time)
=> b
-> Wire e m b b
integral1_ = accumT1 (\dt x dx -> x ^+^ dt *^ dx)
integralLim ::
(VectorSpace b)
=> (w -> b -> b -> b)
-> b
-> Wire e m ((b, w), Scalar b) b
integralLim uf = accum (\x ((dx, w), dt) -> uf w x (x ^+^ dt *^ dx))
integralLim1 ::
(VectorSpace b)
=> (w -> b -> b -> b)
-> b
-> Wire e m ((b, w), Scalar b) b
integralLim1 uf = accum1 (\x ((dx, w), dt) -> uf w x (x ^+^ dt *^ dx))
integralLim_ ::
(VectorSpace b, Scalar b ~ Time)
=> (w -> b -> b -> b)
-> b
-> Wire e m (b, w) b
integralLim_ uf = accumT (\dt x (dx, w) -> uf w x (x ^+^ dt *^ dx))
integralLim1_ ::
(VectorSpace b, Scalar b ~ Time)
=> (w -> b -> b -> b)
-> b
-> Wire e m (b, w) b
integralLim1_ uf = accumT1 (\dt x (dx, w) -> uf w x (x ^+^ dt *^ dx))
object ::
forall b m dt e w.
(VectorSpace b, Scalar b ~ dt)
=> (w -> ObjectState b -> ObjectState b)
-> ObjectState b
-> Wire e m (ObjectDiff b, w, dt) (ObjectState b)
object uf = loop
where
applyDiff :: dt -> ObjectDiff b -> ObjectState b -> ObjectState b
applyDiff dt (Accelerate dv) (ObjectState x' v') = ObjectState x v
where
v = v' ^+^ dt *^ dv
x = x' ^+^ dt *^ v
applyDiff _ (Position x) (ObjectState _ v) = ObjectState x v
applyDiff dt (Velocity v) (ObjectState x' _) = ObjectState (x' ^+^ dt *^ v) v
loop :: ObjectState b -> Wire e m (ObjectDiff b, w, dt) (ObjectState b)
loop os' =
mkPure $ \_ (dos, w, dt) ->
let os = uf w . applyDiff dt dos $ os'
in (Right os, loop os)
object_ ::
(Monad m, VectorSpace b, Scalar b ~ Time)
=> (w -> ObjectState b -> ObjectState b)
-> ObjectState b
-> Wire e m (ObjectDiff b, w) (ObjectState b)
object_ uf x0 = object uf x0 . liftA2 (\(dx, w) dt -> (dx, w, dt)) id dtime