import Control.Applicative import Control.Monad.Trans 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 width :: Float width = 150 height :: Float height = 150 main :: IO () main = do windowSize <- initCommon "LambdaCube Engine Basic Example" (mousePosition,mousePositionSink) <- external (0,0) (_mousePress,mousePressSink) <- external False (fblrPress,fblrPressSink) <- external (False,False,False,False,False) mediaPath <- getDataFileName "media" renderSystem <- mkGLRenderSystem runLCM renderSystem [Stb.loadImage] $ do -- inLCM $ addConfig "resources.cfg" addResourceLibrary [("General",[(PathDir,mediaPath)])] let mrq = mesh defaultRQP m = mrq Nothing materials = ["Examples/TransparentTest","Examples/Toon","2 - Default","Examples/EnvMappedRustySteel"] materialLen = length materials mat i = materials !! (i `mod` materialLen) addScene $ [ node "Root" "Robot" idmtx [m "robot.mesh.xml"] , node "Root" "OgreHead" (scalingUniformProj4 0.05) [m "ogrehead.mesh.xml",m "Quad.mesh.xml"] , node "Root" "Light1" (translation (Vec3 5 5 10)) [defaultLight,m "ogrehead.mesh.xml"] , node "Root" "CameraNode1" (translation (Vec3 0 0 10)) [simpleCamera "Camera1"] , node "Root" "CameraEye" idmtx [mesh (Just RQP_EarlySky) Nothing "Box.mesh.xml" ] , node "Root" "CameraNode2" idmtx [simpleCamera "Camera2"] ] ++ [node "Root" ("Knot" ++ show i) idmtx [mrq (Just (repeat $ mat i)) "knot.mesh.xml"] | i <- [1..200]] addRenderTexture "RenderTex01" 640 480 addRenderWindow "MainWindow" 640 480 [viewport 0 0 1 0.5 "Camera1" ["Glass" {- "Tiling" -}], viewport 0 0.5 1 0.5 "Camera2" []] s <- liftIO fpsState sc <- liftIO $ start $ scene windowSize mousePosition fblrPress driveNetwork sc (readInput s mousePositionSink mousePressSink fblrPressSink) closeWindow scene :: RenderSystem r vb ib q t p lp => Signal (Int, Int) -> Signal (FloatType, FloatType) -> Signal (Bool, Bool, Bool, Bool, Bool) -> SignalGen FloatType (Signal (LCM (World r vb ib q t p lp) e ())) scene windowSize mousePosition fblrPress = do re1 <- integral 0 1.5 re2 <- integral 10 (-1.0) re3 <- integral 110 0.8 time <- stateful 0 (+) last2 <- transfer ((0,0),(0,0)) (\_ n (_,b) -> (b,n)) mousePosition let mouseMove = (\((ox,oy),(nx,ny)) -> (nx-ox,ny-oy)) <$> last2 --let mouseMove = mousePosition cam <- cameraSignal (Vec3 (-4) 0 0) mouseMove fblrPress return $ drawGLScene <$> windowSize <*> re1 <*> re2 <*> re3 <*> cam <*> time drawGLScene :: RenderSystem r vb ib q t2 p lp => (Int, Int) -> FloatType -> FloatType -> FloatType -> (Vec3, Vec3, Vec3, t1) -> FloatType -> LCM (World r vb ib q t2 p lp) e () drawGLScene (w,h) _re1 re2 re3 (cam,dir,up,_) time = do updateTransforms $ [ ("Robot", scalingUniformProj4 0.1 .*. (linear $ rotMatrixY re2) .*. translation (Vec3 3.5 (-5) (-7))) , ("Light1", translation (Vec3 0 100 200) .*. (linear $ rotMatrixX re2)) , ("CameraEye", scalingUniformProj4 1 .*. translation cam) , ("CameraNode2", inverse $ lookat (cam) (cam &+ dir) (up)) ] ++ [("Knot" ++ show i, ((linear $ rotMatrixY re3) .*. let (y,x) = quotRem i 14 in translation (Vec3 ((fromIntegral x - 7)*width) (height*(fromIntegral y - 7)) (-166)) ) ) | i <- [1..200 :: Int]] updateTargetSize "MainWindow" w h renderWorld (realToFrac time) "MainWindow" liftIO $ swapBuffers readInput :: State -> ((FloatType, FloatType) -> IO a) -> (Bool -> IO b) -> ((Bool, Bool, Bool, Bool, Bool) -> IO c) -> IO (Maybe FloatType) readInput s mousePos mouseBut fblrPress = do t <- getTime resetTime (x,y) <- getMousePosition mousePos (fromIntegral x,fromIntegral y) mouseBut =<< mouseButtonIsPressed MouseButton0 fblrPress =<< ((,,,,) <$> keyIsPressed KeyLeft <*> keyIsPressed KeyUp <*> keyIsPressed KeyDown <*> keyIsPressed KeyRight <*> keyIsPressed KeyRightShift) updateFPS s t k <- keyIsPressed KeyEsc return $ if k then Nothing else Just (realToFrac t)