Why is this Yampa ball-bouncing going into an endless loop?

Question

I'm trying to simulate a bouncing ball with the Yampa-Framework: Given an initial x-position, height and velocity, the ball should bounce according to gravity rules. The signal function takes a "Tip-Event" as input, the idea being "when the ball is tipped, it's speed should double".

The ball bounces nicely, but every time there is a tipping event, the function goes in to an endless loop. I figured I probably need to add a delay (dSwitch, pre, notYet?), but I do not know how. Any help would be appreciated!

{-# LANGUAGE Arrows #-} 

module Ball where

import FRP.Yampa

type Position  = Double
type Velocity  = Double
type Height    = Double

data Ball = Ball {
      height :: Height,
      width  :: Position,
      vel    :: Velocity
} deriving (Show)

type Tip = Event ()

fly :: Position -> (Height, Velocity) -> SF Tip (Ball, Event (Height,Velocity))
fly w0 (h0, v0) = proc tipEvent -> do
     let tip = (tipEvent == Event ())
     v <- (v0+) ^<< integral -< -10.0
     h <- (h0+) ^<< integral -< v 
     returnA -< (Ball h w0 v, 
                 if h < 0 then Event (0,(-v*0.6)) 
                  else if tip then Event (h, (v*2))
                   else NoEvent)

bounce w (h,v) = switch (fly w (h,v)) (bounce w)   

runBounce w (h,v)  = embed (bounce 10 (100.0, 10.0)) (deltaEncode 0.1 [NoEvent, NoEvent, NoEvent, Event (), NoEvent])

EDIT: I managed to avoid the endless loop by feeding back a flag when a tip occurred, but that still does not feel like the right way to do it...

fly :: Position -> (Height, Velocity, Bool) -> SF Tip (Ball, Event (Height,Velocity,Bool))
fly w0 (h0, v0, alreadyTipped) = proc tipEvent -> do
     let tip = tipEvent == Event () && (not alreadyTipped)
     v <- (v0+) ^<< integral -< -10.0
     h <- (h0+) ^<< integral -< v 
     returnA -< (Ball h w0 v, 
                 if h < 0 then Event (0,(-v*0.6), False) 
                  else if tip then Event (h, (v*2), True)
                   else NoEvent)

bounce w (h,v,alreadyTipped) = switch (fly w (h,v,alreadyTipped)) (bounce w)   

Answer 1

After a few days hacking I think I found the answer. The trick is to use notYet to delay the switching event to the next point in time, so that the switching (and hence the recursive call to fly) occurs when the "old" tipping event is gone. The second function makes sure that only the second part of the result tuple (Ball, Event (..)) will be put through notYet. This removes the endless loop, but also changes the semantics: The switching now takes place one "time step" later, this in turn leads to a different speed.

This Yampa thing is actually quite nice, sadly there is not much documentation to find. I still could not find out what the pre and iPre functions are good for, I figure they can be used in a similar context.

fly :: Position -> (Height, Velocity) -> SF Tip (Ball, Event (Height,Velocity))
fly w0 (h0, v0) = proc tipEvent -> do
     let tip = tipEvent == Event ()
     v <- (v0+) ^<< integral -< -10.0
     h <- (h0+) ^<< integral -< v 
     returnA -< (Ball h w0 v, 
                 if h < 0 then Event (0,-v*0.6) 
                  else if tip then Event (h, v*2)
                   else NoEvent)

bounce w (h,v) = switch (fly w (h,v) >>> second notYet) (bounce w)