Connecting Yampa with LambdaCube-Engine
This blog post was originally written back in 2012-06-11
In this post I present a minimal LambdaCube-Engine program which connects a 3D rendering engine to Yampa FRP. The code is an adaption of the
lambdacube-basic.hs example delivered with
lambdacube-examples. Some changes to Yampa were necessary to allow
MonadIO transformations in order to connect with LambdaCube. The goal is to get quickstarted with Yampa and LambdaCube, so the code was intentionally kept simple. Full source code is available at bottom of post.
First we’re going to setup LamdaCube, run the lambdacube-basic example and see how it does work. Note that the latest version (0.2.4) of LamdaCube is available at GoogleCode (instead of Hackage (0.2.3)).
>>> cabal unpack lambdacube-engine # old version >>> svn checkout http://lambdacube.googlecode.com/svn/trunk/ lambdacube # new version >>> cd lambdacube/lambdacube-examples >>> dist/build/lambdacube-basic/lambdacube-basic # ls lambdacube-examples.cabal # ls src/lambdacube-basic.hs # ls media/
It should show 1 frame of a bluesky scene. However it stops immediately because of an issue in Elerea FRP with the following message (bug report):
thread blocked indefinitely in an MVar operation
This is unfortunate, however we’re going to integrate Yampa anyway. The important parts of the example are outlined here:
import FRP.Elerea.Param ... main = do openWindow ... runLCM renderSystem [Stb.loadImage] $ do ... addScene [ node "Root" "Obj" ...] ... addRenderWindow "MainWindow" 640 480 ... ... sc <- liftIO $ start $ scene ... driveNetwork sc (readInput ...) scene :: RenderSystem r vb ib q t p lp => ... -> SignalGen FloatType (Signal (LCM (World r vb ib q t p lp) e ())) scene = do ... return $ drawGLScene <$> ... drawGLScene :: RenderSystem r vb ib q t2 p lp => ... -> FloatType -> LCM (World r vb ib q t2 p lp) e () drawGLScene ... time = do updateTransforms $ ... updateTargetSize "MainWindow" w h renderWorld (realToFrac time) "MainWindow"
What happens here is that a LCM world (
LambdaCubeMonad) is created and several changes are made by “shoving” through the World via
runLCM. Finally Elerea’s
driveNetwork starts an infinite loop to make repeated
renderWorld calls within the
LCM context. So all we have to do is replace Elerea’s
driveNetwork with Yampa’s
reactimate and “shove” the LCM into
reactimate. Unfortunately the types don’t match: (
LCM). Also note how an external
renderWorld is called within an
LCM context. What’s going on? Let’s look up the definition! Because there are no public docs available we’ll generate them ourselves:
>>> cd lambdacube/lambdacube-engine >>> cabal haddock >>> firefox dist/doc/html/lambdacube-engine/index.html
data LCM w e a Instances Monad (LCM w e) Functor (LCM w e) Applicative (LCM w e) MonadIO (LCM w e)
What’s interesting here is that
MonadIO and provides a free type variable
LCM has an IO context and can be extended with other Monad contexts and types. All we have to do therefore is to make Yampa’s
reactimate less strict and do some Monad lifting.
>>> cabal install transformers >>> cabal unpack Yampa >>> cd Yampa-0.9.3/src/FRP
reactimate :: IO a -> (Bool -> IO (DTime, Maybe a)) -> (Bool -> b -> IO Bool) -> SF a b -> IO ()
import Control.Monad.IO.Class (MonadIO) ... reactimate :: MonadIO m => m a -> (Bool -> m (DTime, Maybe a)) -> (Bool -> b -> m Bool) -> SF a b -> m ()
Now we can call
runLCM and use Yampa as usual. Copy the
lambdacube-basic.hs file and extend
lambdacube-examples.cabal with the new executable.
type ObjInput = (Int, Int) -- mouse-position type ObjOutput = (String, Proj4) -- object name, transformation main :: IO () main = do mediaPath <- getDataFileName "media" renderSystem <- mkGLRenderSystem runLCM renderSystem [Stb.loadImage] (reactimate (initput title mediaPath) input output (process objs)) closeWindow initput :: RenderSystem r vb ib q t p lp => Bool -> LCM (World r vb ib q t p lp) e (DTime, Maybe (Bool, ObjInput)) initput _ = do ... liftIO $ openWindow ... ... addScene [ node "Root" "Obj" ...] ... output :: RenderSystem r vb ib q t p lp => Bool -> [ObjOutput] -> LCM (World r vb ib q t p lp) e Bool cam :: SF ObjInput ObjOutput cam = proc _ -> do t <- localTime -< () returnA -< ("Cam", translation (Vec3 0 0 (realToFrac t)))
>>> cd lambdacube/lambdacube-examples >>> cabal configure >>> cabal build >>> dist/build/YampaCube/YampaCube
Download full source code:
Viola! What you should see is a small box with the bluesky texture and the camera slowly moving away from it.