-- This source file is part of HGamer3D -- (A project to enable 3D game development in Haskell) -- For the latest info, see http://www.althainz.de/HGamer3D.html -- -- (c) 2011 Peter Althainz -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License. -- You may obtain a copy of the License at -- -- http://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -- See the License for the specific language governing permissions and -- limitations under the License. -- Engine3D.hs -- -- Basic functionality of the 3D engine module HGamer3D.APIs.Base.Graphics3D.Engine3D ( Camera (..), HGamer3D.APIs.Base.Graphics3D.Engine3D.getCamera, cameraLookAt, HGamer3D.APIs.Base.Graphics3D.Engine3D.setBackgroundColour, initEngine3D, renderLoop ) where import GHC.Ptr import HGamer3D.Bindings.Ogre.ClassPtr import HGamer3D.Bindings.Ogre.Utils import HGamer3D.Data.Colour import HGamer3D.Data.Vector import HGamer3D.Data.Angle import HGamer3D.Bindings.Ogre.StructColour import HGamer3D.Bindings.Ogre.StructSharedPtr import HGamer3D.Bindings.Ogre.EnumSceneType import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace import HGamer3D.Bindings.Ogre.ClassCamera as Camera import HGamer3D.Bindings.Ogre.ClassRoot as Root import HGamer3D.Bindings.Ogre.ClassLight as Light import HGamer3D.Bindings.Ogre.ClassNode as Node import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager import HGamer3D.Bindings.Ogre.ClassSceneNode as SceneNode import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget import HGamer3D.Bindings.Ogre.ClassRenderWindow as RenderWindow import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager import HGamer3D.Bindings.Ogre.ClassTextureManager as TextureManager import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager import HGamer3D.Bindings.Ogre.ClassViewport as Viewport import HGamer3D.Bindings.Ogre.ClassFrustum as Frustum import HGamer3D.Bindings.Ogre.ClassAnimationState as AnimationState import HGamer3D.Bindings.Ogre.ClassEntity as Entity import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities import HGamer3D.Bindings.Ogre.ClassLogManager as LogManager import HGamer3D.Bindings.Ogre.ClassLog as Log import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType import HGamer3D.Bindings.Ogre.StructHG3DClass import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType import HGamer3D.Data.HG3DClass import HGamer3D.APIs.Base.Common import Control.Monad import Control.Monad.Trans import Control.Monad.Reader import Control.Monad.State import Control.Concurrent import System.Win32.Process import System (getArgs) -- Camera functions -- data Camera = Camera HG3DClass getCamera :: MHGamer3D Camera getCamera = do (cs, es) <- ask let cam = Camera (esCamera es) return cam instance Position3D Camera where position3D (Camera c) = do pos <- liftIO $ Camera.getPosition c return (pos) positionTo3D (Camera c) pos = do liftIO $ Camera.setPosition2 c pos return () instance Direction3D Camera where direction3D (Camera c) = do d <- liftIO $ Camera.getDirection c return d directionTo3D (Camera c) v = do liftIO $ Camera.setDirection2 c v instance Orientation3D Camera where orientation3D (Camera c) = do q <- liftIO $ Camera.getOrientation c let uq = mkNormal q return uq orientationTo3D (Camera c) uq = do liftIO $ Camera.setOrientation c (fromNormal uq) return () cameraLookAt (Camera c) v = do liftIO $ Camera.lookAt c v return () -- specific single function -- setBackgroundColour :: Colour -> MHGamer3D () setBackgroundColour bgColour = do (cs, es) <- ask liftIO $ Viewport.setBackgroundColour (esViewport es) bgColour initEngine3D :: CommonSystem -> String -- ^Name of the window, displayed -> String -- ^SceneManager type used -> IO (EngineSystem) initEngine3D cs windowName sceneManagerType = do let hg3dpath = (csHG3DPath cs) -- create a good experience for the user, starting the -- engine, and also, make sure, we can modify options args <- getArgs let fConfig = foldl (||) False $ map (\arg -> if arg == "--config" then True else False) args let fDX = foldl (||) False $ map (\arg -> if arg == "--directx" then True else False) args let fLog = foldl (||) False $ map (\arg -> if arg == "--logging" then True else False) args let plugins = if fDX then hg3dpath ++ "\\config\\pluginsDX.cfg" else hg3dpath ++ "\\config\\plugins.cfg" let config = if fDX then hg3dpath ++ "\\config\\engineDX.cfg" else hg3dpath ++ "\\config\\engine.cfg" print "Here comes the path info" print plugins print config root <- Root.new plugins config "" lmgr <- LogManager.getSingletonPtr if not fLog then do newlog <- LogManager.createLog lmgr "SilentLog" True False True return () else do newlog <- LogManager.createLog lmgr "hgamer3d-engine.log" True False False return () fOk <- if fConfig then Root.showConfigDialog root else do fLoaded <- Root.restoreConfig root if not fLoaded then Root.showConfigDialog root else return True -- fUAddResourceLocations "resources.cfg" renderWindow <-Root.initialise root True windowName "" -- Suppress logging unless, fLog sceneManager <- Root.createSceneManager root sceneManagerType "SceneManager" camera <- SceneManager.createCamera sceneManager "SimpleCamera" Frustum.setNearClipDistance camera 5.0 Frustum.setFarClipDistance camera 5000.0 viewport <- RenderTarget.addViewport renderWindow camera 0 0.0 0.0 1.0 1.0 let bgColor = Colour 0.0 0.0 0.0 1.0 Viewport.setBackgroundColour viewport bgColor height <- Viewport.getActualHeight viewport width <- Viewport.getActualWidth viewport Frustum.setAspectRatio camera ((fromIntegral width) / (fromIntegral height)) tm <- TextureManager.getSingletonPtr TextureManager.setDefaultNumMipmaps tm 20 rgm <- ResourceGroupManager.getSingletonPtr ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\materials") "FileSystem" "General" False ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\Sinbad.zip") "Zip" "General" False ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\ywing.zip") "Zip" "General" False ResourceGroupManager.initialiseAllResourceGroups rgm cm <- ControllerManager.new return (EngineSystem root sceneManager rgm tm cm lmgr camera renderWindow viewport ) -- renderStep a :: TimeMS -> a -> MHGamer3D (Bool, a) -- this function needs to be defined in renderInternalStep :: Int -> TimeMS -> MHGamer3D (Bool, TimeMS) renderInternalStep frameRate (TimeMS lastTime) = do (cs, es) <- ask -- adapt to framerate, while still doing messagePump (TimeMS time) <- getTimeMS let delta = time - lastTime let waitTimeMS = (1000.0 / (fromIntegral frameRate) ) - (fromIntegral delta) time <- if waitTimeMS > 0.0 then do liftIO $ sleep (round waitTimeMS) (TimeMS time) <- getTimeMS return (time) else return (time) -- adapt liftIO $ WindowEventUtilities.messagePump closed <- liftIO $ RenderWindow.isClosed (esRenderWindow es) if (closed) then return (False, (TimeMS time)) else do liftIO $ Root.renderOneFrame (esRoot es) return (True, (TimeMS time)) renderLoop :: Int -> TimeMS -> a -> (TimeMS -> a -> MHGamer3D (Bool, a)) -> MHGamer3D () renderLoop frameRate t a renderStep = do (cs, es) <- ask (flagStep, time) <- renderInternalStep frameRate t let delta = TimeMS (time' - t') where TimeMS time' = time TimeMS t' = t (flagLoop, a) <- renderStep delta a if (flagStep && flagLoop) then do renderLoop frameRate time a renderStep else return ()