import Control.Applicative import Control.Monad.Trans import qualified Data.List as List import FRP.Elerea.Param import Graphics.UI.GLFW as GLFW import Graphics.LambdaCube import Graphics.LambdaCube.RenderSystem.GL import qualified Graphics.LambdaCube.Loader.StbImage as Stb import Paths_lambdacube_examples (getDataFileName) import Utils main :: IO () main = do windowSize <- initCommon "LambdaCube Engine Camera Track Example" mediaPath <- getDataFileName "media" renderSystem <- mkGLRenderSystem runLCM renderSystem [Stb.loadImage] $ do let simpleLight = Light { lgType = LT_POINT , lgDiffuse = (1,1,1,1) , lgDirection = Vec3 0 0 1 , lgSpecular = (0,0,0,0) , lgSpotOuter = pi / 180 * 40 , lgSpotFalloff = 1 , lgRange = 100000 , lgAttenuationConst = 1 , lgAttenuationLinear = 0 , lgAttenuationQuad = 0 } -- inLCM $ addConfig "resources.cfg" addResourceLibrary [("General",[(PathDir,mediaPath)])] let mrq = mesh defaultRQP m = mrq Nothing addScene $ [ node "Root" "OgreHead" idmtx [m "ogrehead.mesh.xml"] , node "Root" "Light1" idmtx [light simpleLight { lgDiffuse = (1,0,0,1) }] , node "Root" "Light2" idmtx [defaultLight] , node "Root" "Light3" idmtx [light simpleLight { lgDiffuse = (0,0,1,1) }] , node "Light1" "Cube1" (scalingUniformProj4 0.2) [mrq (Just (repeat "Examples/TransparentTest")) "knot.mesh.xml"] , node "Light2" "Cube2" (scalingUniformProj4 0.2) [mrq (Just (repeat "Examples/TransparentTest")) "knot.mesh.xml"] , node "Light3" "Cube3" (scalingUniformProj4 0.2) [mrq (Just (repeat "Examples/TransparentTest")) "knot.mesh.xml"] , node "Root" "CameraNode1" idmtx [simpleCamera "Camera1"] , node "Root" "GroundNode1" (scalingUniformProj4 7000 .*. translation (Vec3 0 (-70) 0) ) [mrq (Just ["MyAnimMaterial"]) "Ground.mesh.xml"] , node "Root" "SkyBoxNode1" (scalingUniformProj4 1000) [mesh (Just RQP_EarlySky) Nothing "Box.mesh.xml"] ] addRenderWindow "MainWindow" 640 480 [viewport 0 0 1 1 "Camera1" []] s <- liftIO fpsState sc <- liftIO $ start $ scene windowSize driveNetwork sc (readInput s) closeWindow scene :: RenderSystem r vb ib q t p lp => Signal (Int, Int) -> SignalGen FloatType (Signal (LCM (World r vb ib q t p lp) e ())) scene windowSize = do time <- stateful 0 (+) let animCm = curve track <$> time animL1 = curve trackLight1 <$> time animL2 = curve trackLight2 <$> time animL3 = curve trackLight3 <$> time return $ drawGLScene <$> windowSize <*> animCm <*> animL1 <*> animL2 <*> animL3 <*> time where curve kfl t = (fx + t' * dx, fy + t' * dy, fz + t' * dz) where t'' = len * (snd $ (properFraction :: FloatType -> (Int,FloatType)) $ 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 track = [ (0, (-100 , 100 , 100)) , (2.5, (-300 ,-10 ,-200)) , (5, ( 500 , 700 ,-500)) , (7.5, ( 200 ,-10 , 400)) , (10, (-100 , 100 , 100)) ] trackLight1 = [ (0, ( 200 , 200 , 100)) , (2*2.5, ( 100 ,-10 ,-200)) , (2*5, (-500 , 700 ,-500)) , (2*7.5, (-200 ,-10 , 400)) , (2*10, ( 200 , 200 , 100)) ] trackLight2 = [ (3*0, (-100 , 100 , 100)) , (3*2.5, (-300 ,-10 ,-200)) , (3*5, ( 500 , 700 ,-500)) , (3*7.5, ( 200 ,-10 , 400)) , (3*10, (-100 , 100 , 100)) ] trackLight3 = [ (0.3*0, (-100 , 10 , 100)) , (0.3*2.5, (-300 ,-10 ,-200)) , (0.3*5, ( 500 , 70 ,-500)) , (0.3*7.5, ( 200 ,-10 , 400)) , (0.3*10, (-100 , 10 , 100)) ] drawGLScene :: RenderSystem r vb ib q t p lp => (Int, Int) -> (Float, Float, Float) -> (Float, Float, Float) -> (Float, Float, Float) -> (Float, Float, Float) -> FloatType -> LCM (World r vb ib q t p lp) e () drawGLScene (w,h) (x,y,z) l1 l2 l3 time = do let t (x,y,z) = translation (Vec3 x y z) updateTransforms [ ("CameraNode1", inverse $ lookat (Vec3 x y z) (Vec3 0 0 0) (Vec3 0 1 0)) , ("Light1", t l1), ("Light2", t l2), ("Light3", t l3) , ("SkyBoxNode1", scalingUniformProj4 1000 .*. translation (Vec3 x y z)) ] updateTargetSize "MainWindow" w h renderWorld (realToFrac time) "MainWindow" liftIO $ swapBuffers readInput :: State -> IO (Maybe FloatType) readInput s = do t <- getTime updateFPS s t setTime 0 k <- keyIsPressed KeyEsc return (if k then Nothing else Just (realToFrac t))