How to implement a collision with Netwire (5.0.1) - haskell

Question

I am trying to model moving objects using Netwire and would like to know the recommended way to implement something like the bouncing of a ball off a wall. I have encountered several possible ways to do this and I need some help actually getting them to work.
The motion code looks like this:
type Pos = Float
type Vel = Float
data Collision = Collision | NoCollision
deriving (Show)
motion :: (HasTime t s, MonadFix m) => Pos -> Vel -> Wire s Collision m a Pos
motion x0 v0 = proc _ -> do
rec
v <- vel <<< delay 0 -< x
x <- pos x0 -< v
returnA -< x
pos :: (HasTime t s, MonadFix m) => Pos -> Wire s Collision m Vel Pos
pos x0 = integral x0
main :: IO ()
main = testWire clockSession_ (motion 0 5)
What is the recommended way to make a velocity arrow that causes a bounce at a certain position, eg x=20?
I have seen three different ways that I might be able to do this:
The netwire --> function which seems the simplest. I have a prototype using this function but I don't know how to make a new velocity arrow based on the velocity at the time of the collision, I can only use a fixed value which is not useful if the object can accelerate.
vel :: (HasTime t s, MonadFix m) => Wire s Collision m Pos Vel
vel = pure 5 . unless (>20) --> pure (-5)
Using the Event and switch in Netwire. I don't understand how to use this.
Using the (|||) function available to arrows in general.
The first two seem like the best options but I don't know how to implement them.
I have seen other similar questions to this but the incompatibility between different versions of netwire have made the answers not useful for me.

Answer 1

Disclaimer: I cannot comment on what is "recommended", but I can show a way that does what you want to do.
I want to describe two methods:
The first is using stateful wires, and is pretty similar to this a bit outdated tutorial from 2013, but based on Netwire 5.0.2.
The second is using stateless wires. Because they are stateless they need to be fed back their previous values, which makes the wire's input types and the final combination of the wires a bit more convoluted. Otherwise they are pretty similar.
The basic types that are involved in both examples are
type Collision = Bool
type Velocity = Float
type Position = Float
Stateful
You can model your problem with two (stateful) wires that are then combined.
One wire models the velocity, which is constant, and changes direction when a collision happens. The (simplified) type of this is Wire s e m Collision Velocity, i.e. it's input is if a collision happened and the output is the current velocity.
The other one models the position, and handles collisions. The (simplified) type of this is Wire s e m Velocity (Position, Collision), i.e. it takes a velocity, calculates the new position and returns that and if a collision happened.
Finally the velocity is fed into the position wire, and the collision result from that is fed back into the velocity wire.
Let's have a look at the details of the velocity wire:
-- stateful fixed velocity wire that switches direction when collision occurs
velocity :: Velocity -> Wire s e m Collision Velocity
velocity vel = mkPureN $ \collision ->
let nextVel = if collision then negate vel else vel
in (Right nextVel, velocity nextVel)
mkPureN creates a stateful wire that only depends on the input and its own state (not on a Monad, or time). The state is the current velocity, and the next velocity is negated if Collision=True is passed as input. The return value is a pair of the velocity value and the new wire with the new state.
For the position it is no longer sufficient to use the integral wire directly. We want an enhanced, "bounded" version of integral which makes sure that the value stays lower than an upper bound and greater than 0, and returns the information if such a collision has happened.
-- bounded integral [0, bound]
pos :: HasTime t s => Position -> Position -> Wire s e m Velocity (Position, Collision)
pos bound x = mkPure $ \ds dx ->
let dt = realToFrac (dtime ds)
nextx' = x + dt*dx -- candidate
(nextx, coll)
| nextx' <= 0 && dx < 0 = (-nextx', True)
| nextx' >= bound && dx > 0 = (bound - (nextx' - bound), True)
| otherwise = (nextx', False)
in (Right (nextx, coll), pos bound nextx)
mkPure is similar to mkPureN, but allows the wire to depend on time.
dt is the time difference.
nextx' is the new position, as it would be returned by integral.
The following lines check the bounds and return the new position, if a collision has occurred and the new wire with the new state.
Finally you feed them into each other using rec and delay. Full example:
{-# LANGUAGE Arrows #-}
module Main where
import Control.Monad.Fix
import Control.Wire
import FRP.Netwire
type Collision = Bool
type Velocity = Float
type Position = Float
-- bounded integral [0, bound]
pos :: HasTime t s => Position -> Position -> Wire s e m Velocity (Position, Collision)
pos bound x = mkPure $ \ds dx ->
let dt = realToFrac (dtime ds)
nextx' = x + dt*dx -- candidate
(nextx, coll)
| nextx' <= 0 && dx < 0 = (-nextx', True)
| nextx' >= bound && dx > 0 = (bound - (nextx' - bound), True)
| otherwise = (nextx', False)
in (Right (nextx, coll), pos bound nextx)
-- stateful fixed velocity wire that switches direction when collision occurs
velocity :: Velocity -> Wire s e m Collision Velocity
velocity vel = mkPureN $ \collision ->
let nextVel = if collision then negate vel else vel
in (Right nextVel, velocity nextVel)
run :: (HasTime t s, MonadFix m) => Position -> Velocity -> Position -> Wire s () m a Position
run start vel bound = proc _ -> do
rec
v <- velocity vel <<< delay False -< collision
(p, collision) <- pos bound start -< v
returnA -< p
main :: IO ()
main = testWire clockSession_ (run 0 5 20)
Stateless
The stateless variant is very similar to the stateful one, except that the state wanders to the input type of the wires instead of being a parameter to the functions that create the wire.
The velocity wire therefore takes a tuple (Velocity, Collision) as its input, and we can just lift a function to create it:
-- pure stateless independent from time
-- output velocity is input velocity potentially negated depending on collision
velocity :: Monad m => Wire s e m (Velocity, Collision) Velocity
velocity = arr $ \(vel, collision) -> if collision then -vel else vel
You can also use the function mkSF_ from Control.Wire.Core (and then get rid of the restriction to Monad m).
pos becomes
-- pure stateless but depending on time
-- output position is input position moved by input velocity (depending on timestep)
pos :: HasTime t s => Position -> Wire s e m (Position, Velocity) (Position, Collision)
pos bound = mkPure $ \ds (x,dx) ->
let dt = realToFrac (dtime ds)
nextx' = x + dt*dx -- candidate
(nextx, coll)
| nextx' <= 0 && dx < 0 = (-nextx', True)
| nextx' >= bound && dx > 0 = (bound - (nextx' - bound), True)
| otherwise = (nextx', False)
in (Right (nextx, coll), pos bound)
Here we still need to use mkPure, because there is no function that specifically can be used for stateless wires that depend on time.
To connect the two wire we now must feed the output of velocity into itself and the position, and from the pos wire the position into itself and the collision information into the velocity wire.
But actually with stateless wires you can also separate the "integrating" and the "bounds checking" parts of the pos wire. The pos wire then is a Wire s e m (Position, Velocity) Position that directly returns what is nextx' above, and the boundedPos wire is a Wire s e m (Position, Velocity) (Position, Collision) that gets the new position from pos and the velocity, and applies the bound check. That way the different logical parts become nicely separated.
Full example:
{-# LANGUAGE Arrows #-}
module Main where
import Control.Monad.Fix
import Control.Wire
import FRP.Netwire
type Collision = Bool
type Velocity = Float
type Position = Float
-- pure stateless but depending on time
-- output position is input position moved by input velocity (depending on timestep)
pos :: HasTime t s => Wire s e m (Position, Velocity) Position
pos = mkPure $ \ds (x,dx) ->
let dt = realToFrac (dtime ds)
in (Right (x + dt*dx), pos)
-- pure stateless independent from time
-- input position is bounced off the bounds
boundedPos :: Monad m => Position -> Wire s e m (Position, Velocity) (Position, Collision)
boundedPos bound = arr $ \(x, dx) ->
let (nextx, collision)
| x <= 0 && dx < 0 = (-x, True)
| x >= bound && dx > 0 = (bound - (x - bound), True)
| otherwise = (x, False)
in (nextx, collision)
-- pure stateless independent from time
-- output velocity is input velocity potentially negated depending on collision
velocity :: Monad m => Wire s e m (Velocity, Collision) Velocity
velocity = arr $ \(vel, collision) -> if collision then -vel else vel
-- plug the wires into each other
run :: (HasTime t s, MonadFix m) => Position -> Velocity -> Position -> Wire s () m a Position
run start vel bound = proc _ -> do
rec
v <- velocity <<< delay (vel, False) -< (v, collision)
lastPos <- delay start -< p'
p <- pos -< (lastPos, v)
(p', collision) <- boundedPos bound -< (p, v)
returnA -< p'
main :: IO ()
main = testWire clockSession_ (run 0 5 20)