Netwire 5 - A box cannot bounce

Question

I am trying to convert challenge 3 ( https://ocharles.org.uk/blog/posts/2013-08-01-getting-started-with-netwire-and-sdl.html ) from netwire 4.0 to netwire 5.0 using OpenGL. Unfortunately, the box cannot bounce. The entire code is following. It seems to me that the function velocity does not work. When the box collides with a wall, it does not bounce but stops. How do I correct my program? Thanks in advance.

{-# LANGUAGE Arrows #-}
import Graphics.Rendering.OpenGL 
import Graphics.UI.GLFW 
import Data.IORef 
import Prelude hiding ((.)) 
import Control.Monad.Fix (MonadFix)
import Control.Wire 
import FRP.Netwire 


isKeyDown :: (Enum k, Monoid e) => k -> Wire s e IO a e 
isKeyDown k = mkGen_ $ \_ -> do 
  s <- getKey k 
  return $ case s of 
    Press -> Right mempty     
    Release -> Left mempty


acceleration :: (Monoid e) => Wire s e IO a Double
acceleration =  pure ( 0)   . isKeyDown (CharKey 'A') . isKeyDown (CharKey 'D') 
            <|> pure (-0.5) . isKeyDown (CharKey 'A') 
            <|> pure ( 0.5) . isKeyDown (CharKey 'D') 
            <|> pure ( 0) 


velocity ::  (Monad m, HasTime t s, Monoid e) => Wire s e m (Double, Bool) Double
velocity = integralWith bounce 0
             where bounce c v 
                     | c         = (-v)
                     | otherwise =  v

collided :: (Ord a, Fractional a) => (a, a) -> a -> (a, Bool)
collided (a, b) x
  | x < a = (a, True)
  | x > b = (b, True)
  | otherwise = (x, False)


position' :: (Monad m, HasTime t s) => Wire s e m Double (Double, Bool)   
position' = integral 0 >>> (arr $ collided (-0.8, 0.8))

challenge3 :: (HasTime t s) => Wire s () IO a Double 
challenge3 = proc _ -> do
  rec a <- acceleration -< ()
      v <- velocity -< (a, c)
      (p, c) <- position' -< v
  returnA -< p


s :: Double 
s = 0.05 
y :: Double 
y = 0.0 
renderPoint :: (Double, Double) -> IO () 
renderPoint (x, y) = vertex $ Vertex2 (realToFrac x :: GLfloat) (realToFrac y :: GLfloat)

generatePoints :: Double -> Double -> Double -> [(Double, Double)] 
generatePoints x y s = 
  [ (x - s, y - s) 
  , (x + s, y - s) 
  , (x + s, y + s) 
  , (x - s, y + s) ] 


runNetwork :: (HasTime t s) => IORef Bool -> Session IO s -> Wire s e IO a Double -> IO () 
runNetwork closedRef session wire = do 
  pollEvents 
  closed <- readIORef closedRef 
  if closed 
    then return () 
    else do
      (st , session') <- stepSession session 
      (wt', wire' ) <- stepWire wire st $ Right undefined 
      case wt' of 
        Left _ -> return () 
        Right x -> do 
          clear [ColorBuffer] 
          renderPrimitive Quads $ 
            mapM_ renderPoint $ generatePoints x y s 
          swapBuffers 
          runNetwork closedRef session' wire' 



main :: IO () 
main = do
  initialize 
  openWindow (Size 1024 512) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window

   closedRef <- newIORef False 
  windowCloseCallback $= do 
    writeIORef closedRef True 
    return True 
  runNetwork closedRef clockSession_ challenge3
  closeWindow

Answer 1

By experience, I think the trick here is the fact that you technically have to bounce a few pixels before the actual collision, because if you detect it when it happens, then the inertia put your square a little bit "in" the wall, and so velocity is constantly reversed, causing your square to be blocked.

Ocharles actually nods to it in the blog post :

If this position falls outside the world bounds, we adjust the square (with a small epsilon to stop it getting stuck in the wall) and return the collision information.

Good luck with Netwire 5, I'm playing with it too, and I just begin to like it. ;)