diff --git a/BulletExample.hs b/BulletExample.hs
new file mode 100644
--- /dev/null
+++ b/BulletExample.hs
@@ -0,0 +1,644 @@
+{-# LANGUAGE OverloadedStrings, TypeOperators, NoMonomorphismRestriction, ExistentialQuantification, PackageImports, DoRec, ParallelListComp, DataKinds #-}
+
+{-
+
+Notes:
+
+* btCollisionShape can be handled as an immutable, shareable object,
+  so functions creating any of its descendants don't have to be in IO
+
+* access to all constants would be nice (e.g. no activation states available)
+
+* the physics world could be just as well made accessible from a monad as the LC world
+
+* how to check if a boxed pointer is null?
+
+-}
+
+import Control.Applicative
+import Control.Arrow (first)
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.Trans
+import Data.Bits
+import qualified Data.ByteString.Char8 as B
+import Data.IORef
+import Data.Maybe
+import Data.List
+import qualified Data.Trie as T
+import Data.Vect
+import Data.Vector ((!))
+import qualified Data.Vector as V 
+import Foreign hiding (unsafePerformIO)
+import FRP.Elerea.Simple
+import "GLFW-b" Graphics.UI.GLFW
+import Physics.Bullet.Raw
+import Physics.Bullet.Raw.Class
+import Physics.Bullet.Raw.Types
+import Physics.Bullet.Raw.Utils
+import System.IO.Unsafe
+import Unsafe.Coerce
+
+import LC_API hiding (Transform)
+import qualified LC_API as LC
+import LC_Mesh
+
+import Common.Utils
+import Common.GraphicsUtils
+
+data CameraInfo = CameraInfo
+    { cameraPosition :: Vec3
+    , targetPosition :: Vec3
+    , upwardDirection :: Vec3
+    }
+
+cameraView (CameraInfo cameraPos targetPos upwardDir) = lookat cameraPos targetPos upwardDir
+ 
+cameraInfo = CameraInfo (Vec3 0 20 30) (Vec3 0 0 0) (Vec3 0 1 0)
+
+farPlane = 5000
+
+fieldOfView = pi / 2
+
+floorSize = Vec3 100.0 1.0 100.0
+
+brickSize = Vec3 5.0 2.0 10.0
+
+ghostRadius = 5
+
+capsuleBoxSize radius height = Vec3 radius (height/2+radius) radius
+
+pi2 = pi*0.5
+
+pi4 = pi*0.25
+
+scaleTransPos m (Transform rot pos) = Transform rot (pos &* m)
+
+--ragdollPartConfig :: [(String, (Float, Float, Transform))]
+ragdollPartConfig = map (scalePart 5)
+    [ ("Pelvis", (0.15, 0.20, Transform idmtx (Vec3 0 1 0)))
+	, ("Spine", (0.15, 0.28, Transform idmtx (Vec3 0 1.2 0)))
+	, ("Head", (0.10, 0.05, Transform idmtx (Vec3 0 1.6 0)))
+	, ("LeftUpperLeg", (0.07, 0.45, Transform idmtx (Vec3 (-0.18) 0.65 0)))
+	, ("LeftLowerLeg", (0.05, 0.37, Transform idmtx (Vec3 (-0.18) 0.2 0)))
+	, ("RightUpperLeg", (0.07, 0.45, Transform idmtx (Vec3 0.18 0.65 0)))
+	, ("RightLowerLeg", (0.05, 0.37, Transform idmtx (Vec3 0.18 0.2 0)))
+	, ("LeftUpperArm", (0.05, 0.33, Transform (rotMatrixZ pi2) (Vec3 (-0.35) 1.45 0)))
+	, ("LeftLowerArm", (0.04, 0.25, Transform (rotMatrixZ pi2) (Vec3 (-0.7) 1.45 0)))
+	, ("RightUpperArm", (0.05, 0.33, Transform (rotMatrixZ (-pi/2)) (Vec3 0.35 1.45 0)))
+	, ("RightLowerArm", (0.04, 0.25, Transform (rotMatrixZ (-pi/2)) (Vec3 0.7 1.45 0)))
+    ]
+  where
+    scalePart m (name, (radius, height, trans)) = (name, (radius*m, height*m, scaleTransPos m trans))
+
+ragdollConstraintConfig = map (scaleConstraint 5)
+    [ HingeConstraint "Pelvis" "Spine" (Transform (rotMatrixY pi2) (Vec3 0 0.15 0)) (Transform (rotMatrixY pi2) (Vec3 0 (-0.15) 0)) (-pi4) pi2
+    , ConeTwistConstraint "Spine" "Head" (Transform (rotMatrixZ pi2) (Vec3 0 0.3 0)) (Transform (rotMatrixZ pi2) (Vec3 0 (-0.14) 0)) pi4 pi4 pi2
+    , hipConstraint "LeftUpperLeg" (-1)
+    , kneeConstraint "LeftUpperLeg" "LeftLowerLeg"
+    , hipConstraint "RightUpperLeg" 1
+    , kneeConstraint "RightUpperLeg" "RightLowerLeg"
+    , shoulderConstraint "LeftUpperArm" (-1)
+    , elbowConstraint "LeftUpperArm" "LeftLowerArm"
+    , shoulderConstraint "RightUpperArm" 1
+    , elbowConstraint "RightUpperArm" "RightLowerArm"
+    ]
+  where
+    hipConstraint upperLeg sign = ConeTwistConstraint "Pelvis" upperLeg (Transform (rotMatrixZ (sign*pi4)) (Vec3 (sign*0.18) (-0.1) 0)) (Transform (rotMatrixZ (sign*pi4)) (Vec3 0 0.225 0)) pi4 pi4 0
+    kneeConstraint upperLeg lowerLeg = HingeConstraint upperLeg lowerLeg (Transform (rotMatrixY pi2) (Vec3 0 (-0.225) 0)) (Transform (rotMatrixY pi2) (Vec3 0 0.185 0)) 0 pi2
+    shoulderConstraint upperArm sign = ConeTwistConstraint "Spine" upperArm (Transform (rotMatrixZ (pi2-sign*pi2)) (Vec3 (sign*0.2) 0.15 0)) (Transform (rotMatrixZ pi2) (Vec3 0 (-0.18) 0)) pi2 pi2 0
+    elbowConstraint upperArm lowerArm = HingeConstraint upperArm lowerArm (Transform (rotMatrixY pi2) (Vec3 0 0.18 0)) (Transform (rotMatrixY pi2) (Vec3 0 (-0.14) 0)) 0 pi2
+    scaleConstraint m c = case c of
+        HingeConstraint name1 name2 trans1 trans2 low high -> HingeConstraint name1 name2 (sc trans1) (sc trans2) low high
+        ConeTwistConstraint name1 name2 trans1 trans2 swingSpan1 swingSpan2 twistSpan -> ConeTwistConstraint name1 name2 (sc trans1) (sc trans2) swingSpan1 swingSpan2 twistSpan
+      where
+        sc = scaleTransPos m
+        
+-- This is missing a lot of stuff (including other constructors?), it should be handled by attributes
+data BulletConstraint
+    = HingeConstraint String String Transform Transform Float Float
+    | ConeTwistConstraint String String Transform Transform Float Float Float
+
+-- Capsules only...
+complexBody dynamicsWorld offset parts constraints = do
+    bodies <- forM parts $ \(name, (radius, height, Transform rot pos)) -> do
+        body <- snd <$> localCreateRigidBodyM dynamicsWorld 1 (Transform rot (pos &+ offset)) (capsuleShape radius height)
+        return (name, body)
+    let body name = snd (fromJust (find ((==name) . fst) bodies))
+    forM_ constraints $ \ctr -> case ctr of
+        HingeConstraint name1 name2 trans1 trans2 low high -> do
+            hinge <- btHingeConstraint2 (body name1) (body name2) trans1 trans2 False
+            btHingeConstraint_setLimit hinge low high 0.9 0.3 1
+            --set hinge [lowerLimit? := low, upperLimit? := high, limitSoftness := 0.9, biasFactor := 0.3, relaxationFactor := 1]
+            btDynamicsWorld_addConstraint dynamicsWorld hinge True
+        ConeTwistConstraint name1 name2 trans1 trans2 swSpan1 swSpan2 twSpan -> do
+            coneTwist <- btConeTwistConstraint0 (body name1) (body name2) trans1 trans2
+            --set coneTwist [swingSpan1 := swSpan1, swingSpan2 := swSpan2, twistSpan := twSpan, limitSoftness := 1, biasFactor := 0.3, relaxationFactor := 1]
+            btConeTwistConstraint_setLimit1 coneTwist swSpan1 swSpan2 twSpan 1 0.3 1
+            btDynamicsWorld_addConstraint dynamicsWorld coneTwist True
+    return bodies    
+
+-- Attribute system in the footsteps of gtk2hs (glib)
+
+infixr 0 :=, :~, :<
+
+data Attr o a = forall x . Attr !(o -> IO a) !(o -> a -> IO x)
+
+data AttrOp o = forall a . Attr o a := a
+              | forall a . Attr o a :~ (a -> a)
+              | forall a . Attr o a :!= IO a
+              | forall a . Attr o a :!~ (a -> IO a)
+              | forall a . Attr o a :< Signal (Maybe a)
+  
+set :: o -> [AttrOp o] -> IO o
+set obj attrs = (>> return obj) $ forM_ attrs $ \op -> case op of
+    Attr _ setter := x       -> setter obj x >> return ()
+    Attr getter setter :~ f  -> getter obj >>= setter obj . f >> return ()
+    Attr _ setter :!= x      -> x >>= setter obj >> return ()
+    Attr getter setter :!~ f -> getter obj >>= f >>= setter obj >> return ()
+    _ :< _                   -> error "Signals not supported in IO"
+
+get :: o -> Attr o a -> IO a
+get obj (Attr getter _) = getter obj 
+
+make :: IO o -> [AttrOp o] -> IO o
+make act flags = do
+    obj <- act
+    set obj flags
+    return obj
+
+set' :: o -> [AttrOp o] -> SignalGen (Signal ())
+set' obj as = go as (return ())
+  where
+    go [] sig     = return sig
+    go (a:as) sig = case a of
+        Attr getter setter := x  -> execute (setter obj x >> return ()) >> go as sig
+        Attr getter setter :~ f  -> execute (getter obj >>= setter obj . f >> return ()) >> go as sig
+        Attr getter setter :!= x -> execute (x >>= setter obj >> return ()) >> go as sig
+        Attr getter setter :!~ f -> execute (getter obj >>= f >>= setter obj >> return ()) >> go as sig
+        Attr getter setter :< s  -> do     
+            dummy <- flip effectful1 s $ \mx -> case mx of
+                Nothing -> return ()
+                Just x  -> setter obj x >> return ()
+            go as (liftA2 const sig dummy)
+
+make' :: IO o -> [AttrOp o] -> SignalGen (Signal o)
+make' act flags = do
+    obj <- execute act
+    dummy <- set' obj flags
+    return (liftA2 const (return obj) dummy)
+
+-- Test attributes
+
+collisionFlags :: BtCollisionObjectClass o => Attr o Int
+collisionFlags = Attr btCollisionObject_getCollisionFlags btCollisionObject_setCollisionFlags
+
+-- coercion needed to generalise concrete type into a vague type class (should be safe)
+collisionShape :: (BtCollisionObjectClass o, BtCollisionShapeClass cs) => Attr o cs
+collisionShape = Attr (unsafeCoerce . btCollisionObject_getCollisionShape) btCollisionObject_setCollisionShape
+
+worldTransform :: BtCollisionObjectClass o => Attr o Transform
+worldTransform = Attr btCollisionObject_getWorldTransform btCollisionObject_setWorldTransform
+
+deactivationTime :: BtCollisionObjectClass o => Attr o Float
+deactivationTime = Attr btCollisionObject_getDeactivationTime btCollisionObject_setDeactivationTime
+
+-- note the inconsistent naming convention...
+pivotA :: BtPoint2PointConstraintClass o => Attr o Vec3
+pivotA = Attr btPoint2PointConstraint_getPivotInA btPoint2PointConstraint_setPivotA
+
+pivotB :: BtPoint2PointConstraintClass o => Attr o Vec3
+pivotB = Attr btPoint2PointConstraint_getPivotInB btPoint2PointConstraint_setPivotB
+
+-- it would be great if all the constraints provided a similar facility
+setting :: BtPoint2PointConstraintClass o => Attr o BtConstraintSetting
+setting = Attr btPoint2PointConstraint_m_setting_get btPoint2PointConstraint_m_setting_set
+
+impulseClamp :: BtConstraintSettingClass o => Attr o Float
+impulseClamp = Attr btConstraintSetting_m_impulseClamp_get btConstraintSetting_m_impulseClamp_set
+
+tau :: BtConstraintSettingClass o => Attr o Float
+tau = Attr btConstraintSetting_m_tau_get btConstraintSetting_m_tau_set
+
+damping :: BtConstraintSettingClass o => Attr o Float
+damping = Attr btConstraintSetting_m_damping_get btConstraintSetting_m_damping_set
+
+-- Collision tracking example
+
+extractManifold :: BtPersistentManifold -> IO (BtCollisionObject,BtCollisionObject,[(Float,Vec3,Vec3,Vec3)])
+extractManifold manifold = do
+    b0 <- mkBtCollisionObject =<< btPersistentManifold_getBody0 manifold
+    b1 <- mkBtCollisionObject =<< btPersistentManifold_getBody1 manifold
+    cpn <- btPersistentManifold_getNumContacts manifold
+    l <- forM [0..cpn-1] $ \p -> do
+        pt <- btPersistentManifold_getContactPoint manifold p
+        (,,,) <$>
+            btManifoldPoint_getDistance pt <*> btManifoldPoint_getPositionWorldOnA pt <*> 
+            btManifoldPoint_getPositionWorldOnB pt <*> btManifoldPoint_m_normalWorldOnB_get pt
+    return (b0,b1,l)
+
+collectManifolds :: BtCollisionWorldClass cw => cw -> BtPairCachingGhostObject -> IO [BtPersistentManifold]
+collectManifolds dynamicsWorld ghostObject = do
+    let notNull a = btToPtr a /= nullPtr
+    manifoldArray <- btAlignedObjectArray_btPersistentManifold_ptr_
+    pairArray <- btHashedOverlappingPairCache_getOverlappingPairArray =<< btPairCachingGhostObject_getOverlappingPairCache ghostObject
+    numPairs <- btAlignedObjectArray_btBroadphasePair__size pairArray
+    l <- forM [0..numPairs-1] $ \i -> do
+        btAlignedObjectArray_btPersistentManifold_ptr__clear manifoldArray
+        pair <- btAlignedObjectArray_btBroadphasePair__at pairArray i
+        pProxy0 <- btBroadphasePair_m_pProxy0_get pair
+        pProxy1 <- btBroadphasePair_m_pProxy1_get pair
+        collisionPair <- (\a -> btOverlappingPairCache_findPair a pProxy0 pProxy1) =<< btCollisionWorld_getPairCache dynamicsWorld
+        case notNull collisionPair of
+            False -> return []
+            True -> do
+                alg <- btBroadphasePair_m_algorithm_get collisionPair
+                when (notNull alg) $ btCollisionAlgorithm_getAllContactManifolds alg manifoldArray
+                n <- btAlignedObjectArray_btPersistentManifold_ptr__size manifoldArray
+                forM [0..n-1] $ \j -> btAlignedObjectArray_btPersistentManifold_ptr__at manifoldArray j
+    --btAlignedObjectArray_btPersistentManifold_ptr__free manifoldArray
+    return $ concat l
+
+rigidBodyProj4 :: BtRigidBody -> IO Proj4
+rigidBodyProj4 rigidBody = do
+    motionState <- btRigidBody_getMotionState rigidBody
+    t <- btMotionState_getWorldTransform motionState idTransform
+    return (transformToProj4 t)
+
+proj4ToTransform :: Proj4 -> Transform
+proj4ToTransform p = Transform (Mat3 (Vec3 a1 a2 a3) (Vec3 b1 b2 b3) (Vec3 c1 c2 c3)) (Vec3 p1 p2 p3)
+  where
+    Mat4 (Vec4 a1 b1 c1 _) (Vec4 a2 b2 c2 _) (Vec4 a3 b3 c3 _) (Vec4 p1 p2 p3 _) = fromProjective p
+
+transformToProj4 :: Transform -> Proj4
+transformToProj4 t = toProjectiveUnsafe $ Mat4 (Vec4 a1 b1 c1 0) (Vec4 a2 b2 c2 0) (Vec4 a3 b3 c3 0) (Vec4 p1 p2 p3 1)
+  where
+    Transform (Mat3 (Vec3 a1 a2 a3) (Vec3 b1 b2 b3) (Vec3 c1 c2 c3)) (Vec3 p1 p2 p3) = t
+
+main' = do
+    dynamicsWorld <- simpleBtDiscreteDynamicsWorldM
+
+    -- setup
+    ghostPairCallback <- btGhostPairCallback
+    pairCache <- btCollisionWorld_getPairCache dynamicsWorld
+    btOverlappingPairCache_setInternalGhostPairCallback pairCache ghostPairCallback
+
+    ghostObject <- btPairCachingGhostObject
+
+    sphere <- btSphereShape 5
+    print sphere
+    print (btToPtr ghostObject < btToPtr sphere)
+    btCollisionObject_setCollisionShape ghostObject sphere
+    btCollisionObject_setWorldTransform ghostObject $ Transform idmtx $ Vec3 0 5 0
+    btCollisionWorld_addCollisionObject dynamicsWorld ghostObject 1 (-1)
+
+    (_,b) <- localCreateRigidBodyM dynamicsWorld 1 (Transform idmtx $ Vec3 0 6 0) sphere
+    print (ghostObject,b)
+
+    print =<< mapM extractManifold =<< collectManifolds dynamicsWorld ghostObject
+
+    -- ray test
+    let from = Vec3 0 100 0
+        to = Vec3 0 (-100) 0
+    rayResult <- btCollisionWorld_AllHitsRayResultCallback from to
+    btCollisionWorld_rayTest dynamicsWorld from to rayResult
+    l <- btCollisionWorld_AllHitsRayResultCallback_m_hitPointWorld_get rayResult
+    -- m_collisionObjects: btAlignedObjectArray<btCollisionObject*>
+    -- btAlignedObjectArray_btCollisionObject_ptr__at
+    n <- btAlignedObjectArray_btVector3__size l
+    hitPoints <- forM [0..n-1] $ \i -> btAlignedObjectArray_btVector3__at l i
+    print ("ray test",hitPoints)
+
+    -- ghost object collision test
+    btDynamicsWorld_stepSimulation dynamicsWorld 0.01 10 (1 / 200)
+    print =<< (mapM extractManifold =<< collectManifolds dynamicsWorld ghostObject)
+    btDynamicsWorld_stepSimulation dynamicsWorld 10 10 (1 / 200)
+    print =<< (mapM extractManifold =<< collectManifolds dynamicsWorld ghostObject)
+
+sphereShape = unsafePerformIO . btSphereShape
+
+boxShape = unsafePerformIO . btBoxShape
+
+capsuleShape r h = unsafePerformIO (btCapsuleShape1 r h)
+
+bodyTransformation = effectful1 rigidBodyProj4
+
+boolToMaybe val bool = if bool then Just val else Nothing
+
+main = do
+    (windowSize, mousePosition, mousePress) <- initCommon "LambdaCube-Bullet test"
+
+    dynamicsWorld <- simpleBtDiscreteDynamicsWorldM
+    ghostPairCallback <- btGhostPairCallback
+    pairCache <- btCollisionWorld_getPairCache dynamicsWorld
+    btOverlappingPairCache_setInternalGhostPairCallback pairCache ghostPairCallback
+  
+    let stepPhysics dt = btDynamicsWorld_stepSimulation dynamicsWorld dt 50 0.005
+        collisionInfo gobj = mapM extractManifold =<< collectManifolds dynamicsWorld gobj
+        bodyInCollision body = not . null . filter (involves body)
+          where
+            involves b (b1,b2,_) = b == unsafeCoerce b1 || b == unsafeCoerce b2
+
+    let pipeline :: Exp Obj (Image 1 V4F)
+        pipeline = PrjFrameBuffer "outFB" tix0 translucentShading --simpleShading
+    
+    (duration, renderer) <- measureDuration $ compileRenderer (ScreenOut pipeline)
+    putStrLn $ "Renderer compiled - " ++ show duration
+    
+    let setters = uniformSetter renderer
+        lightPositionSetter = uniformV3F "lightPosition" setters . fromVec3
+
+    lightPositionSetter (Vec3 10 10 10)
+    
+    let createObject name mesh colour = do
+            let (slotName, uniformName) = case colour of 
+                    Left _ -> ("solidGeometry", "solidColour")
+                    Right _ -> ("translucentGeometry", "alphaColour")
+
+            compiledMesh <- compileMesh mesh
+            object <- addMesh renderer slotName compiledMesh [uniformName, "modelMatrix"]
+            let objectSetters = objectUniformSetter object
+                modelMatrixSetter = uniformM44F "modelMatrix" objectSetters . fromMat4
+            
+            modelMatrixSetter idmtx
+            case colour of
+                Left rgb -> uniformV3F uniformName objectSetters (fromVec3 rgb)
+                Right rgba -> uniformV4F uniformName objectSetters (fromVec4 rgba)
+            return (name, modelMatrixSetter)
+
+    ghostSetter <- createObject "Ghost" (sphere 5 10) (Right (Vec4 0.3 0.9 0.9 0.7))
+    floorSetter <- createObject "Floor" (box floorSize) (Left (Vec3 0.7 0.7 0.7))
+    brickSetter <- createObject "Brick" (box brickSize) (Left (Vec3 1.0 0.0 0.0))
+    hitSetter <- createObject "Hit" (sphere 0.5 5) (Right (Vec4 1.0 1.0 1.0 0.7))
+
+    ragdollSetters <- forM ragdollPartConfig $ \(name, (radius, height, trans)) -> do
+        ragdollSetter@(_, setTrans) <- createObject name (capsule radius height 10) (Left (Vec3 1.0 0.9 0.6))
+        setTrans (fromProjective (transformToProj4 trans))
+        return ragdollSetter
+
+    let updateTransforms transforms = forM_ transforms $ \(name, trans) -> do
+            let Just setter = T.lookup (B.pack name) setters
+            setter (fromProjective trans)
+        setters = T.fromList (map (first B.pack) namedSetters)  
+          where
+            namedSetters = ghostSetter : floorSetter : brickSetter : hitSetter : ragdollSetters
+
+    smp <- start $ do
+        ragdollBodies <- execute $ do
+            floor <- localCreateRigidBodyM dynamicsWorld 0 (Transform idmtx 0) (boxShape floorSize)
+            complexBody dynamicsWorld (Vec3 1 5 10) ragdollPartConfig ragdollConstraintConfig
+
+        querySpace <- execute $ do
+            ghostObject <- make btPairCachingGhostObject
+                           [ collisionFlags :~ (.|. e_btCollisionObject_CollisionFlags_CF_NO_CONTACT_RESPONSE)
+                           , collisionShape := sphereShape ghostRadius
+                           , worldTransform := Transform idmtx 0
+                           ]
+            btCollisionWorld_addCollisionObject dynamicsWorld ghostObject 1 (-1)
+            return ghostObject
+
+        collisions <- effectful $ collisionInfo querySpace
+
+        let initBrickTrans = Transform idmtx (Vec3 2 20 (-3))
+        brick <- do
+            rec brick <- make' (snd <$> localCreateRigidBodyM dynamicsWorld 1 initBrickTrans (boxShape brickSize))
+                         [worldTransform :< boolToMaybe initBrickTrans . bodyInCollision brickBody <$> collisions]
+                brickBody <- snapshot brick
+            return brick
+    
+        brickTrans <- bodyTransformation brick
+        
+        (hitPosition, hitPositionSink) <- execute $ external Nothing
+    
+        dummy <- pickConstraint dynamicsWorld windowSize (pure cameraInfo) mousePress mousePosition hitPositionSink
+
+        return $ updateScene renderer updateTransforms stepPhysics ragdollBodies <$> windowSize <*> hitPosition <*> (const <$> brickTrans <*> dummy)
+  
+    fix $ \loop -> do
+        join smp
+        esc <- keyIsPressed KeyEsc
+        when (not esc) loop
+    
+    dispose renderer
+    putStrLn "Renderer destroyed."
+
+    closeWindow
+
+updateScene :: Renderer -> ([(String, Proj4)] -> IO ()) -> (Float -> IO Int) -> [(String, BtRigidBody)] -> Vec2 -> Maybe Vec3 -> Proj4 -> IO ()
+updateScene renderer updateTransforms stepPhysics ragdollBodies (Vec2 w h) hitPosition brickTrans = do
+    ragdollTransforms <- forM ragdollBodies $ \(name, body) -> do
+        proj <- rigidBodyProj4 body
+        return (name, proj)
+    
+    let aspect = w / h
+        cameraProjection = perspective 0.1 farPlane fieldOfView aspect
+        cameraSetter = uniformM44F "cameraMatrix" (uniformSetter renderer) . fromMat4
+    setScreenSize renderer (floor w) (floor h)
+    cameraSetter $ fromProjective (cameraView cameraInfo) .*. cameraProjection
+
+    updateTransforms $
+        ("Brick", brickTrans) :
+        ("Hit", translation (fromMaybe (Vec3 0 10000 0) hitPosition)) :
+        ragdollTransforms
+    
+    dt <- getTime
+    resetTime
+    stepPhysics (realToFrac dt)
+    
+    render renderer
+    swapBuffers
+
+-- Picking
+
+pickConstraint dynamicsWorld windowSize cameraInfo mouseButton mousePos hitPositionSink = do
+    press <- edge mouseButton
+    release <- edge (not <$> mouseButton)
+    pick <- generator $ makePick <$> press <*> windowSize <*> cameraInfo <*> mousePos
+    
+    -- We're going to all this trouble just to keep a reference to the
+    -- constraint signal: we sample it in every frame even though it
+    -- is constant
+    releaseInfo <- do
+        rec sig <- delay Nothing $ do
+                released <- release
+                newPick <- pick
+                currentPick <- sig
+                case (released, newPick, currentPick) of
+                    (True, _, _)                             -> return Nothing
+                    (_, Just (constraintSignal, body), _)    -> do
+                        constraint <- constraintSignal
+                        return $ Just (constraint, body, constraintSignal)
+                    (_, _, Just (_, body, constraintSignal)) -> do
+                        constraint <- constraintSignal
+                        return $ Just (constraint, body, constraintSignal)
+                    _                                        -> return Nothing                            
+
+        return sig
+    
+    effectful2 stopPicking release releaseInfo
+  where
+    edge sig = do
+        sig' <- delay False sig
+        return $ do
+            cur <- sig
+            prev <- sig'
+            return $ not prev && cur 
+    
+    stopPicking True (Just (constraint, body, _)) = releasePick dynamicsWorld body constraint
+    stopPicking _ _ = return ()
+    
+    makePick press windowSizeCur cameraInfoCur mousePosCur = case press of
+        False -> return Nothing
+        True -> do
+            pickInfo <- execute $ pickBody dynamicsWorld windowSizeCur cameraInfoCur mousePosCur hitPositionSink
+            case pickInfo of
+                Nothing -> return Nothing
+                Just (body, hitPosition, distance) -> do
+                    constraint <- createPick dynamicsWorld body hitPosition distance windowSize cameraInfo mousePos
+                    return $ Just (constraint, body)
+    
+-- body picked, ray hit position, and distance from the camera at the time of picking (to be kept while moving)
+--pickBody :: BtCollisionWorldClass bc => bc -> Vec2 -> CameraInfo -> Vec2-> (Maybe Vec3 -> IO ()) -> IO (Maybe (BtRigidBody, Vec3, Float))
+pickBody dynamicsWorld windowSize cameraInfo mousePos hitPositionSink = do
+    let rayFrom = cameraPosition cameraInfo
+        rayTo = rayTarget windowSize cameraInfo mousePos
+    rayResult <- btCollisionWorld_ClosestRayResultCallback rayFrom rayTo
+    btCollisionWorld_rayTest dynamicsWorld rayFrom rayTo rayResult
+    hasHit <- btCollisionWorld_RayResultCallback_hasHit rayResult
+    
+    case hasHit of
+        False -> do
+            hitPositionSink Nothing
+            return Nothing
+        True -> do
+            collisionObj <- btCollisionWorld_RayResultCallback_m_collisionObject_get rayResult
+            isNotPickable <- btCollisionObject_isStaticOrKinematicObject collisionObj
+            hitPositionSink =<< Just <$> btCollisionWorld_ClosestRayResultCallback_m_hitPointWorld_get rayResult
+            internalType <- btCollisionObject_getInternalType collisionObj
+            case isNotPickable || internalType /= e_btCollisionObject_CollisionObjectTypes_CO_RIGID_BODY of
+                True -> return Nothing
+                False -> do
+                    btCollisionObject_setActivationState collisionObj 4 -- DISABLE_DEACTIVATION
+                    hitPosition <- btCollisionWorld_ClosestRayResultCallback_m_hitPointWorld_get rayResult
+                    body <- btRigidBody_upcast collisionObj -- this is null if the internal type is not CO_RIGID_BODY
+                    return $ Just (body, hitPosition, len (hitPosition &- rayFrom))
+
+createPick :: (BtDynamicsWorldClass bc, BtRigidBodyClass b)
+           => bc -> b -> Vec3 -> Float -> Signal Vec2 -> Signal CameraInfo -> Signal Vec2 -> SignalGen (Signal BtPoint2PointConstraint)
+createPick dynamicsWorld body hitPosition distance windowSize cameraInfo mousePos = do
+    make' (createPickConstraint dynamicsWorld body hitPosition)
+        [ setting :!~ flip set [impulseClamp := 30, tau := 0.001]
+        , pivotB :< pivotPosition <$> windowSize <*> cameraInfo <*> mousePos
+        ]
+  where
+    createPickConstraint dynamicsWorld body hitPosition = do
+        bodyProj <- transformToProj4 <$> btRigidBody_getCenterOfMassTransform body
+        let localPivot = trim ((extendWith 1 hitPosition :: Vec4) .* fromProjective (inverse bodyProj))
+        pickConstraint <- btPoint2PointConstraint1 body localPivot
+        btDynamicsWorld_addConstraint dynamicsWorld pickConstraint True
+        return pickConstraint
+        
+    pivotPosition windowSize cameraInfo mousePos = Just (rayFrom &+ (normalize (rayTo &- rayFrom) &* distance))
+      where
+        rayFrom = cameraPosition cameraInfo
+        rayTo = rayTarget windowSize cameraInfo mousePos
+
+releasePick dynamicsWorld body constraint = do
+    btDynamicsWorld_removeConstraint dynamicsWorld constraint
+    btCollisionObject_forceActivationState body 1 -- ACTIVE_TAG
+    btCollisionObject_setDeactivationTime body 0
+
+rayTarget :: Vec2 -> CameraInfo -> Vec2 -> Vec3
+rayTarget (Vec2 windowW windowH) (CameraInfo cameraPos targetPos cameraUp) (Vec2 windowX windowY) =
+    rayCenter &- (horizontal &* (aspect*(0.5-windowX/windowW))) &+ (vertical &* (0.5-windowY/windowH))
+  where
+    aspect = windowW / windowH
+    tanFov = tan (fieldOfView * sqrt 0.5)
+
+    rayForward = normalize (targetPos &- cameraPos) &* farPlane
+    horizontal = normalize (rayForward &^ cameraUp) &* (farPlane*tanFov)
+    vertical = normalize (horizontal &^ rayForward) &* (farPlane*tanFov)
+    
+    rayCenter = cameraPos &+ rayForward
+
+simpleShading :: Exp Obj (FrameBuffer 1 (Float, V4F))
+simpleShading = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = AccumulationContext Nothing (DepthOp Less True :. ColorOp NoBlending (one' :: V4B) :. ZT)
+    clearBuf = FrameBuffer (DepthImage n1 1000 :. ColorImage n1 (V4 0 0 0 1) :. ZT)
+    prims = LC.Transform vert (Fetch "solidGeometry" Triangles (IV3F "position", IV3F "normal"))
+    
+    cameraMatrix = Uni (IM44F "cameraMatrix")
+    modelMatrix = Uni (IM44F "modelMatrix")
+    lightPosition = Uni (IV3F "lightPosition")
+    colour = Uni (IV3F "solidColour")
+
+    vert :: Exp V (V3F, V3F) -> VertexOut () (V3F, V3F)
+    vert attr = VertexOut viewPos (floatV 1) ZT (Smooth (v4v3 worldPos) :. Smooth worldNormal :. ZT)
+      where
+        worldPos = modelMatrix @*. v3v4 localPos
+        viewPos = cameraMatrix @*. worldPos
+        worldNormal = normalize' (v4v3 (modelMatrix @*. n3v4 localNormal))
+        (localPos, localNormal) = untup2 attr
+        
+    frag :: Exp F (V3F, V3F) -> FragmentOut (Depth Float :+: Color V4F :+: ZZ)
+    frag attr = FragmentOutRastDepth (v3v4 (colour @* light) :. ZT)
+      where
+        light = max' (floatF 0) (dot' worldNormal (normalize' (lightPosition @- worldPos)))
+        (worldPos, worldNormal) = untup2 attr
+
+translucentShading :: Exp Obj (FrameBuffer 1 (Float, V4F))
+translucentShading = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) simpleShading
+  where
+    accCtx = AccumulationContext Nothing (DepthOp Less True :. ColorOp blending (one' :: V4B) :. ZT)
+    blending = Blend (FuncAdd, FuncAdd) ((SrcAlpha, OneMinusSrcAlpha), (SrcAlpha, OneMinusSrcAlpha)) zero'
+    prims = LC.Transform vert (Fetch "translucentGeometry" Triangles (IV3F "position", IV3F "normal"))
+    
+    cameraMatrix = Uni (IM44F "cameraMatrix")
+    modelMatrix = Uni (IM44F "modelMatrix")
+    lightPosition = Uni (IV3F "lightPosition")
+    colour = Uni (IV4F "alphaColour")
+
+    vert :: Exp V (V3F, V3F) -> VertexOut () (V3F, V3F)
+    vert attr = VertexOut viewPos (floatV 1) ZT (Smooth (v4v3 worldPos) :. Smooth worldNormal :. ZT)
+      where
+        worldPos = modelMatrix @*. v3v4 localPos
+        viewPos = cameraMatrix @*. worldPos
+        worldNormal = normalize' (v4v3 (modelMatrix @*. n3v4 localNormal))
+        (localPos, localNormal) = untup2 attr
+        
+    frag :: Exp F (V3F, V3F) -> FragmentOut (Depth Float :+: Color V4F :+: ZZ)
+    frag attr = FragmentOutRastDepth (finalColour :. ZT)
+      where
+        V4 r g b a = unpack' colour
+        finalColour = pack' (V4 (r @* light) (g @* light) (b @* light) a)
+        light = max' (floatF 0) (dot' worldNormal (normalize' (lightPosition @- worldPos)))
+        (worldPos, worldNormal) = untup2 attr
+
+initCommon :: String -> IO (Signal Vec2, Signal Vec2, Signal Bool)
+initCommon title = do
+    initialize
+    openWindow defaultDisplayOptions
+        { displayOptions_numRedBits         = 8
+        , displayOptions_numGreenBits       = 8
+        , displayOptions_numBlueBits        = 8
+        , displayOptions_numAlphaBits       = 8
+        , displayOptions_numDepthBits       = 24
+        , displayOptions_width              = 1280
+        , displayOptions_height             = 720
+        , displayOptions_windowIsResizable  = True
+        , displayOptions_openGLVersion      = (3,2)
+        , displayOptions_openGLProfile      = CoreProfile
+        }
+    setWindowTitle title
+
+    (windowSize, windowSizeSink) <- external (Vec2 0 0)
+    setWindowSizeCallback $ \w h -> windowSizeSink (Vec2 (fromIntegral w) (fromIntegral h))
+    
+    (mousePosition, mousePositionSink) <- external (Vec2 0 0)
+    setMousePositionCallback $ \x y -> mousePositionSink (Vec2 (fromIntegral x) (fromIntegral y))
+    
+    (mousePress, mousePressSink) <- external False
+    setMouseButtonCallback $ \b p -> when (b == MouseButton0) $ mousePressSink p
+    
+    return (windowSize, mousePosition, mousePress)
diff --git a/Common/GraphicsUtils.hs b/Common/GraphicsUtils.hs
new file mode 100644
--- /dev/null
+++ b/Common/GraphicsUtils.hs
@@ -0,0 +1,255 @@
+{-# LANGUAGE OverloadedStrings, NamedFieldPuns, ParallelListComp, DataKinds #-}
+
+module Common.GraphicsUtils where
+
+import Data.Bits
+import qualified Data.ByteString.Char8 as SB
+import qualified Data.Trie as T
+import Data.Vect
+import qualified Data.Vector.Storable as V
+import FRP.Elerea.Param
+
+import LC_API
+import LC_Mesh
+
+complexMesh :: [(Proj4, Mesh)] -> Mesh
+complexMesh parts = Mesh
+    { mAttributes = T.fromList [("position", A_V3F vertices), ("normal", A_V3F normals)]
+    , mPrimitive = P_Triangles
+    , mGPUData = Nothing
+    }
+  where
+    vertices = V.concat partVertices
+    normals = V.concat partNormals
+    
+    (partVertices, partNormals) = unzip [(getV3F trans "position" attr 1, getV3F (transpose (inverse trans)) "normal" attr 0) |
+                                         (trans, mesh) <- parts, let attr = mAttributes (unrollIndices mesh)]
+    getV3F trans name attributes w = V.map transform vector
+      where
+        transform v = fromVec3 (trim ((extendWith w (toVec3 v) :: Vec4) .* fromProjective trans))
+        Just (A_V3F vector) = T.lookup name attributes
+
+quad :: Mesh
+quad = Mesh
+    { mAttributes = T.singleton "position" $ A_V2F $ V.fromList [-1 ^ 1, -1 ^ -1, 1 ^ -1, 1 ^ -1, 1 ^ 1, -1 ^ 1]
+    , mPrimitive = P_Triangles
+    , mGPUData = Nothing
+    }
+  where
+    infixr 0 ^
+    (^) = V2
+
+cube :: Float -> Mesh
+cube size = box (Vec3 size size size) 
+
+box :: Vec3 -> Mesh
+box (Vec3 scaleX scaleY scaleZ) = addFlatNormals $ Mesh
+    { mAttributes = T.singleton "position" (A_V3F vertices)
+    , mPrimitive = P_Triangles
+    , mGPUData = Nothing
+    }
+  where
+    quads = [[6, 2, 3, 7], [5, 1, 0, 4], [7, 3, 1, 5], [4, 0, 2, 6], [3, 2, 0, 1], [6, 7, 5, 4]]
+    indices = V.fromList $ concat [[a, b, c, c, d, a] | [d, c, b, a] <- quads]
+    vertices = V.backpermute (V.generate 8 mkVertex) indices
+    
+    mkVertex n = V3 x y z
+      where
+        x = if testBit n 2 then scaleX else -scaleX
+        y = if testBit n 1 then scaleY else -scaleY
+        z = if testBit n 0 then scaleZ else -scaleZ
+
+capsule :: Float -> Float -> Int -> Mesh
+capsule radius height n = complexMesh
+                          [ (idmtx, cylinderLateralArea height' radius (n * 2))
+                          , (translation (Vec3 0 (-height') 0), halfSphere radius n)
+                          , (scaling (Vec3 (-1) (-1) 1) .*. translation (Vec3 0 height' 0), halfSphere radius n)
+                          ]
+  where
+    height' = height / 2
+
+halfSphere :: Float -> Int -> Mesh
+halfSphere radius n = Mesh
+    { mAttributes = T.fromList [("position", A_V3F vertices), ("normal", A_V3F normals)]
+    , mPrimitive = P_TrianglesI indices
+    , mGPUData = Nothing
+    }
+  where
+    m = pi / fromIntegral n
+    vertices = V.map (\(V3 x y z) -> V3 (radius * x) (radius * y) (radius * z)) normals
+    normals = V.fromList [V3 (sin a * cos b) (cos a) (sin a * sin b) | i <- [0..n], j <- [0..2 * n - 1],
+                          let a = fromIntegral i * m * 0.5 + 0.5 * pi, let b = fromIntegral j * m]
+    indices = V.fromList $ concat [[ix i j, ix i' j, ix i' j', ix i' j', ix i j', ix i j] | i <- [0..n - 1], j <- [0..2 * n - 1],
+                                   let i' = i + 1, let j' = (j + 1) `mod` (2 * n)]
+    ix i j = fromIntegral (i * 2 * n + j)
+
+sphere :: Float -> Int -> Mesh
+sphere radius n = Mesh
+    { mAttributes = T.fromList [("position", A_V3F vertices), ("normal", A_V3F normals)]
+    , mPrimitive = P_TrianglesI indices
+    , mGPUData = Nothing
+    }
+  where
+    m = pi / fromIntegral n
+    vertices = V.map (\(V3 x y z) -> V3 (radius * x) (radius * y) (radius * z)) normals
+    normals = V.fromList [V3 (sin a * cos b) (cos a) (sin a * sin b) | i <- [0..n], j <- [0..2 * n - 1],
+                          let a = fromIntegral i * m, let b = fromIntegral j * m]
+    indices = V.fromList $ concat [[ix i j, ix i' j, ix i' j', ix i' j', ix i j', ix i j] | i <- [0..n - 1], j <- [0..2 * n - 1],
+                                   let i' = i + 1, let j' = (j + 1) `mod` (2 * n)]
+    ix i j = fromIntegral (i * 2 * n + j)
+
+cylinder :: Float -> Float -> Int -> Mesh
+cylinder height radius n = complexMesh
+                           [ (idmtx, cylinderLateralArea height radius n)
+                           , (translation (Vec3 0 height 0), regularPolygon radius n)
+                           , (scaling (Vec3 1 (-1) 1) .*. translation (Vec3 0 (-height) 0), regularPolygon radius n)
+                           ]
+
+regularPolygon :: Float -> Int -> Mesh
+regularPolygon radius n = Mesh
+    { mAttributes = T.fromList [("position", A_V3F vertices), ("normal", A_V3F normals)]
+    , mPrimitive = P_TrianglesI indices
+    , mGPUData = Nothing
+    }
+  where
+    vertices = V.cons (V3 0 0 0) (V.generate n mkVertex)
+    normals = V.replicate (n + 1) (V3 0 1 0)
+    indices = V.map fromIntegral . V.fromList $ concat [[0, i, i `mod` n + 1] | i <- [1..n]]
+    mkVertex i = V3 (radius * cos t) 0 (radius * sin t)
+      where
+        t = fromIntegral i * 2 * pi / fromIntegral n
+
+cylinderLateralArea :: Float -> Float -> Int -> Mesh
+cylinderLateralArea height radius n = Mesh
+    { mAttributes = T.fromList [("position", A_V3F vertices), ("normal", A_V3F normals)]
+    , mPrimitive = P_TrianglesI indices
+    , mGPUData = Nothing
+    }
+  where
+    ts = V.generate n (\t -> fromIntegral t * 2 * pi / fromIntegral n)
+    ts' = ts V.++ ts
+    xs = V.map cos ts'
+    ys = V.replicate n height V.++ V.replicate n (-height)
+    zs = V.map sin ts'
+    is = [t `mod` n | t <- [0..n]]
+    vertices = V.zipWith3 (\x y z -> V3 (radius*x) y (radius*z)) xs ys zs
+    normals = V.zipWith3 V3 xs (V.replicate (n*2) 0) zs
+    indices = V.fromList (map fromIntegral (concat [[i,i+n,i'+n,i'+n,i',i] | i <- is | i' <- tail is]))
+
+addFlatNormals :: Mesh -> Mesh
+addFlatNormals mesh@Mesh { mAttributes, mPrimitive = P_Triangles } =
+    mesh { mAttributes = T.insert "normal" (A_V3F normals) mAttributes } 
+  where
+    Just (A_V3F positions) = T.lookup "position" mAttributes
+    normals = V.concatMap mkNormal (V.generate (V.length positions `div` 3) id)
+    mkNormal i = V.replicate 3 (fromVec3 (normalize ((p3 &- p2) &^ (p2 &- p1))))
+      where
+        p1 = toVec3 (positions V.! (i*3))
+        p2 = toVec3 (positions V.! (i*3 + 1))
+        p3 = toVec3 (positions V.! (i*3 + 2))
+addFlatNormals mesh@Mesh { mPrimitive = P_TrianglesI indices } = addFlatNormals (unrollIndices mesh)
+addFlatNormals _ = error "addFlatNormals: unsupported primitive type"
+
+unrollIndices :: Mesh -> Mesh
+unrollIndices mesh@Mesh { mAttributes, mPrimitive = P_Triangles } = mesh
+unrollIndices mesh@Mesh { mAttributes, mPrimitive = P_TrianglesI indices } =
+    mesh { mAttributes = fmap (unrollAttribute indices') mAttributes, mPrimitive = P_Triangles }
+  where
+    indices' = V.map fromIntegral indices
+unrollIndices _ = error "unrollIndices: unsupported primitive type"
+
+unrollAttribute :: V.Vector Int -> MeshAttribute -> MeshAttribute
+unrollAttribute indices attribute = case attribute of
+    A_V3F vs -> A_V3F (V.backpermute vs indices)
+    _        -> error "unrollAttribute: unsupported attribute type"
+
+toVec3 :: V3F -> Vec3
+toVec3 (V3 x y z) = Vec3 x y z
+
+fromVec3 :: Vec3 -> V3F
+fromVec3 (Vec3 x y z) = V3 x y z
+
+fromVec4 :: Vec4 -> V4F
+fromVec4 (Vec4 x y z w) = V4 x y z w
+
+fromMat4 :: Mat4 -> M44F
+fromMat4 (Mat4 a b c d) = V4 (fromVec4 a) (fromVec4 b) (fromVec4 c) (fromVec4 d)
+
+v3v4 :: Exp s V3F -> Exp s V4F
+v3v4 v = pack' (V4 x y z (Const 1))
+  where 
+    V3 x y z = unpack' v
+
+n3v4 :: Exp s V3F -> Exp s V4F
+n3v4 v = pack' (V4 x y z (Const 0))
+  where 
+    V3 x y z = unpack' v
+
+v4v3 :: Exp s V4F -> Exp s V3F
+v4v3 v = pack' (V3 x y z)
+  where
+    V4 x y z _ = unpack' v
+
+floatV :: Float -> Exp V Float
+floatV = Const
+
+floatF :: Float -> Exp F Float
+floatF = Const
+
+floatG :: Float -> Exp G Float
+floatG = Const
+
+intF :: Int32 -> Exp F Int32
+intF = Const
+
+intG :: Int32 -> Exp G Int32
+intG = Const
+
+-- | Perspective transformation matrix in row major order.
+perspective :: Float  -- ^ Near plane clipping distance (always positive).
+            -> Float  -- ^ Far plane clipping distance (always positive).
+            -> Float  -- ^ Field of view of the y axis, in radians.
+            -> Float  -- ^ Aspect ratio, i.e. screen's width\/height.
+            -> Mat4
+perspective n f fovy aspect = transpose $
+    Mat4 (Vec4 (2*n/(r-l))       0       (-(r+l)/(r-l))        0)
+         (Vec4     0        (2*n/(t-b))  ((t+b)/(t-b))         0)
+         (Vec4     0             0       (-(f+n)/(f-n))  (-2*f*n/(f-n)))
+         (Vec4     0             0            (-1)             0)
+  where
+    t = n*tan(fovy/2)
+    b = -t
+    r = aspect*t
+    l = -r
+
+-- | Pure orientation matrix defined by Euler angles.
+rotationEuler :: Vec3 -> Proj4
+rotationEuler (Vec3 a b c) = orthogonal $ toOrthoUnsafe $ rotMatrixY a .*. rotMatrixX b .*. rotMatrixZ c
+
+-- | Camera transformation matrix.
+lookat :: Vec3   -- ^ Camera position.
+       -> Vec3   -- ^ Target position.
+       -> Vec3   -- ^ Upward direction.
+       -> Proj4
+lookat pos target up = translateBefore4 (neg pos) (orthogonal $ toOrthoUnsafe r)
+  where
+    w = normalize $ pos &- target
+    u = normalize $ up &^ w
+    v = w &^ u
+    r = transpose $ Mat3 u v w
+
+-- | Continuous camera state (rotated with mouse, moved with arrows)
+userCamera :: Vec3 -> Signal Vec2 -> Signal (Bool, Bool, Bool, Bool, Bool) -> SignalGen Float (Signal (Vec3, Vec3, Vec3, Vec2))
+userCamera startPosition mouseDelta directionKeys = transfer2 (startPosition, zero, zero, zero) calcCam mouseDelta directionKeys
+  where
+    d0 = Vec4 0 0 (-1) 1
+    u0 = Vec4 0 1 0 1
+    calcCam dt dm (ka, kw, ks, kd, turbo) (p0, _, _, m) = (p', d, u, m')
+      where
+        f0 c v = if c then v else zero
+        p' = p0 &+ (f0 kw d &- f0 ks d &+ f0 kd v &- f0 ka v) &* (realToFrac dt * if turbo then 5 else 1)
+        m' = dm &+ m
+        rm = fromProjective $ rotationEuler $ extendZero (m' &* 0.01)
+        d  = trim (rm *. d0) :: Vec3
+        u  = trim (rm *. u0) :: Vec3
+        v  = normalize (d &^ u)
diff --git a/Common/Utils.hs b/Common/Utils.hs
new file mode 100644
--- /dev/null
+++ b/Common/Utils.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE PackageImports #-}
+
+module Common.Utils where
+
+import Control.Applicative
+import Control.Monad
+import Data.Time.Clock
+import "GLFW-b" Graphics.UI.GLFW as GLFW
+import Graphics.Rendering.OpenGL.Raw.Core32 (glViewport)
+import FRP.Elerea.Param
+
+measureDuration :: IO a -> IO (NominalDiffTime, a)
+measureDuration action = do
+    startTime <- getCurrentTime
+    result <- action
+    endTime <- getCurrentTime
+    return (diffUTCTime endTime startTime, result)
+
+initWindow :: String -> Int -> Int -> IO (Signal (Int, Int))
+initWindow title width height = do
+    initialize
+    openWindow defaultDisplayOptions
+        { displayOptions_numRedBits         = 8
+        , displayOptions_numGreenBits       = 8
+        , displayOptions_numBlueBits        = 8
+        , displayOptions_numAlphaBits       = 8
+        , displayOptions_numDepthBits       = 24
+        , displayOptions_width              = width
+        , displayOptions_height             = height
+        , displayOptions_windowIsResizable  = True
+        , displayOptions_openGLVersion      = (3,2)
+        , displayOptions_openGLProfile      = CoreProfile
+--        , displayOptions_openGLForwardCompatible = True
+--        , displayOptions_displayMode    = Fullscreen
+        }
+    setWindowTitle title
+
+    (windowSize, windowSizeSink) <- external (0, 0)
+    setWindowSizeCallback $ \w h -> do
+        glViewport 0 0 (fromIntegral w) (fromIntegral h)
+        windowSizeSink (fromIntegral w, fromIntegral h)
+
+    return windowSize
+
+driveNetwork :: (p -> IO (IO a)) -> IO (Maybe p) -> IO ()
+driveNetwork network driver = do
+    dt <- driver
+    case dt of
+        Just dt -> do
+            join (network dt)
+            driveNetwork network driver
+        Nothing -> return ()
+
+risingEdge :: Signal Bool -> SignalGen p (Signal Bool)
+risingEdge signal = do
+    signal' <- delay True signal
+    memo $ liftA2 (&&) signal (not <$> signal') 
+
+toggle :: Signal Bool -> SignalGen p (Signal Bool)
+toggle = transfer False (const (/=))
diff --git a/ConvolutionFilter.hs b/ConvolutionFilter.hs
new file mode 100644
--- /dev/null
+++ b/ConvolutionFilter.hs
@@ -0,0 +1,228 @@
+{-# LANGUAGE OverloadedStrings, PackageImports, TypeOperators, ParallelListComp, DataKinds #-}
+
+import Control.Monad
+import Control.Monad.Fix
+import qualified Data.ByteString.Char8 as SB
+import qualified Data.Trie as T
+import Data.Time.Clock
+import Data.Vect
+import Data.Vect.Float.Instances ()
+import qualified Data.Vector.Storable as V
+import "GLFW-b" Graphics.UI.GLFW as GLFW
+import Text.Printf
+
+import LC_API
+import LC_Mesh
+
+import Common.Utils
+import Common.GraphicsUtils
+
+windowWidth, windowHeight :: Num a => a
+windowWidth = 512
+windowHeight = 512
+
+weights = gaussianSamples 1000 101
+dirH = V2 1 0
+dirV = V2 0 1
+
+finalImage :: Exp Obj (FrameBuffer 1 V4F)
+finalImage = filterPass dirV (filterPass dirH originalImage)
+  where
+    filterPass dir = convolve dir weights . projectBuffer
+    projectBuffer = PrjFrameBuffer "" tix0
+
+--finalImage = additiveSample "verticalFilter" (projectBuffer (additiveSample "horizontalFilter" (projectBuffer originalImage)))
+--finalImage = originalImage
+
+main :: IO ()
+main = do
+    let pipeline :: Exp Obj (Image 1 V4F)
+        pipeline = PrjFrameBuffer "outFB" tix0 finalImage
+
+    initWindow "LambdaCube 3D Convolution Filter Demo" windowWidth windowHeight
+
+    (duration, renderer) <- measureDuration $ compileRenderer (ScreenOut pipeline)
+    putStrLn $ "Renderer compiled - " ++ show duration
+    
+    putStrLn "Renderer uniform slots:"
+    forM_ (T.toList (slotUniform renderer)) $ \(name, slot) -> do
+        putStrLn $ "  " ++ SB.unpack name
+        forM_ (T.toList slot) $ \(inputName, inputType) -> do
+            putStrLn $ "    " ++ SB.unpack inputName ++ " :: " ++ show inputType
+    
+    putStrLn "Renderer stream slots:"
+    forM_ (T.toList (slotStream renderer)) $ \(name, (primitive, attributes)) -> do
+        putStrLn $ "  " ++ SB.unpack name ++ " - " ++ show primitive
+        forM_ (T.toList attributes) $ \(attributeName, attributeType) -> do
+            putStrLn $ "    " ++ SB.unpack attributeName ++ " :: " ++ show attributeType
+
+    quadMesh <- compileMesh quad
+    addMesh renderer "postSlot" quadMesh []
+    
+    horizontalSamplingMesh <- compileMesh (samplingQuads dirH weights)
+    verticalSamplingMesh <- compileMesh (samplingQuads dirV weights)
+    addMesh renderer "horizontalFilter" horizontalSamplingMesh []
+    addMesh renderer "verticalFilter" verticalSamplingMesh []
+    
+    addMesh renderer "geometrySlot" quadMesh []
+
+    startTime <- getCurrentTime
+    flip fix (0, startTime) $ \loop (frameCount, lastTime) -> do
+        input <- readInput
+        case input of
+            Nothing -> return ()
+            Just dt -> do
+                (w, h) <- getWindowDimensions
+                setScreenSize renderer (fromIntegral w) (fromIntegral h)
+                render renderer
+                swapBuffers
+                currentTime <- getCurrentTime
+                let elapsedTime = realToFrac (diffUTCTime currentTime lastTime) :: Float
+                    next = case elapsedTime > 5.0 of 
+                        True -> (0, currentTime)
+                        False -> frameCount' `seq` (frameCount', lastTime)
+                          where
+                            frameCount' = frameCount+1
+                when (fst next == 0) $
+                    printf "%d frames in %0.3f seconds (%0.2f ms/f)\n" (round frameCount :: Int) elapsedTime (1000 * elapsedTime / frameCount) 
+                loop next
+
+    dispose renderer
+    putStrLn "Renderer destroyed."
+
+    closeWindow
+
+readInput :: IO (Maybe Float)
+readInput = do
+    t <- getTime
+    resetTime
+
+    k <- keyIsPressed KeyEsc
+    return $ if k then Nothing else Just (realToFrac t)
+
+-- the threshold and offsetWeight optimisations can be commented out independently
+gaussianSamples :: Float -> Int -> [(Float, Float)]
+gaussianSamples tolerance = normalise . threshold tolerance . offsetWeight . withOffsets . binomialCoefficients
+
+binomialCoefficients :: Int -> [Float]
+binomialCoefficients n = iterate next [1] !! (n-1)
+  where
+    next xs = [x+y | x <- xs ++ [0] | y <- 0:xs]
+
+withOffsets :: [Float] -> [(Float, Float)]
+withOffsets cs = [(o, c) | c <- cs | o <- [-lim..lim]]
+  where
+    lim = fromIntegral (length cs `quot` 2)
+
+offsetWeight :: [(Float, Float)] -> [(Float, Float)]
+offsetWeight [] = []
+offsetWeight [ow] = [ow] 
+offsetWeight ((o1,w1):(o2,w2):ows) = (o1+w2/w', w') : offsetWeight ows
+  where
+    w' = w1+w2
+
+threshold :: Float -> [(Float, Float)] -> [(Float, Float)]
+threshold t ocs = [oc | oc@(_, c) <- ocs, c*t >= m]
+  where
+    m = maximum [c | (_, c) <- ocs]
+
+normalise :: [(Float, Float)] -> [(Float, Float)]
+normalise ocs = [(o, c/s) | (o, c) <- ocs]
+  where
+    s = sum [c | (_, c) <- ocs]
+
+originalImage :: Exp Obj (FrameBuffer 1 V4F)
+originalImage = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = AccumulationContext Nothing (ColorOp NoBlending (one' :: V4B) :. ZT)
+    clearBuf = FrameBuffer (ColorImage n1 (V4 0 0 0 1) :. ZT)
+    prims = Transform vert (Fetch "geometrySlot" Triangles (IV2F "position"))
+    
+    vert :: Exp V V2F -> VertexOut () ()
+    vert pos = VertexOut pos' (floatV 1) ZT ZT
+      where
+        V2 x y = unpack' pos
+        pos' = pack' (V4 x y (floatV 0) (floatV 1))
+    
+    frag :: Exp F () -> FragmentOut (Color V4F :+: ZZ)
+    frag _ = FragmentOut (col :. ZT)
+      where
+        V4 x y _ _ = unpack' fragCoord'
+        x' = sqrt' x @* floatF 16
+        y' = sqrt' y @* floatF 16
+        r = Cond ((x' @+ y') @% (floatF 50) @< (floatF 25)) (floatF 0) (floatF 1)
+        g = floatF 0
+        b = Cond ((x' @- y') @% (floatF 50) @< (floatF 25)) (floatF 0) (floatF 1)
+        col = pack' (V4 r g b (floatF 1))
+
+convolve :: V2F -> [(Float, Float)] -> Exp Obj (Image 1 V4F) -> Exp Obj (FrameBuffer 1 V4F)
+convolve (V2 dx dy) weights img = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    resX = windowWidth
+    resY = windowHeight
+    dir' :: Exp F V2F
+    dir' = Const (V2 (dx / fromIntegral resX) (dy / fromIntegral resY))
+    
+    accCtx = AccumulationContext Nothing (ColorOp NoBlending (one' :: V4B) :. ZT)
+    clearBuf = FrameBuffer (ColorImage n1 (V4 0 0 0 1) :. ZT)
+    prims = Transform vert (Fetch "postSlot" Triangles (IV2F "position"))
+
+    vert :: Exp V V2F -> VertexOut () V2F
+    vert uv = VertexOut pos (Const 1) ZT (NoPerspective uv' :. ZT)
+      where
+        uv'    = uv @* floatV 0.5 @+ floatV 0.5
+        pos    = pack' (V4 u v (floatV 1) (floatV 1))
+        V2 u v = unpack' uv
+
+    frag :: Exp F V2F -> FragmentOut (Color V4F :+: ZZ)
+    frag uv = FragmentOut (sample :. ZT)
+      where
+        sample = foldr1 (@+) [ texture' smp (uv @+ dir' @* floatF ofs) @* floatF coeff
+                             | (ofs, coeff) <- weights]
+        smp = Sampler LinearFilter ClampToEdge tex
+        tex = Texture (Texture2D (Float RGBA) n1) (V2 resX resY) NoMip [img]
+
+additiveSample :: SB.ByteString -> Exp Obj (Image 1 V4F) -> Exp Obj (FrameBuffer 1 V4F)
+additiveSample slot img = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    resX = windowWidth
+    resY = windowHeight
+    
+    accCtx = AccumulationContext Nothing (ColorOp blendEquation (one' :: V4B) :. ZT)
+    blendEquation = Blend (FuncAdd, FuncAdd) ((SrcAlpha, One), (SrcAlpha, One)) (V4 1 1 1 1)
+    clearBuf = FrameBuffer (ColorImage n1 (V4 0 0 0 1) :. ZT)
+    prims = Transform vert (Fetch slot Triangles (IV2F "position", IV2F "uv", IFloat "alpha"))
+
+    vert :: Exp V (V2F, V2F, Float) -> VertexOut () (V2F, Float)
+    vert attr = VertexOut pos' (Const 1) ZT (NoPerspective uv :. Flat alpha :. ZT)
+      where
+        pos'   = pack' (V4 x y (floatV 1) (floatV 1))
+        V2 x y = unpack' pos
+        (pos, uv, alpha) = untup3 attr
+
+    frag :: Exp F (V2F, Float) -> FragmentOut (Color V4F :+: ZZ)
+    frag attr = FragmentOut (pack' (V4 r g b alpha) :. ZT)
+      where
+        V4 r g b _ = unpack' (texture' smp uv)
+        smp = Sampler LinearFilter ClampToEdge tex
+        tex = Texture (Texture2D (Float RGBA) n1) (V2 resX resY) NoMip [img]
+        (uv, alpha) = untup2 attr
+
+samplingQuads :: V2F -> [(Float, Float)] -> Mesh
+samplingQuads (V2 dx dy) weights = Mesh
+    { mAttributes = T.fromList
+                    [ ("position", A_V2F $ V.fromList (concat (replicate (length weights) quadCoords)))
+                    , ("uv", A_V2F $ V.fromList (concatMap makeUVs weights))
+                    , ("alpha", A_Float $ V.fromList (concatMap makeAlphas weights))
+                    ]
+    , mPrimitive = P_Triangles
+    , mGPUData = Nothing
+    }
+  where
+    infixr 0 ^
+    (^) = V2
+    quadCoords = [-1 ^ 1, -1 ^ -1, 1 ^ -1, 1 ^ -1, 1 ^ 1, -1 ^ 1]
+    makeUVs (ofs, _) = [V2 (x*0.5+0.5+dx*ofs/resX) (y*0.5+0.5+dy*ofs/resY) | V2 x y <- quadCoords]
+    makeAlphas (_,w) = map (const w) quadCoords
+    resX = windowWidth
+    resY = windowHeight
diff --git a/CubeMap.hs b/CubeMap.hs
new file mode 100644
--- /dev/null
+++ b/CubeMap.hs
@@ -0,0 +1,271 @@
+{-# OPTIONS -cpp #-}
+{-# LANGUAGE OverloadedStrings, PackageImports, TypeOperators, DataKinds #-}
+
+import Control.Applicative hiding (Const)
+import Control.Monad
+import qualified Data.ByteString.Char8 as SB
+import qualified Data.Trie as T
+import Data.Vect hiding (reflect')
+import Data.Vect.Float.Instances ()
+import FRP.Elerea.Param
+import "GLFW-b" Graphics.UI.GLFW as GLFW
+import Text.Printf
+
+import LC_API
+import LC_Mesh
+
+import Common.Utils
+import Common.GraphicsUtils
+
+#ifdef CAPTURE
+import Graphics.Rendering.OpenGL.Raw.Core32
+import Codec.Image.DevIL
+import Text.Printf
+import Foreign
+
+withFrameBuffer :: Int -> Int -> Int -> Int -> (Ptr Word8 -> IO ()) -> IO ()
+withFrameBuffer x y w h fn = allocaBytes (w*h*4) $ \p -> do
+    glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) gl_RGBA gl_UNSIGNED_BYTE $ castPtr p
+    fn p
+#endif
+
+main :: IO ()
+main = do
+#ifdef CAPTURE
+    ilInit
+#endif
+    
+    let pipeline :: Exp Obj (Image 1 V4F)
+        pipeline = PrjFrameBuffer "outFB" tix0 sceneRender
+
+    windowSize <- initWindow "LambdaCube 3D Cube Map Demo" 1280 720
+
+    (duration, renderer) <- measureDuration $ compileRenderer (ScreenOut pipeline)
+    putStrLn $ "Renderer compiled - " ++ show duration
+    
+    putStrLn "Renderer uniform slots:"
+    forM_ (T.toList (slotUniform renderer)) $ \(name, slot) -> do
+        putStrLn $ "  " ++ SB.unpack name
+        forM_ (T.toList slot) $ \(inputName, inputType) -> do
+            putStrLn $ "    " ++ SB.unpack inputName ++ " :: " ++ show inputType
+    
+    putStrLn "Renderer stream slots:"
+    forM_ (T.toList (slotStream renderer)) $ \(name, (primitive, attributes)) -> do
+        putStrLn $ "  " ++ SB.unpack name ++ " - " ++ show primitive
+        forM_ (T.toList attributes) $ \(attributeName, attributeType) -> do
+            putStrLn $ "    " ++ SB.unpack attributeName ++ " :: " ++ show attributeType
+
+    quadMesh <- compileMesh quad
+    addMesh renderer "postSlot" quadMesh []
+
+    cubeMesh <- compileMesh (cube 1)
+    
+    (duration, cubeObjects) <- measureDuration $ replicateM 6 $ addMesh renderer "geometrySlot" cubeMesh ["modelMatrix"]
+    putStrLn $ "Cube meshes added - " ++ show duration
+    
+    reflectorMesh <- compileMesh (capsule 2.5 3.5 25) -- (sphere 5 25)
+    (duration, reflectorObject) <- measureDuration $ addMesh renderer "reflectSlot" reflectorMesh ["modelMatrix"]
+
+    putStrLn $ "Reflector mesh added - " ++ show duration
+    
+    let objectSlots = reflectorSlot : map objectUniformSetter cubeObjects
+        reflectorSlot = objectUniformSetter reflectorObject
+        sceneSlots = uniformSetter renderer
+
+        draw command = do
+            render renderer
+            command
+            swapBuffers
+
+    sceneSignal <- start $ do
+        thread <- scene (setScreenSize renderer) sceneSlots objectSlots windowSize
+        return $ draw <$> thread
+    driveNetwork sceneSignal readInput
+
+    dispose renderer
+    putStrLn "Renderer destroyed."
+
+    closeWindow
+
+scene setSize sceneSlots (reflectorSlot:planeSlot:cubeSlots) windowSize = do
+    pause <- toggle =<< risingEdge =<< effectful (keyIsPressed (CharKey 'P'))
+    time <- transfer 0 (\dt paused time -> time + if paused then 0 else dt) pause 
+    
+    capture <- toggle =<< risingEdge =<< effectful (keyIsPressed (CharKey 'C'))
+    frameCount <- stateful (0 :: Int) (const (+1))
+    
+    fpsTracking <- stateful (0, 0, Nothing) $ \dt (time, count, _) -> 
+        let time' = time + dt
+            done = time > 5
+        in if done
+           then (0, 0, Just (count / time'))
+           else (time', count + 1, Nothing)
+
+    mousePosition <- effectful $ do
+        (x, y) <- getMousePosition
+        return $ Vec2 (fromIntegral x) (fromIntegral y)
+    directionControl <- effectful $ (,,,,)
+                 <$> keyIsPressed KeyLeft
+                 <*> keyIsPressed KeyUp
+                 <*> keyIsPressed KeyDown
+                 <*> keyIsPressed KeyRight
+                 <*> keyIsPressed KeyRightShift
+    
+    mousePosition' <- delay zero mousePosition
+    camera <- userCamera (Vec3 (-4) 0 10) (mousePosition - mousePosition') directionControl
+    
+    let setViewCameraMatrix = uniformM44F "viewCameraMatrix" sceneSlots . fromMat4
+        setViewCameraPosition = uniformV3F "viewCameraPosition" sceneSlots . fromVec3
+        setCubeCameraMatrix i = uniformM44F (cubeMatrixName i) sceneSlots . fromMat4
+        setCubeCameraPosition = uniformV3F "cubeCameraPosition" sceneSlots . fromVec3
+        setLightPosition = uniformV3F "lightPosition" sceneSlots . fromVec3
+        setPlaneModelMatrix = uniformM44F "modelMatrix" planeSlot . fromMat4
+        setCubeModelMatrices = [uniformM44F "modelMatrix" cubeSlot . fromMat4 | cubeSlot <- cubeSlots]
+        setReflectorModelMatrix = uniformM44F "modelMatrix" reflectorSlot . fromMat4
+        
+        setupRendering ((_, _, fps), frameCount, capture) (windowWidth, windowHeight) (cameraPosition, cameraDirection, cameraUp, _) time = do
+            let aspect = fromIntegral windowWidth / fromIntegral windowHeight
+                
+                cameraView = fromProjective (lookat cameraPosition (cameraPosition &+ cameraDirection) cameraUp)
+                cameraProjection = perspective 0.1 50 (pi/2) aspect
+
+                lightPosition = Vec3 (15 * sin time) 2 10
+                reflectorPosition = Vec3 (-8) (5 * sin (time * 0.25)) 0
+                
+                cubeCameraProjection = perspective 0.1 50 (pi/2) 1
+                cubeLookAt dir up = fromProjective (lookat reflectorPosition (reflectorPosition &+ dir) up)
+                cubeCameraMatrix 1 = cubeLookAt (Vec3 1 0 0) (Vec3 0 (-1) 0)
+                cubeCameraMatrix 2 = cubeLookAt (Vec3 (-1) 0 0) (Vec3 0 (-1) 0)
+                cubeCameraMatrix 3 = cubeLookAt (Vec3 0 1 0) (Vec3 0 0 1)
+                cubeCameraMatrix 4 = cubeLookAt (Vec3 0 (-1) 0) (Vec3 0 0 (-1))
+                cubeCameraMatrix 5 = cubeLookAt (Vec3 0 0 1) (Vec3 0 (-1) 0)
+                cubeCameraMatrix 6 = cubeLookAt (Vec3 0 0 (-1)) (Vec3 0 (-1) 0)
+            
+            case fps of
+                Just value -> putStrLn $ "FPS: " ++ show value
+                Nothing -> return ()
+            
+            setViewCameraMatrix (cameraView .*. cameraProjection)
+            setViewCameraPosition cameraPosition
+            setLightPosition lightPosition
+            
+            setCubeCameraPosition reflectorPosition
+            setReflectorModelMatrix (fromProjective (translation reflectorPosition))
+            forM_ [1..6] $ \index -> setCubeCameraMatrix index (cubeCameraMatrix index .*. cubeCameraProjection)
+    
+            setPlaneModelMatrix (fromProjective $ scaling (Vec3 12 12 1) .*. translation (Vec3 0 (-2) (-12)))
+            forM_ (zip setCubeModelMatrices [0..]) $ \(setCubeModelMatrix, i) -> do
+                let t = i * 2 * pi / 5
+                    s = (t + 2) * 0.3
+                    trans = scaling (Vec3 s s s) .*. rotationEuler (Vec3 0 0 s) .*. translation (Vec3 (t * 0.3) (sin t * 4) (cos t * 4))
+                setCubeModelMatrix (fromProjective trans)
+            setSize (fromIntegral windowWidth) (fromIntegral windowHeight)
+            
+            return $ do
+#ifdef CAPTURE
+                when capture $ do
+                    glFinish
+                    withFrameBuffer 0 0 windowWidth windowHeight $ writeImageFromPtr (printf "frame%08d.jpg" frameCount) (windowHeight, windowWidth)
+#endif
+                return ()
+    
+    effectful4 setupRendering ((,,) <$> fpsTracking <*> frameCount <*> capture) windowSize camera time
+
+readInput :: IO (Maybe Float)
+readInput = do
+    t <- getTime
+    resetTime
+
+    k <- keyIsPressed KeyEsc
+    return $ if k then Nothing else Just (realToFrac t)
+
+sceneRender :: Exp Obj (FrameBuffer 1 (Float, V4F))
+sceneRender = Accumulate accCtx PassAll reflectFrag (Rasterize rastCtx reflectPrims) directRender
+  where
+    directRender = Accumulate accCtx PassAll frag (Rasterize rastCtx directPrims) clearBuf
+    cubeMapRender = Accumulate accCtx PassAll frag (Rasterize rastCtx cubePrims) clearBuf6
+    
+    accCtx = AccumulationContext Nothing (DepthOp Less True :. ColorOp NoBlending (one' :: V4B) :. ZT)
+    rastCtx = triangleCtx { ctxCullMode = CullFront CCW }
+    clearBuf = FrameBuffer (DepthImage n1 1000 :. ColorImage n1 (V4 0.1 0.2 0.6 1) :. ZT)
+    clearBuf6 = FrameBuffer (DepthImage n6 1000 :. ColorImage n6 (V4 0.05 0.1 0.3 1) :. ZT)
+    worldInput = Fetch "geometrySlot" Triangles (IV3F "position", IV3F "normal")
+    reflectInput = Fetch "reflectSlot" Triangles (IV3F "position", IV3F "normal")
+    directPrims = Transform directVert worldInput
+    cubePrims = Reassemble geom (Transform cubeMapVert worldInput)
+    reflectPrims = Transform directVert reflectInput
+
+    lightPosition = Uni (IV3F "lightPosition")
+    viewCameraMatrix = Uni (IM44F "viewCameraMatrix")
+    viewCameraPosition = Uni (IV3F "viewCameraPosition")
+    cubeCameraMatrix i = Uni (IM44F (cubeMatrixName i))
+    cubeCameraPosition = Uni (IV3F "cubeCameraPosition")
+    modelMatrix = Uni (IM44F "modelMatrix")
+    
+    transformGeometry :: Exp f V4F -> Exp f V3F -> Exp f M44F -> (Exp f V4F, Exp f V4F, Exp f V3F)
+    transformGeometry localPos localNormal viewMatrix = (viewPos, worldPos, worldNormal)
+      where
+        worldPos = modelMatrix @*. localPos
+        viewPos = viewMatrix @*. worldPos
+        worldNormal = normalize' (v4v3 (modelMatrix @*. n3v4 localNormal))
+
+    directVert :: Exp V (V3F, V3F) -> VertexOut () (V3F, V3F, V3F)
+    directVert attr = VertexOut viewPos (floatV 1) ZT (Smooth (v4v3 worldPos) :. Smooth worldNormal :. Flat viewCameraPosition :. ZT)
+      where
+        (localPos, localNormal) = untup2 attr
+        (viewPos, worldPos, worldNormal) = transformGeometry (v3v4 localPos) localNormal viewCameraMatrix
+
+    cubeMapVert :: Exp V (V3F, V3F) -> VertexOut () V3F
+    cubeMapVert attr = VertexOut (v3v4 localPos) (floatV 1) ZT (Smooth localNormal :. ZT)
+      where
+        (localPos, localNormal) = untup2 attr
+
+    geom :: GeometryShader Triangle Triangle () () 6 V3F (V3F, V3F, V3F) 
+    geom = GeometryShader n6 TrianglesOutput 18 init prim vert
+      where
+        init attr = tup2 (primInit, intG 6)
+          where
+            primInit = tup2 (intG 0, attr)
+        prim primState = tup5 (layer, layer, primState', vertInit, intG 3) 
+          where
+            (layer, attr) = untup2 primState
+            primState' = tup2 (layer @+ intG 1, attr)
+            vertInit = tup3 (intG 0, viewMatrix, attr)
+            viewMatrix = indexG (map cubeCameraMatrix [1..6]) layer
+        vert vertState = GeometryOut vertState' viewPos pointSize ZT (Smooth (v4v3 worldPos) :. Smooth worldNormal :. Flat cubeCameraPosition :. ZT)
+          where
+            (index, viewMatrix, attr) = untup3 vertState
+            vertState' = tup3 (index @+ intG 1, viewMatrix, attr)
+            (attr0, attr1, attr2) = untup3 attr
+            (localPos, pointSize, _, localNormal) = untup4 (indexG [attr0, attr1, attr2] index)
+            (viewPos, worldPos, worldNormal) = transformGeometry localPos localNormal viewMatrix
+
+    frag :: Exp F (V3F, V3F, V3F) -> FragmentOut (Depth Float :+: Color V4F :+: ZZ)
+    frag attr = FragmentOutRastDepth (luminance :. ZT)
+      where
+        lambert = max' (floatF 0) (worldNormal @. normalize' (lightPosition @- worldPos))
+        reflectedRay = normalize' (reflect' (worldPos @- (cameraPosition :: Exp F V3F)) worldNormal)
+        directLight = normalize' (lightPosition @- worldPos)
+        phong = max' (floatF 0) (reflectedRay @. directLight)
+        colour = pack' (V3 (floatF 0.7) (floatF 0.05) (floatF 0))
+        luminance = v3v4 (colour @* lambert @+ pow' phong (floatF 10))
+        (worldPos, worldNormal, cameraPosition) = untup3 attr
+
+    reflectFrag :: Exp F (V3F, V3F, V3F) -> FragmentOut (Depth Float :+: Color V4F :+: ZZ)
+    reflectFrag attr = FragmentOutRastDepth (luminance :. ZT)
+      where
+        reflectedRay = reflect' (worldPos @- (cameraPosition :: Exp F V3F)) worldNormal
+        luminance = reflectionSample reflectedRay
+        (worldPos, worldNormal, cameraPosition) = untup3 attr
+        reflectionSample dir = texture' (Sampler LinearFilter ClampToEdge reflectionMap) dir
+        reflectionMap = Texture (TextureCube (Float RGBA)) (V2 256 256) NoMip [PrjFrameBuffer "" tix0 cubeMapRender]
+
+indexG :: GPU a => [Exp G a] -> Exp G Int32 -> Exp G a
+indexG xs index = go xs 0
+  where
+    go [x] _ = x
+    go (x:xs) i = Cond (index @== intG i) x (go xs (i+1))
+
+cubeMatrixName :: Int -> SB.ByteString
+cubeMatrixName i = SB.pack (printf "cubeCameraMatrix%d" i)
+
diff --git a/Hello.hs b/Hello.hs
new file mode 100644
--- /dev/null
+++ b/Hello.hs
@@ -0,0 +1,228 @@
+{-# LANGUAGE OverloadedStrings, PackageImports, TypeOperators, DataKinds #-}
+
+import "GLFW-b" Graphics.UI.GLFW as GLFW
+import Control.Monad
+import Data.Vect
+import qualified Data.Trie as T
+import qualified Data.Vector.Storable as SV
+
+import LC_API
+import LC_Mesh
+
+import Codec.Image.STB hiding (Image)
+
+import Paths_lambdacube_samples (getDataFileName)
+
+--  Our vertices. Tree consecutive floats give a 3D vertex; Three consecutive vertices give a triangle.
+--  A cube has 6 faces with 2 triangles each, so this makes 6*2=12 triangles, and 12*3 vertices
+g_vertex_buffer_data =
+    [ ( 1.0, 1.0,-1.0)
+    , ( 1.0,-1.0,-1.0)
+    , (-1.0,-1.0,-1.0)
+    , ( 1.0, 1.0,-1.0)
+    , (-1.0,-1.0,-1.0)
+    , (-1.0, 1.0,-1.0)
+    , ( 1.0, 1.0,-1.0)
+    , ( 1.0, 1.0, 1.0)
+    , ( 1.0,-1.0, 1.0)
+    , ( 1.0, 1.0,-1.0)
+    , ( 1.0,-1.0, 1.0)
+    , ( 1.0,-1.0,-1.0)
+    , ( 1.0, 1.0, 1.0)
+    , (-1.0,-1.0, 1.0)
+    , ( 1.0,-1.0, 1.0)
+    , ( 1.0, 1.0, 1.0)
+    , (-1.0, 1.0, 1.0)
+    , (-1.0,-1.0, 1.0)
+    , (-1.0, 1.0, 1.0)
+    , (-1.0,-1.0,-1.0)
+    , (-1.0,-1.0, 1.0)
+    , (-1.0, 1.0, 1.0)
+    , (-1.0, 1.0,-1.0)
+    , (-1.0,-1.0,-1.0)
+    , ( 1.0, 1.0,-1.0)
+    , (-1.0, 1.0,-1.0)
+    , (-1.0, 1.0, 1.0)
+    , ( 1.0, 1.0,-1.0)
+    , (-1.0, 1.0, 1.0)
+    , ( 1.0, 1.0, 1.0)
+    , ( 1.0, 1.0,-1.0)
+    , ( 1.0, 1.0, 1.0)
+    , (-1.0, 1.0, 1.0)
+    , ( 1.0, 1.0,-1.0)
+    , (-1.0, 1.0, 1.0)
+    , (-1.0, 1.0,-1.0)
+    ]
+
+--  Two UV coordinatesfor each vertex. They were created with Blender.
+g_uv_buffer_data =
+    [ (0.0, 0.0)
+    , (0.0, 1.0)
+    , (1.0, 1.0)
+    , (0.0, 0.0)
+    , (1.0, 1.0)
+    , (1.0, 0.0)
+    , (0.0, 0.0)
+    , (1.0, 0.0)
+    , (1.0, 1.0)
+    , (0.0, 0.0)
+    , (1.0, 1.0)
+    , (0.0, 1.0)
+    , (1.0, 0.0)
+    , (0.0, 1.0)
+    , (1.0, 1.0)
+    , (1.0, 0.0)
+    , (0.0, 0.0)
+    , (0.0, 1.0)
+    , (0.0, 0.0)
+    , (1.0, 1.0)
+    , (0.0, 1.0)
+    , (0.0, 0.0)
+    , (1.0, 0.0)
+    , (1.0, 1.0)
+    , (0.0, 0.0)
+    , (1.0, 0.0)
+    , (1.0, 1.0)
+    , (0.0, 0.0)
+    , (1.0, 1.0)
+    , (0.0, 1.0)
+    , (0.0, 0.0)
+    , (0.0, 1.0)
+    , (1.0, 1.0)
+    , (0.0, 0.0)
+    , (1.0, 1.0)
+    , (1.0, 0.0)
+    ]
+
+cube :: Mesh
+cube = Mesh
+    { mAttributes   = T.fromList
+        [ ("vertexPosition_modelspace", A_V3F $ SV.fromList [V3 x y z | (x,y,z) <- g_vertex_buffer_data])
+        , ("vertexUV",                  A_V2F $ SV.fromList [V2 u v | (u,v) <- g_uv_buffer_data])
+        ]
+    , mPrimitive    = P_Triangles
+    , mGPUData      = Nothing
+    }
+
+texturing :: Exp Obj (VertexStream Triangle (V3F,V2F)) -> Exp Obj (FrameBuffer 1 (Float,V4F))
+texturing objs = Accumulate fragmentCtx PassAll fragmentShader fragmentStream emptyFB
+  where
+    rasterCtx :: RasterContext Triangle
+    rasterCtx = TriangleCtx (CullFront CW) PolygonFill NoOffset LastVertex
+
+    fragmentCtx :: AccumulationContext (Depth Float :+: (Color (V4 Float) :+: ZZ))
+    fragmentCtx = AccumulationContext Nothing $ DepthOp Less True:.ColorOp NoBlending (one' :: V4B):.ZT
+
+    emptyFB :: Exp Obj (FrameBuffer 1 (Float,V4F))
+    emptyFB = FrameBuffer (DepthImage n1 1000:.ColorImage n1 (V4 0 0 0.4 1):.ZT)
+
+    fragmentStream :: Exp Obj (FragmentStream 1 V2F)
+    fragmentStream = Rasterize rasterCtx primitiveStream
+
+    primitiveStream :: Exp Obj (PrimitiveStream Triangle () 1 V V2F)
+    primitiveStream = Transform vertexShader objs
+
+    modelViewProj :: Exp V M44F
+    modelViewProj = Uni (IM44F "MVP")
+
+    vertexShader :: Exp V (V3F,V2F) -> VertexOut () V2F
+    vertexShader puv = VertexOut v4 (Const 1) ZT (Smooth uv:.ZT)
+      where
+        v4 :: Exp V V4F
+        v4 = modelViewProj @*. v3v4 p
+        (p,uv) = untup2 puv
+
+    fragmentShader :: Exp F V2F -> FragmentOut (Depth Float :+: Color V4F :+: ZZ)
+    fragmentShader uv = FragmentOutRastDepth $ color tex uv :. ZT
+      where
+        tex = TextureSlot "myTextureSampler" $ Texture2D (Float RGBA) n1
+
+v3v4 :: Exp s V3F -> Exp s V4F
+v3v4 v = let V3 x y z = unpack' v in pack' $ V4 x y z (Const 1)
+
+color t uv = texture' (smp t) uv
+smp t = Sampler LinearFilter ClampToEdge t
+
+main :: IO ()
+main = do
+    initialize
+    openWindow defaultDisplayOptions
+        { displayOptions_width              = 1024
+        , displayOptions_height             = 768
+        , displayOptions_openGLVersion      = (3,2)
+        , displayOptions_openGLProfile      = CoreProfile
+        }
+    setWindowTitle "LambdaCube 3D Textured Cube"
+
+    let frameImage :: Exp Obj (Image 1 V4F)
+        frameImage = PrjFrameBuffer "" tix0 $ texturing $ Fetch "stream" Triangles (IV3F "vertexPosition_modelspace", IV2F "vertexUV")
+
+    renderer <- compileRenderer $ ScreenOut frameImage
+
+    let uniformMap      = uniformSetter renderer
+        texture         = uniformFTexture2D "myTextureSampler" uniformMap
+        mvp             = uniformM44F "MVP" uniformMap
+        setWindowSize   = setScreenSize renderer
+
+    setWindowSize 1024 768
+    Right img <- loadImage =<< getDataFileName "hello.png"
+    texture =<< compileTexture2DRGBAF True False img
+
+    gpuCube <- compileMesh cube
+    addMesh renderer "stream" gpuCube []
+
+    let cm  = fromProjective (lookat (Vec3 4 3 3) (Vec3 0 0 0) (Vec3 0 1 0))
+        pm  = perspective 0.1 100 (pi/4) (1024 / 768)
+        loop = do
+            t <- getTime
+            let angle = pi / 2 * realToFrac t
+                mm = fromProjective $ rotationEuler $ Vec3 angle 0 0
+            mvp $! mat4ToM44F $! mm .*. cm .*. pm
+            render renderer
+            swapBuffers
+
+            k <- keyIsPressed KeyEsc
+            unless k $ loop
+    loop
+
+    dispose renderer
+    closeWindow
+
+vec4ToV4F :: Vec4 -> V4F
+vec4ToV4F (Vec4 x y z w) = V4 x y z w
+
+mat4ToM44F :: Mat4 -> M44F
+mat4ToM44F (Mat4 a b c d) = V4 (vec4ToV4F a) (vec4ToV4F b) (vec4ToV4F c) (vec4ToV4F d)
+
+-- | Perspective transformation matrix in row major order.
+perspective :: Float  -- ^ Near plane clipping distance (always positive).
+            -> Float  -- ^ Far plane clipping distance (always positive).
+            -> Float  -- ^ Field of view of the y axis, in radians.
+            -> Float  -- ^ Aspect ratio, i.e. screen's width\/height.
+            -> Mat4
+perspective n f fovy aspect = transpose $
+    Mat4 (Vec4 (2*n/(r-l))       0       (-(r+l)/(r-l))        0)
+         (Vec4     0        (2*n/(t-b))  ((t+b)/(t-b))         0)
+         (Vec4     0             0       (-(f+n)/(f-n))  (-2*f*n/(f-n)))
+         (Vec4     0             0            (-1)             0)
+  where
+    t = n*tan(fovy/2)
+    b = -t
+    r = aspect*t
+    l = -r
+
+-- | Pure orientation matrix defined by Euler angles.
+rotationEuler :: Vec3 -> Proj4
+rotationEuler (Vec3 a b c) = orthogonal $ toOrthoUnsafe $ rotMatrixY a .*. rotMatrixX b .*. rotMatrixZ c
+
+-- | Camera transformation matrix.
+lookat :: Vec3   -- ^ Camera position.
+       -> Vec3   -- ^ Target position.
+       -> Vec3   -- ^ Upward direction.
+       -> Proj4
+lookat pos target up = translateBefore4 (neg pos) (orthogonal $ toOrthoUnsafe r)
+  where
+    w = normalize $ pos &- target
+    u = normalize $ up &^ w
+    v = w &^ u
+    r = transpose $ Mat3 u v w
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2014, Csaba Hruska
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Csaba Hruska nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/ShadowMapping.hs b/ShadowMapping.hs
new file mode 100644
--- /dev/null
+++ b/ShadowMapping.hs
@@ -0,0 +1,379 @@
+{-# OPTIONS -cpp #-}
+{-# LANGUAGE OverloadedStrings, PackageImports, TypeOperators, DataKinds #-}
+
+import Control.Applicative hiding (Const)
+import Control.Monad
+import qualified Data.ByteString.Char8 as SB
+import qualified Data.Trie as T
+import Data.Vect
+import Data.Vect.Float.Instances ()
+import FRP.Elerea.Param
+import "GLFW-b" Graphics.UI.GLFW as GLFW
+
+import LC_API
+import LC_Mesh
+
+import Common.Utils
+import Common.GraphicsUtils
+
+#ifdef CAPTURE
+import Graphics.Rendering.OpenGL.Raw.Core32
+import Codec.Image.DevIL
+import Text.Printf
+import Foreign
+
+withFrameBuffer :: Int -> Int -> Int -> Int -> (Ptr Word8 -> IO ()) -> IO ()
+withFrameBuffer x y w h fn = allocaBytes (w*h*4) $ \p -> do
+    glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) gl_RGBA gl_UNSIGNED_BYTE $ castPtr p
+    fn p
+#endif
+
+main :: IO ()
+main = do
+#ifdef CAPTURE
+    ilInit
+#endif
+    
+    let pipeline :: Exp Obj (Image 1 V4F)
+        pipeline = PrjFrameBuffer "outFB" tix0 vsm
+
+    windowSize <- initWindow "LambdaCube 3D Shadow Mapping Demo" 1280 720
+
+    (duration, renderer) <- measureDuration $ compileRenderer (ScreenOut pipeline)
+    putStrLn $ "Renderer compiled - " ++ show duration
+    
+    putStrLn "Renderer uniform slots:"
+    forM_ (T.toList (slotUniform renderer)) $ \(name, slot) -> do
+        putStrLn $ "  " ++ SB.unpack name
+        forM_ (T.toList slot) $ \(inputName, inputType) -> do
+            putStrLn $ "    " ++ SB.unpack inputName ++ " :: " ++ show inputType
+    
+    putStrLn "Renderer stream slots:"
+    forM_ (T.toList (slotStream renderer)) $ \(name, (primitive, attributes)) -> do
+        putStrLn $ "  " ++ SB.unpack name ++ " - " ++ show primitive
+        forM_ (T.toList attributes) $ \(attributeName, attributeType) -> do
+            putStrLn $ "    " ++ SB.unpack attributeName ++ " :: " ++ show attributeType
+
+    quadMesh <- compileMesh quad
+    addMesh renderer "postSlot" quadMesh []
+
+    cubeMesh <- compileMesh (cube 1)
+    
+    (duration, cubeObjects) <- measureDuration $ replicateM 6 $ addMesh renderer "geometrySlot" cubeMesh ["modelMatrix"]
+    putStrLn $ "Cube meshes added - " ++ show duration
+
+    let objectSlots = map objectUniformSetter cubeObjects
+        sceneSlots = uniformSetter renderer
+
+        draw command = do
+            render renderer
+            command
+            swapBuffers
+
+    sceneSignal <- start $ do
+        thread <- scene (setScreenSize renderer) sceneSlots objectSlots windowSize
+        return $ draw <$> thread
+    driveNetwork sceneSignal readInput
+
+    dispose renderer
+    putStrLn "Renderer destroyed."
+
+    closeWindow
+
+scene setSize sceneSlots (planeSlot:cubeSlots) windowSize = do
+    pause <- toggle =<< risingEdge =<< effectful (keyIsPressed (CharKey 'P'))
+    time <- transfer 0 (\dt paused time -> time + if paused then 0 else dt) pause 
+    
+    capture <- risingEdge =<< effectful (keyIsPressed (CharKey 'C'))
+    frameCount <- stateful (0 :: Int) (const (+1))
+    
+    fpsTracking <- stateful (0, 0, Nothing) $ \dt (time, count, _) -> 
+        let time' = time + dt
+            done = time > 5
+        in if done
+           then (0, 0, Just (count / time'))
+           else (time', count + 1, Nothing)
+
+    mousePosition <- effectful $ do
+        (x, y) <- getMousePosition
+        return $ Vec2 (fromIntegral x) (fromIntegral y)
+    directionControl <- effectful $ (,,,,)
+                 <$> keyIsPressed KeyLeft
+                 <*> keyIsPressed KeyUp
+                 <*> keyIsPressed KeyDown
+                 <*> keyIsPressed KeyRight
+                 <*> keyIsPressed KeyRightShift
+    
+    mousePosition' <- delay zero mousePosition
+    camera <- userCamera (Vec3 (-4) 0 0) (mousePosition - mousePosition') directionControl
+    
+    let setCameraMatrix = uniformM44F "cameraMatrix" sceneSlots . fromMat4
+        setLightMatrix = uniformM44F "lightMatrix" sceneSlots . fromMat4
+        setLightPosition = uniformV3F "lightPosition" sceneSlots . fromVec3
+        setPlaneModelMatrix = uniformM44F "modelMatrix" planeSlot . fromMat4
+        setCubeModelMatrices = [uniformM44F "modelMatrix" cubeSlot . fromMat4 | cubeSlot <- cubeSlots]
+        
+        setupRendering ((_, _, fps), frameCount, capture) (windowWidth, windowHeight) (cameraPosition, cameraDirection, cameraUp, _) time = do
+            let aspect = fromIntegral windowWidth / fromIntegral windowHeight
+                
+                cameraView = fromProjective (lookat cameraPosition (cameraPosition &+ cameraDirection) cameraUp)
+                cameraProjection = perspective 0.1 50 (pi/2) aspect
+
+                lightPosition = Vec3 (5 * sin time) 2 10
+                lightDirection = Vec3 0 (-0.2) (-1)
+                lightUp = Vec3 0 1 0
+                
+                lightView = fromProjective (lookat lightPosition (lightPosition &+ lightDirection) lightUp)
+                lightProjection = perspective 0.1 100 (pi/2) aspect
+            
+            case fps of
+                Just value -> putStrLn $ "FPS: " ++ show value
+                Nothing -> return ()
+            
+            setCameraMatrix (cameraView .*. cameraProjection)
+            setLightMatrix (lightView .*. lightProjection)
+            setLightPosition lightPosition
+            
+            setPlaneModelMatrix (fromProjective $ scaling (Vec3 12 12 1) .*. translation (Vec3 0 (-2) (-12)))
+            forM_ (zip setCubeModelMatrices [0..]) $ \(setCubeModelMatrix, i) -> do
+                let t = i * 2 * pi / 5
+                    s = (t + 2) * 0.3
+                    trans = scaling (Vec3 s s s) .*. rotationEuler (Vec3 0 0 s) .*. translation (Vec3 (t * 0.3) (sin t * 4) (cos t * 4))
+                setCubeModelMatrix (fromProjective trans)
+            setSize (fromIntegral windowWidth) (fromIntegral windowHeight)
+            
+            return $ do
+#ifdef CAPTURE
+                when capture $ do
+                    glFinish
+                    withFrameBuffer 0 0 windowWidth windowHeight $ writeImageFromPtr (printf "frame%08d.jpg" frameCount) (windowHeight, windowWidth)
+#endif
+                return ()
+            
+    
+    effectful4 setupRendering ((,,) <$> fpsTracking <*> frameCount <*> capture) windowSize camera time
+
+readInput :: IO (Maybe Float)
+readInput = do
+    t <- getTime
+    resetTime
+
+    k <- keyIsPressed KeyEsc
+    return $ if k then Nothing else Just (realToFrac t)
+
+shadowMapSize :: Num a => a
+shadowMapSize = 512
+
+blurCoefficients :: [(Float, Float)]
+blurCoefficients = gaussFilter9
+
+gaussFilter7 :: [(Float, Float)]
+gaussFilter7 = 
+    [ (-3.0,   0.015625)
+    , (-2.0,   0.09375)
+    , (-1.0,   0.234375)
+    , (0.0,    0.3125)
+    , (1.0,    0.234375)
+    , (2.0,    0.09375)
+    , (3.0,    0.015625)
+    ]
+
+gaussFilter9 :: [(Float, Float)]
+gaussFilter9 = 
+    [ (-4.0,   0.05)
+    , (-3.0,   0.09)
+    , (-2.0,   0.12)
+    , (-1.0,   0.15)
+    , (0.0,    0.16)
+    , (1.0,    0.15)
+    , (2.0,    0.12)
+    , (3.0,    0.09)
+    , (4.0,    0.05)
+    ]
+
+blur :: [(Float, Float)] -> Exp Obj (Image 1 V2F) -> Exp Obj (FrameBuffer 1 V2F)
+blur coefficients img = filter1D dirH (PrjFrameBuffer "" tix0 (filter1D dirV img))
+  where
+    dirH v = Const (V2 (v / shadowMapSize) 0) :: Exp F V2F
+    dirV v = Const (V2 0 (v / shadowMapSize)) :: Exp F V2F
+    
+    filter1D :: (Float -> Exp F V2F) -> Exp Obj (Image 1 V2F) -> Exp Obj (FrameBuffer 1 V2F)
+    filter1D dir img = Accumulate accCtx PassAll frag
+                                 (Rasterize triangleCtx prims) clearBuf
+      where
+        accCtx = AccumulationContext Nothing
+                                    (ColorOp NoBlending (one' :: V2B) :. ZT)
+        clearBuf = FrameBuffer (ColorImage n1 (V2 0 0) :. ZT)
+        prims = Transform vert (Fetch "postSlot" Triangles (IV2F "position"))
+
+        vert :: Exp V V2F -> VertexOut () V2F
+        vert uv = VertexOut pos (Const 1) ZT (NoPerspective uv' :. ZT)
+          where
+            uv'    = uv @* floatV 0.5 @+ floatV 0.5
+            pos    = pack' (V4 u v (floatV 1) (floatV 1))
+            V2 u v = unpack' uv
+
+        frag :: Exp F V2F -> FragmentOut (Color V2F :+: ZZ)
+        frag uv = FragmentOut (sample :. ZT)
+          where
+            sample = foldr1 (@+) [ texture' smp (uv @+ dir ofs) @* floatF coeff
+                                 | (ofs, coeff) <- coefficients]
+            smp = Sampler LinearFilter ClampToEdge tex
+            tex = Texture (Texture2D (Float RG) n1)
+                          (V2 shadowMapSize shadowMapSize) NoMip [img]
+    
+
+moments :: Exp Obj (FrameBuffer 1 (Float, V2F))
+moments = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = AccumulationContext Nothing (DepthOp Less True :. ColorOp NoBlending (one' :: V2B) :. ZT)
+    clearBuf = FrameBuffer (DepthImage n1 1000 :. ColorImage n1 (V2 0 0) :. ZT)
+    prims = Transform vert (Fetch "geometrySlot" Triangles (IV3F "position"))
+    
+    lightMatrix = Uni (IM44F "lightMatrix")
+    modelMatrix = Uni (IM44F "modelMatrix")
+
+    vert :: Exp V V3F -> VertexOut () Float
+    vert pos = VertexOut lightPos (floatV 1) ZT (Smooth depth :. ZT)
+      where
+        lightPos = lightMatrix @*. modelMatrix @*. v3v4 pos
+        V4 _ _ depth _ = unpack' lightPos
+
+    frag :: Exp F Float -> FragmentOut (Depth Float :+: Color V2F :+: ZZ)
+    frag depth = FragmentOutRastDepth (pack' (V2 moment1 moment2) :. ZT)
+      where
+        dx = dFdx' depth
+        dy = dFdy' depth
+        moment1 = depth
+        moment2 = depth @* depth @+ floatF 0.25 @* (dx @* dx @+ dy @* dy)
+
+depth :: Exp Obj (FrameBuffer 1 (Float, Float))
+depth = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = AccumulationContext Nothing (DepthOp Less True :. ColorOp NoBlending True :. ZT)
+    clearBuf = FrameBuffer (DepthImage n1 1000 :. ColorImage n1 0 :. ZT)
+    prims = Transform vert (Fetch "geometrySlot" Triangles (IV3F "position"))
+    
+    lightMatrix = Uni (IM44F "lightMatrix")
+    modelMatrix = Uni (IM44F "modelMatrix")
+
+    vert :: Exp V V3F -> VertexOut () Float
+    vert pos = VertexOut lightPos (floatV 1) ZT (Smooth depth :. ZT)
+      where
+        lightPos = lightMatrix @*. modelMatrix @*. v3v4 pos
+        V4 _ _ depth _ = unpack' lightPos
+
+    frag :: Exp F Float -> FragmentOut (Depth Float :+: Color Float :+: ZZ)
+    frag depth = FragmentOutRastDepth (depth :. ZT)
+
+vsm :: Exp Obj (FrameBuffer 1 (Float, V4F))
+vsm = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = AccumulationContext Nothing
+                (DepthOp Less True :. ColorOp NoBlending (one' :: V4B) :. ZT)
+    clearBuf = FrameBuffer (  DepthImage n1 1000
+                           :. ColorImage n1 (V4 0.1 0.2 0.6 1) :. ZT)
+    prims = Transform vert (Fetch "geometrySlot" Triangles (IV3F "position", IV3F "normal"))
+
+    cameraMatrix = Uni (IM44F "cameraMatrix")
+    lightMatrix = Uni (IM44F "lightMatrix")
+    modelMatrix = Uni (IM44F "modelMatrix")
+    lightPosition = Uni (IV3F "lightPosition")
+
+    vert :: Exp V (V3F, V3F) -> VertexOut () (V3F, V4F, V3F)
+    vert attr = VertexOut viewPos (floatV 1) ZT (Smooth (v4v3 worldPos) :. Smooth lightPos :. Smooth worldNormal :. ZT)
+      where
+        worldPos = modelMatrix @*. v3v4 localPos
+        viewPos = cameraMatrix @*. worldPos
+        lightPos = lightMatrix @*. worldPos
+        worldNormal = normalize' (v4v3 (modelMatrix @*. n3v4 localNormal))
+        (localPos, localNormal) = untup2 attr
+
+    frag :: Exp F (V3F, V4F, V3F) -> FragmentOut (Depth Float :+: Color V4F :+: ZZ)
+    frag attr = FragmentOutRastDepth (luminance :. ZT)
+      where
+        V4 lightU lightV lightDepth lightW = unpack' lightPos
+        uv = clampUV (scaleUV (pack' (V2 lightU lightV) @/ lightW))
+        
+        V2 moment1 moment2 = unpack' (texture' sampler uv)
+        variance = max' (floatF 0.002) (moment2 @- moment1 @* moment1)
+        distance = max' (floatF 0) (lightDepth @- moment1)
+        lightProbMax = variance @/ (variance @+ distance @* distance)
+        
+        lambert = max' (floatF 0) (dot' worldNormal (normalize' (lightPosition @- worldPos)))
+        
+        uv' = uv @- floatF 0.5
+        spotShape = floatF 1 @- length' uv' @* floatF 4
+        intensity = max' (floatF 0) (spotShape @* lambert)
+        
+        V2 spotR spotG = unpack' (scaleUV (round' (uv' @* floatF 10)) @* intensity)
+        
+        luminance = pack' (V4 spotR spotG intensity (floatF 1)) @* pow' lightProbMax (floatF 2)
+        
+        clampUV x = clamp' x (floatF 0) (floatF 1)
+        scaleUV x = x @* floatF 0.5 @+ floatF 0.5
+        
+        (worldPos, lightPos, worldNormal) = untup3 attr
+
+    sampler = Sampler LinearFilter ClampToEdge shadowMapBlur
+    
+    shadowMap :: Texture (Exp Obj) Tex2D SingleTex (Regular Float) RG
+    shadowMap = Texture (Texture2D (Float RG) n1) (V2 shadowMapSize shadowMapSize) NoMip [PrjFrameBuffer "shadowMap" tix0 moments]
+
+    shadowMapBlur :: Texture (Exp Obj) Tex2D SingleTex (Regular Float) RG
+    shadowMapBlur = Texture (Texture2D (Float RG) n1) (V2 shadowMapSize shadowMapSize) NoMip [PrjFrameBuffer "shadowMap" tix0 blurredMoments]
+      where
+        blurredMoments = blur blurCoefficients (PrjFrameBuffer "blur" tix0 moments)
+
+sm :: Exp Obj (FrameBuffer 1 (Float, V4F))
+sm = Accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = AccumulationContext Nothing (DepthOp Less True :. ColorOp NoBlending (one' :: V4B) :. ZT)
+    clearBuf = FrameBuffer (DepthImage n1 1000 :. ColorImage n1 (V4 0.1 0.2 0.6 1) :. ZT)
+    prims = Transform vert (Fetch "geometrySlot" Triangles (IV3F "position", IV3F "normal"))
+
+    cameraMatrix = Uni (IM44F "cameraMatrix")
+    lightMatrix = Uni (IM44F "lightMatrix")
+    modelMatrix = Uni (IM44F "modelMatrix")
+    lightPosition = Uni (IV3F "lightPosition")
+
+    vert :: Exp V (V3F, V3F) -> VertexOut () (V3F, V4F, V3F)
+    vert attr = VertexOut viewPos (floatV 1) ZT (Smooth (v4v3 worldPos) :. Smooth lightPos :. Smooth worldNormal :. ZT)
+      where
+        worldPos = modelMatrix @*. v3v4 localPos
+        viewPos = cameraMatrix @*. worldPos
+        lightPos = lightMatrix @*. worldPos
+        worldNormal = normalize' (v4v3 (modelMatrix @*. n3v4 localNormal))
+        (localPos, localNormal) = untup2 attr
+
+    frag :: Exp F (V3F, V4F, V3F) -> FragmentOut (Depth Float :+: Color V4F :+: ZZ)
+    frag attr = FragmentOutRastDepth (luminance :. ZT)
+      where
+        V4 lightU lightV lightDepth lightW = unpack' lightPos
+        uv = clampUV (scaleUV (pack' (V2 lightU lightV) @/ lightW))
+        
+        surfaceDistance = texture' sampler uv
+        lightPortion = Cond (lightDepth @<= surfaceDistance @+ floatF 0.01) (floatF 1) (floatF 0)
+        
+        lambert = max' (floatF 0) (dot' worldNormal (normalize' (lightPosition @- worldPos)))
+        
+        --intensity = lambert @* lightPortion
+        --luminance = pack' (V4 intensity intensity intensity (floatF 1))
+        
+        uv' = uv @- floatF 0.5
+        spotShape = floatF 1 @- length' uv' @* floatF 4
+        intensity = max' (floatF 0) (spotShape @* lambert)
+        
+        V2 spotR spotG = unpack' (scaleUV (round' (uv' @* floatF 10)) @* intensity)
+        
+        luminance = pack' (V4 spotR spotG intensity (floatF 1)) @* lightPortion
+        
+        clampUV x = clamp' x (floatF 0) (floatF 1)
+        scaleUV x = x @* floatF 0.5 @+ floatF 0.5
+        
+        (worldPos, lightPos, worldNormal) = untup3 attr
+
+    sampler = Sampler PointFilter ClampToEdge shadowMap
+    
+    shadowMap :: Texture (Exp Obj) Tex2D SingleTex (Regular Float) Red
+    shadowMap = Texture (Texture2D (Float Red) n1) (V2 shadowMapSize shadowMapSize) NoMip [PrjFrameBuffer "shadowMap" tix0 depth]
diff --git a/hello.png b/hello.png
new file mode 100644
Binary files /dev/null and b/hello.png differ
diff --git a/lambdacube-samples.cabal b/lambdacube-samples.cabal
new file mode 100644
--- /dev/null
+++ b/lambdacube-samples.cabal
@@ -0,0 +1,81 @@
+name:                lambdacube-samples
+version:             0.1.0
+synopsis:            Samples for LambdaCube 3D
+description:
+    Executable samples to showcase the capabilities of LambdaCube
+    3D. Each sample is a separate executable called
+    @lambdacube-\<samplename\>@. The following samples are included
+    (each is described in a separate blog post):
+    .
+    * 'hello': the cannonical rotating cube
+    .
+    * 'convolutionfilter': a simple Gaussian blur (<http://lambdacube3d.wordpress.com/2013/04/11/optimising-convolution-filters/>)
+    .
+    * 'shadowmapping': variance shadow mapping (<http://lambdacube3d.wordpress.com/2012/10/14/variance-shadow-mapping/>)
+    .
+    * 'cubemap': cube mapped reflection using geometry shaders (<http://lambdacube3d.wordpress.com/2012/10/14/variance-shadow-mapping/>)
+    .
+    * 'bulletexample': integration with Bullet physics through Elerea;
+    this sample is optional due to its dependence on Bullet, and you
+    need to install the package with -fBulletInstalled to enable it.
+    (first post: <http://lambdacube3d.wordpress.com/2012/12/20/using-bullet-physics-with-an-frp-approach-part-1/>,
+    second post: <http://lambdacube3d.wordpress.com/2012/12/20/using-bullet-physics-with-an-frp-approach-part-2/>,
+    third post: <http://lambdacube3d.wordpress.com/2012/12/20/using-bullet-physics-with-an-frp-approach-part-3/>)
+ 
+homepage:            http://lambdacube3d.wordpress.com/
+license:             BSD3
+license-file:        LICENSE
+author:              Csaba Hruska, Gergely Patai
+maintainer:          csaba.hruska@gmail.com, patai.gergely@gmail.com
+-- copyright:
+category:            Graphics
+build-type:          Simple
+cabal-version:       >=1.10
+
+extra-source-files:
+    Common/Utils.hs
+    Common/GraphicsUtils.hs
+
+data-files:       hello.png
+
+flag BulletInstalled
+  description:    Enable samples that depend on Bullet
+  default:        False
+
+executable lambdacube-hello
+  main-is:             Hello.hs
+  -- other-modules:
+  other-extensions:    OverloadedStrings, TypeOperators, NoMonomorphismRestriction, ExistentialQuantification, PackageImports, DoRec, ParallelListComp, DataKinds, NamedFieldPuns
+  build-depends:       base >=4.6 && <4.7, mtl >=2.1 && <2.2, bytestring >=0.10 && <0.11, bytestring-trie >=0.2 && <0.3, vect >=0.4 && <0.5, vector >=0.10 && <0.11, elerea >=2.7 && <2.8, lambdacube-core >=0.1 && <0.2, time >=1.4 && <1.5, OpenGLRaw >=1.4 && <1.5, GLFW-b ==0.1.0.5, stb-image ==0.2.1
+  default-language:    Haskell2010
+
+executable lambdacube-shadowmapping
+  main-is:             ShadowMapping.hs
+  -- other-modules:
+  other-extensions:    OverloadedStrings, TypeOperators, NoMonomorphismRestriction, ExistentialQuantification, PackageImports, DoRec, ParallelListComp, DataKinds, NamedFieldPuns
+  build-depends:       base >=4.6 && <4.7, mtl >=2.1 && <2.2, bytestring >=0.10 && <0.11, bytestring-trie >=0.2 && <0.3, vect >=0.4 && <0.5, vector >=0.10 && <0.11, elerea >=2.7 && <2.8, lambdacube-core >=0.1 && <0.2, time >=1.4 && <1.5, OpenGLRaw >=1.4 && <1.5, GLFW-b ==0.1.0.5
+  default-language:    Haskell2010
+
+executable lambdacube-cubemap
+  main-is:             CubeMap.hs
+  -- other-modules:
+  other-extensions:    OverloadedStrings, TypeOperators, NoMonomorphismRestriction, ExistentialQuantification, PackageImports, DoRec, ParallelListComp, DataKinds, NamedFieldPuns
+  build-depends:       base >=4.6 && <4.7, mtl >=2.1 && <2.2, bytestring >=0.10 && <0.11, bytestring-trie >=0.2 && <0.3, vect >=0.4 && <0.5, vector >=0.10 && <0.11, elerea >=2.7 && <2.8, lambdacube-core >=0.1 && <0.2, time >=1.4 && <1.5, OpenGLRaw >=1.4 && <1.5, GLFW-b ==0.1.0.5
+  default-language:    Haskell2010
+
+executable lambdacube-convolutionfilter
+  main-is:             ConvolutionFilter.hs
+  -- other-modules:
+  other-extensions:    OverloadedStrings, TypeOperators, NoMonomorphismRestriction, ExistentialQuantification, PackageImports, DoRec, ParallelListComp, DataKinds, NamedFieldPuns
+  build-depends:       base >=4.6 && <4.7, mtl >=2.1 && <2.2, bytestring >=0.10 && <0.11, bytestring-trie >=0.2 && <0.3, vect >=0.4 && <0.5, vector >=0.10 && <0.11, elerea >=2.7 && <2.8, lambdacube-core >=0.1 && <0.2, time >=1.4 && <1.5, OpenGLRaw >=1.4 && <1.5, GLFW-b ==0.1.0.5
+  default-language:    Haskell2010
+
+executable lambdacube-bulletexample
+  main-is:             BulletExample.hs
+  -- other-modules:
+  other-extensions:    OverloadedStrings, TypeOperators, NoMonomorphismRestriction, ExistentialQuantification, PackageImports, DoRec, ParallelListComp, DataKinds, NamedFieldPuns
+  if flag(BulletInstalled)
+    build-depends:       base >=4.6 && <4.7, mtl >=2.1 && <2.2, bytestring >=0.10 && <0.11, bytestring-trie >=0.2 && <0.3, vect >=0.4 && <0.5, vector >=0.10 && <0.11, elerea >=2.7 && <2.8, bullet >=0.2 && <0.3, lambdacube-core >=0.1 && <0.2, time >=1.4 && <1.5, OpenGLRaw >=1.4 && <1.5, GLFW-b ==0.1.0.5
+  else
+    buildable: False
+  default-language:    Haskell2010