lambdacube-examples-0.1.1: src/lambdacube-cameratrack.hs

import Data.Maybe
import Data.Map
import qualified Data.List as List
import Control.Applicative
import Control.Monad

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

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

import Paths_lambdacube_examples (getDataFileName)

import Utils

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

main = do
    updateGlobalLogger rootLoggerName (setLevel DEBUG)
    initialize
    openWindow (Size 640 480) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window
    windowTitle $= "LambdaCube Engine Camera Track Example"

    initGL 640 480
    (windowSize,windowSizeSink) <- external (0,0)
    windowSizeCallback $= resizeGLScene windowSizeSink

    let curve kfl t = (fx + t' * dx, fy + t' * dy, fz + t' * dz)
          where
            t''             = len * (snd $ properFraction $ (realToFrac t) / len)
            t'              = t'' - ft
            (al,bl)         = List.span (\(a,_)-> a <= t'') kfl
            (ft,(fx,fy,fz)) = last al
            (gt,(gx,gy,gz)) = head bl
            dt              = gt - ft
            dx              = (gx-fx) / dt
            dy              = (gy-fy) / dt
            dz              = (gz-fz) / dt
            len             = fst $ last kfl
        idMatrix4 = transl 0 0 0
        track =
            [ (0,   (-100 , 100 , 100))
            , (2.5, (-300 ,-10  ,-200))
            , (5,   ( 500 , 700 ,-500))
            , (7.5, ( 200 ,-10  , 400))
            , (10,  (-100 , 100 , 100))
            ]

    mediaPath <- getDataFileName "media"
    renderSystem <- mkGLRenderSystem
    world' <- addRenderWindow "MainWindow" 640 480 [mkViewport 0 0 1 1 "Camera1" []]
        =<< addScene [ mkNode "Root" "OgreHead" idMatrix4 [mesh "ogrehead.mesh.xml"] 
                     , mkNode "Root" "Light1"   (transl 5 5 10) [light{-,mesh "Cube.mesh.xml"-}]
                     , mkNode "Root" "Light2"   (transl (-5) 15 10) [light{-,mesh "Cube.mesh.xml"-}]
                     , mkNode "Root" "CameraNode1" idMatrix4 [simpleCamera "Camera1"]
--                     , mkNode "Root" "GroundNode1" (scal 7000 <> transl 0 (-70) 0) [meshMat "Ground.mesh.xml" ["Examples/RustySteel"]]
                     , mkNode "Root" "GroundNode1" (scal 7000 <> transl 0 (-70) 0) [meshMat "Ground.mesh.xml" ["MyAnimMaterial"]]
                     , mkNode "Root" "SkyBoxNode1" (scal 1000) [mesh "Box.mesh.xml"]
                     ]
        =<< addResourceLibrary [("General",[(PathDir,mediaPath)])]
--          =<< addConfig "resources.cfg"
        =<< mkWorld renderSystem [Stb.loadImage]
    (world,worldSink) <- external world'

    time <- createSignal $ stateful 0 (+)
    let anim = curve track <$> time

    s <- fpsState

    driveNetwork (drawGLScene worldSink <$> world <*> windowSize <*> anim <*> time)
                 (readInput s)

    closeWindow

readInput s = do
    t <- get GLFW.time
    updateFPS s t
    GLFW.time $= 0
    k <- getKey ESC
    return (if k == Press then Nothing else Just t)

drawGLScene worldSink world (w,h) (x,y,z) time = do
    w' <- updateTargetSize "MainWindow" w h
      =<< updateTransforms [("CameraNode1", lookat (Vec4 x y z 0) (Vec4 x y z 0) (Vec4 0 1 0 0))] world
    w <- renderWorld (realToFrac time) "MainWindow" (flattenScene $ wrScene w') w'
    worldSink w
    swapBuffers