tinythunk.com

I didn't see a simple example of using Animas for Functional Reactive Programming, and I just spent the last day trying to put together a little toy program. So I figured I'd share what I did come up with.

Functional Reactive Programming looks like a pretty cool paradigm for playing with interactive or animated systems in a functional programming language. If you're not familiar with the idea, or with Animas, the best place to start I've found is with the paper Arrows, Robots, and Functional Programming.

I'll start with a quick signal function that describes a sphere. Every 3 seconds this sphere will pick a new position, and then move to that position.

type Position2 = Point2 Float
type SimpleSphere = SF () SphereState

simpleSphere :: (RandomGen g0, RandomGen g1) => g0 -> g1 -> Position2 -> SimpleSphere
simpleSphere gx gy (FRP.Point2 x0 y0) = 
    proc gi -> do
      rec
               -- Pick a position
               smpl <- repeatedly 3 () -< ()
               (rx,ry) <- (noiseR (xMin, xMax) gx) &&& (noiseR (xMin, xMax) gy) -< ()
               (dx, dy) <- hold (x0, y0) -< smpl `tag` (rx, ry)

               let ax = accFac * (dx - x) - velFac * vx
               vx <- integral -< ax
               x <- (x0+) ^<< integral -< vx

               let ay = accFac * (dy - y) - velFac * vy
               vy <- integral -< ay
               y <- (y0+) ^<< integral -< vy

      returnA -< SphereState { ssPos = (FRP.Point2 x y)
                             , ssDPos = (FRP.Point2 dx dy)
                             }

It takes no input, and is initialized by two random number generators and a start Position2.

I'll skip the rec keyword for now and explain the position picking. repeatedly will return an Event () every 3 seconds, or noEvent (Nothing) otherwise. (rx, ry) is a new position picked randomly using noiseR, which gives random numbers within a range, using a random number generator.

tag is of type Event a -> b -> Event b. If it receives an event, then it replaces the value of the event. So when repeatedly fires, it replaces the event with a sample from one of the noiseRs. Thus every 3 seconds we get a new position to home in on.

After that is some math to move the sphere to the new position. A new x and y are calculated by using the integral signal function. Note that x and y are calculated in terms of themselves. This is allowed because we used the rec keyword earlier, which enables our signal function to maintain some state. Under the hood, it makes use of an ArrowLoop.

Two more utility functions from FRP land, then we start plugging into GLUT. GLUT implements its own event loop, so we won't be using reactimate to drive our program's main loop, we'll be using GLUT's main loop. To do that we'll use reactInit and react. react needs an init function to get the initial signal input. For our purposes, we'll just pass ().

initr :: IO ()
initr = do
  return ()

The other guy that reactInit will want is a function called actuate, which is where we'll be drawing the output state to the screen.

actuate :: ReactHandle a b -> Bool -> [SphereState] -> IO Bool
actuate _ _ noos  = do
  clear [ ColorBuffer, DepthBuffer ]

  mapM (\noo -> do
          preservingMatrix (do
                             translate $ stateToVector3 (ssDPos noo) 0.0
                             color (Color3 0.1 0.1 (0.1::GLfloat))
                             renderObject Solid (Sphere' 0.1 8 2)
                           )
          preservingMatrix (do
                             translate $ stateToVector3 (ssPos noo) 0.0
                             color (Color3 1.0 0.0 (0.0::GLfloat))
                             renderObject Solid (Sphere' 0.1 8 2)
                           )
       ) noos
  swapBuffers

  return False

This function takes noos, which is a list of SphereStates, and iterates over them, drawing each sphere's desired location and actual current location.

And now for plugging all of this into a GLUT program. We'll start with the idle callback.

idle :: (ReactHandle a b) -> IORef Int -> IO ()
idle rh tRef = do
  time <- get tRef
  currentTime <- get elapsedTime

  let dt = (fromIntegral (currentTime - time))/clkRes

  react rh (dt, Nothing)

  writeIORef tRef currentTime
  return ()

This idle callback takes a reactHandle, and an IORef Int which should be a reference to the last clock time when this function was evaluated. The time elapsed since the last evaluation of idle is calculated, and passed to react. react then does one iteration of all the signal functions, using the time difference we passed in. We could also throw in any events that have been generated from IO land, but in this program we won't be.

reshape :: ReshapeCallback
reshape size@(Size w h) = do
  let vp = 0.8
      aspect = fromIntegral w / fromIntegral h
  
  viewport $= (Position 0 0, size)

  matrixMode $= Projection
  loadIdentity
  frustum (-vp) vp (-vp / aspect) (vp / aspect) 3 50

  matrixMode $= Modelview 0
  loadIdentity
  translate (Vector3 0 0 (-20 :: GLfloat))

This is just a basic window resizing function, updates all our matrices whenever the window is resized.

And finally, our main function:

main :: IO ()
main = do
  (progname, args) <- getArgsAndInitialize
  initialDisplayMode $= [WithDepthBuffer, DoubleBuffered, RGBAMode]
  initialWindowSize $= (Size 400 400)
  createWindow "Moving Spheres"

  t <- get elapsedTime
  timeRef <- newIORef t

  rh <- (reactInit 
         (initr) 
         (actuate) 
         (parB (map (\i -> let g0 = mkStdGen i
                               (x, g1) = randomR (xMin, xMax) g0
                               (y, g2) = randomR (xMin, xMax) g1
                               pos = FRP.Point2 x y
                           in
                             simpleSphere g1 g2 pos)
                [0..3]))
         )
                                     
  displayCallback $= (do return ())
  idleCallback $= Just (idle rh timeRef)
  reshapeCallback $= Just reshape
  mainLoop

reactInit returns a ReactHandle, which we're calling rh. It takes our initr and actuate functions, and then finally the signal function that we'd like to evaluate. When the idle loop calls react with this handle, it knows to run our signal function and then actuate.

Here I've used parB to run several of my simpleSphere's together in parallel. The big let generates a random location for each sphere, and generates a new random number generator for each sphere. Despite creating the random number generators this way, the spheres still tend to line themselves up in rows or patterns quite often, which is interesting. I'm probably not using the random number generator properly or something.

Anyway, that's my story and I'm sticking to it. Full code over at github.