[Haskell-cafe] Netwire bouncing ball

Just haskell at justnothing.org
Wed Jul 10 23:15:33 CEST 2013


Hello,

I'm trying to get a grasp of netwire by implementing a bouncing ball 
simulation and I'm failing.
The ball starts from the ground with a given velocity and when hitting 
the ground the wire inhibits successfully. Now I'm kinda stuck.

How can I make the ball bounce?


Here is the code:

{-# LANGUAGE Arrows #-}

module Main where

import Control.Wire
import Prelude hiding ((.), id)
import Control.Concurrent

type Pos = Double
type Vel = Double
type ObjState = (Pos, Vel)

testApp :: Pos -> Vel -> WireP () ObjState
testApp p0 v0 = proc _ -> do
     v <- integral_ v0 -< -9.81
     p <- integral1_ p0 -< v
     when (>= 0) -< p
     returnA -< (p, v)

main :: IO ()
main = loop' (testApp 0 30) clockSession
     where
     loop' w' session' = do
         threadDelay 1000000
         (mx, w, session) <- stepSessionP w' session' ()
         case mx of
             Left ex -> putStrLn ("Inhibited: " ++ show ex)
             Right x -> putStrLn ("Produced: " ++ show x)
         loop' w session

Thanks in advance!



More information about the Haskell-Cafe mailing list