I have bouncing balls balls working now (code below). It uses scanlB instead of a recursive behavior. Here's the ugliest part, and I'd love to hear suggestions about it: scanlB const beh ((\((_x,_v),t) -> bounce xLow xLow (12) t) <$> collisions xLow event beh) Ideally, I'd like to pass the next 'bounce' variables 'x' and '-v' from the previous behavior instead of 'xLow' and '12', but because 'x' is below 'xLow', it triggers a collision. If I pass 'xLow' and '-v', then the balls bounce higher and higher from the extra speed gained between 'xLow' and 'x'. So I need to either figure out a way to filter collisions until 'x' is above 'xLow' again, or start bounce at 'xLow' and figure out what the velocity would have been at that position. The next ugliest line is this: event = withTimeE_ (atTimes (map (t0+) [0,0.01..])) Should I be using 'framePass' here? import Data.Monoid import Control.Applicative import FRP.Reactive import FRP.Reactive.GLUT.Adapter import Graphics.FieldTrip import FRP.Reactive.FieldTrip.Adapter main :: IO () main = anim3 $ \ui -> drops_ 0.25 lilRedBall (leftButtonPressed ui) `mappend` drops_ 0.5 lilGreenBall (leftButtonPressed ui) lilRedBall :: Double -> Geometry3 lilRedBall sz = lilThing red (-1) sz (flatG udisk) lilGreenBall :: Double -> Geometry3 lilGreenBall sz = lilThing green 1 sz (flatG udisk) lilThing :: Col -> Double -> Double -> Geometry3 -> Geometry3 lilThing color x sz = materialG (flat color) . (translate3 (Vector3 x 0 0) *%) . (uscale3 sz *%) drops_ :: Double -> (Double -> Geometry3) -> Event a -> Behavior Geometry3 drops_ sz g0 e = monoidB ((fmap . fmap) (object (g0 sz)) bouncing) where bouncing = bounce 0 (-2.5+sz) 0 <$> withTimeE_ e object :: Geometry3 -> (Double,Double) -> Geometry3 object g0 (pos,_y) = translate3 (Vector3 0 pos 0) *% g0 bounce :: Double -> Double -> Double -> TimeT -> Behavior (Double, Double) bounce x0 xLow v0 t0 = scanlB const beh ((\((_x,_v),t) -> bounce xLow xLow (12) t) <$> collisions xLow event beh) where event = withTimeE_ (atTimes (map (t0+) [0,0.01..])) beh = fall x0 v0 t0 fall :: Double -> Double -> Double -> Behavior (Double, Double) fall x0 v0 t0 = gravity x0 v0 <$> (subtract t0 <$> time) collisions :: Double -> Event a -> Behavior (Double,Double) -> Event ((Double,Double), TimeT) collisions xLow e = withTimeE . once . filterMP (\(x,_) -> x < xLow) . snapshot_ e gravity :: Double -> Double -> TimeT -> (Double, Double) gravity x v t = (x + v * t - 9.8 * (t * t), -9.8 * t) On Fri, Nov 21, 2008 at 10:00 AM, Greg Fitzgerald <garious@gmail.com> wrote:
positionB :: Double -> Behavior Double -> Behavior Double -> Behavior Double positionB x0 v t = (x0 +) <$> liftA2 (*) v t positionB x0 v t = pure x0 + v * t
That's very convenient. I'm showing this stuff off to visual designers, so tricks like this have great Sales appeal. :)
If others are trying this out, the Num instance is implemented in FRP.Reactive.Num.
-Greg
On Fri, Nov 21, 2008 at 6:48 AM, Conal Elliott <conal@conal.net> wrote:
For that matter, you can also say, thanks to Num overloading:
positionB :: Double -> Behavior Double -> Behavior Double -> Behavior Double positionB x0 v t = pure x0 + v * t
Sadly, similar convenience does not come for free with non-methods, such as most of the FieldTrip API. For non-methods, in the past (with Fran), I've written parallel sets of modules with behavior-lifted functionality. It's tedious to set up but convenient to use. Perhaps a tool could automate the job.
By the way, a nice feature of Yampa is that it avoids this lifting business altogether, via desugaring for the arrow notation.
- Conal
On Fri, Nov 21, 2008 at 12:14 AM, Thomas Davie <tom.davie@gmail.com> wrote:
positionB :: Double -> Behavior Double -> Behavior Double -> Behavior Double positionB x0 v t = (x0 +) <$> liftA2 (*) v t
On an unrelated note, I created a package called InfixApplicative, because I found that exactly this kind of expression looked ugly in my code. If you import it, you can define this instead:
positionB x0 v t = (x0 +) <$> (v <^(*)^> t)
Hope that helps
Bob _______________________________________________ Reactive mailing list Reactive@haskell.org http://www.haskell.org/mailman/listinfo/reactive