[reactive] Bounce

[Greg Fitzgerald]

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 at 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 at 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 at 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 at haskell.org
>>> http://www.haskell.org/mailman/listinfo/reactive
>>
>>
>