lambdacube-bullet-0.1.1: src/lambdacube-bullet-example.hs

import Data.Maybe
import Data.Map hiding (filter)
import qualified Data.IntMap as IntMap
import Control.Monad
import Control.Applicative
import Foreign
import Foreign.C.Types

import FRP.Elerea
import Graphics.UI.GLFW as GLFW
import Graphics.Rendering.OpenGL as GL hiding (light)
import System.Log.Logger

import Graphics.LambdaCube
import Graphics.LambdaCube.RenderSystem.GL
import qualified Graphics.LambdaCube.Loader.StbImage as Stb
import Physics.Bullet

import Paths_lambdacube_bullet (getDataFileName)

import Utils
import BulletUtils

integral v0 s = transfer v0 (\dt v v0 -> v0+v*realToFrac dt) s

baseMousePos = Position 200 200

main = do
    updateGlobalLogger rootLoggerName (setLevel DEBUG)
    initialize
    openWindow (Size 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window
    windowTitle $= "Lambda-Cube GLFW UnsafeFRP Example 1"
    GLFW.mousePos $= baseMousePos
    GLFW.disableSpecial MouseCursor

    GL.TextureUnit mtu <- GL.get GL.maxTextureUnit
    print $ "max texunit: " ++ (show mtu)

    v <- get vendor
    rend <- get renderer
    ver <- get glVersion
    exts <- get glExtensions
    shver <- get shadingLanguageVersion
--    mm <- get majorMinor
    debugM "gl" $ "vendor: " ++ show v
    debugM "gl" $ "renderer: " ++ show rend
    debugM "gl" $ "glVersion: " ++ show ver
    debugM "gl" $ "glExtensions: " ++ show exts
    debugM "gl" $ "shadingLanguageVersion: " ++ show shver
--    debugM "gl" $ "majorMinor: " ++ show mm

    initGL 640 480
    (windowSize,windowSizeSink) <- external (0,0)
    (mousePosition,mousePositionSink) <- external (0,0)
    (mousePress,mousePressSink) <- external False
    (firePress,firePressSink) <- external False
    (fblrPress,fblrPressSink) <- external (False,False,False,False,False)

    mediaPath <- getDataFileName "media"
    
    windowSizeCallback $= resizeGLScene windowSizeSink
    renderSystem <- mkGLRenderSystem
    world <- addRenderWindow "MainWindow" 640 480 [mkViewport 0 0 1 1 "Camera1" []]
          =<< addResourceLibrary [("General",[(PathDir,mediaPath)])]
--          =<< addConfig "resources.cfg"
          =<< mkWorld renderSystem [Stb.loadImage]

    --(w',ent) <- createEntity world "Cube" "Cube.mesh.xml"
    (w',ent) <- createEntity world "car" "scooby_body.mesh.xml"
    (w'',colent) <- createEntity w' "car_collision" "scooby_body.mesh.xml"
    (w''',ground) <- createEntity w'' "ground" "Ground.mesh.xml"
    --,mkNode "Root" "GroundNode1" (scal 80 <> transl sx 0 sz) [mesh "Ground.mesh.xml"]
    (worldSignal,worldSignalSink) <- external (w'',0,[])

    let shapeMesh = enMesh colent -- (rlMeshMap $ wrResource w') ! "Cube.mesh.xml" -- "ogrehead.lmesh"

    sdk <- plNewBulletSdk
    dw <- plCreateDynamicsWorld sdk
    gs <- plNewBoxShape 1000 100 1000
    gb <- plCreateRigidBody nullPtr 0 gs
    plAddRigidBody dw gb
    plSetPosition gb (0,-103,0)
    --shape <- mkConvexHullMeshShape shapeMesh
    shape <- mkConvexTriangleMeshShape shapeMesh
    --shape <- mkStaticTriangleMeshShape shapeMesh
    --shape <- mkGimpactTriangleMeshShape shapeMesh
    --shape <- plNewBoxShape 1 1 1

    re1 <- createSignal $ integral 0 $ pure (1.5)
    re2 <- createSignal $ integral 10 $ pure (-1.0)
    re3 <- createSignal $ integral 110 $ pure (0.8)
    time <- createSignal $ stateful 0 (+)
    fire <- createSignal $ transfer (0,False) (\ t f (rt,_) -> if f then (if rt > 0 then (max 0 $ rt - t) else 0.5,rt <= 0) else ((max 0 $ rt - t),False)) firePress
    cam <- cameraSignal (-10,0,0) mousePosition fblrPress

    s <- fpsState

    driveNetwork (drawGLScene ent dw shape ground worldSignalSink <$> fire <*> worldSignal <*> windowSize <*> mousePosition <*> re1 <*> re2 <*> re3 <*> cam)-- <*> zsin <*> cam)
                 (readInput dw s firePressSink mousePositionSink mousePressSink fblrPressSink)

    closeWindow

readInput dw s fire mousePos mouseBut fblrPress = do
    t <- get GLFW.time
    updateFPS s t
    GLFW.time $= 0
    let Position x0 y0 = baseMousePos
    Position x y <- get GLFW.mousePos
    GLFW.mousePos $= baseMousePos
    mousePos (fromIntegral (x-x0),fromIntegral (y-x0))

    b <- GLFW.getMouseButton GLFW.ButtonLeft
    mouseBut (b == GLFW.Press)
    k <- (==GLFW.Press) <$> getKey ESC
    kw <- (==GLFW.Press) <$> getKey UP -- $ CharKey 'w'
    ks <- (==GLFW.Press) <$> getKey DOWN -- $ CharKey 's'
    ka <- (==GLFW.Press) <$> getKey LEFT -- $ CharKey 'a'
    kd <- (==GLFW.Press) <$> getKey RIGHT -- $ CharKey 'd'
    turbo <- (==GLFW.Press) <$> getKey RSHIFT
    fblrPress (ka,kw,ks,kd,turbo)
    fire =<< (==GLFW.Press) <$> getKey '.'
    plStepSimulation dw $ realToFrac t

    return (if k then Nothing else Just t)

drawGLScene ent dw shape ground worldSink (_,fire) (world,i,l) (w,h) (cx,cy) re1 re2 re3 (cam',dir,up,_) {-zsin camMat-} = do
    let getTransform body = do
            (e0',e1',e2',e3',e4',e5',e6',e7',e8',e9',eA',eB',eC',eD',eE',eF') <- plGetOpenGLMatrix body
            let (e0,e1,e2,e3,e4,e5,e6,e7,e8,e9,eA,eB,eC,eD,eE,eF) = (f e0',f e1',f e2',f e3',f e4',f e5',f e6',f e7',f e8',f e9',f eA',f eB',f eC',f eD',f eE',f eF')
                f :: CFloat -> FloatType
                f = realToFrac
            return $ mk4 (Matrix4 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 eA eB eC eD eE eF) ent

        cam = Camera
            { cmName        = "Camera1"
            , cmFov         = 45
            , cmNear        = 0.1
            , cmFar         = 1000
            , cmAspectRatio = Nothing
            , cmPolygonMode = PM_SOLID
            }

        mk4 m e = (m,prepare m e,constRenderQueueMain,constRenderableDefaultPriority)

    p <- mapM getTransform l
    renderWorld 0 "MainWindow" (FlattenScene (mk4 (scal 200 <> transl 0 (-3) 0) ground:p)
                                               [(lookat cam' dir up,cam)] [])
                    =<< updateTargetSize "MainWindow" w h
                        world
    swapBuffers
    when fire $ do
        let world' = world
        -- create new rigid body
        b <- plCreateRigidBody Foreign.nullPtr 10 shape
        plAddRigidBody dw b
        --plSetPosition b (0,6 + fromIntegral (3*i+1),0)
        plSetPosition b (0,6,0)
        putStrLn $ "instances: " ++ show (i+1)
        -- update rigid body map
        worldSink (world',i+1,b:l)