-- 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 -- -- Copyright 2011 Dr. 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. -- One.hs -- This module provides a simple, generic API into the HGamer3D functionality. module HGamer3D.APIs.One ( -- types ColourValue (ColourValue), Quaternion (Quaternion), Vector3 (Vector3), -- Enums module HGamer3D.Bindings.OIS.EnumKeyCode, -- Data types Entity (Entity), EngineStatus (EngineStatus), Light (Light), -- Functions -- -- Initialize initializeHG3D, -- Camera setCameraPos, setCameraLookAt, -- Light createLight, setLightPos, -- Entities loadEntity, getEntityOrientation, setEntityOrientation, getEntityFromObject, -- Object functions createLineObject, -- event functions isKeyDown, -- run it renderLoop, ) where import GHC.Ptr import HGamer3D.Bindings.Ogre.ClassPtr import HGamer3D.Bindings.OIS.ClassPtr import HGamer3D.Bindings.Ogre.Utils import HGamer3D.Data.ColourValue import HGamer3D.Data.Quaternion import HGamer3D.Data.Vector3 import HGamer3D.Bindings.Ogre.TypeColourValue import HGamer3D.Bindings.Ogre.TypeQuaternion import HGamer3D.Bindings.Ogre.TypeVector3 import HGamer3D.Bindings.Ogre.EnumSceneType import HGamer3D.Bindings.Ogre.ClassCamera import HGamer3D.Bindings.Ogre.ClassRoot import HGamer3D.Bindings.Ogre.ClassLight import HGamer3D.Bindings.Ogre.ClassNode import HGamer3D.Bindings.Ogre.ClassSceneManager import HGamer3D.Bindings.Ogre.ClassSceneNode import HGamer3D.Bindings.Ogre.ClassRenderTarget import HGamer3D.Bindings.Ogre.ClassRenderWindow import HGamer3D.Bindings.Ogre.ClassResourceGroupManager import HGamer3D.Bindings.Ogre.ClassTextureManager import HGamer3D.Bindings.Ogre.ClassViewport import HGamer3D.Bindings.Ogre.ClassFrustum import HGamer3D.Bindings.OIS.Utils import HGamer3D.Bindings.OIS.ClassInputManager import HGamer3D.Bindings.OIS.EnumType import HGamer3D.Bindings.OIS.EnumKeyCode import HGamer3D.Bindings.OIS.ClassObject import HGamer3D.Bindings.OIS.ClassKeyboard import HGamer3D.Bindings.Ogre.ClassManualObject import HGamer3D.Bindings.Ogre.EnumOperationType import HGamer3D.Bindings.Ogre.TypeHG3DClass import HGamer3D.Bindings.OIS.TypeHG3DClass import HGamer3D.Data.Vector3 import HGamer3D.Data.Quaternion import HGamer3D.Data.HG3DClass -- data declarations for basic API -- data EngineStatus = EngineStatus ClassRoot ClassSceneManager ClassResourceGroupManager ClassInputManager ClassRenderWindow ClassCamera ClassViewport ClassKeyboard data EngineStatus = EngineStatus HG3DClass HG3DClass HG3DClass HG3DClass HG3DClass HG3DClass HG3DClass HG3DClass data Light = Light HG3DClass data Entity = Entity HG3DClass HG3DClass -- basic initialize function initializeHG3D :: String -> String -> IO (EngineStatus) initializeHG3D windowName sceneManagerType = do root <- cRNew let (HG3DClass ptr fptr) = root print ptr print fptr cRShowConfigDialog root fUAddResourceLocations "resources.cfg" renderWindow <-cRInitialise root True windowName "" (inputManager, keyboard, mouse) <- fUInitializeOis renderWindow -- keyboard <- cOISImCreateInputObject inputManager Oiskeyboard False "" sceneManager <- cRCreateSceneManager root sceneManagerType "SceneManager" camera <- cSmCreateCamera sceneManager "SimpleCamera" cFSetNearClipDistance camera 5.0 cFSetFarClipDistance camera 5000.0 viewport <- cRtAddViewport renderWindow camera 0 0.0 0.0 1.0 1.0 let bgColor = ColourValue 0.0 0.0 0.0 1.0 cVpSetBackgroundColour viewport bgColor height <- cVpGetActualHeight viewport width <- cVpGetActualWidth viewport cFSetAspectRatio camera ((fromIntegral width) / (fromIntegral height)) -- tm <- cTmGetSingletonPtr -- cTmSetDefaultNumMipmaps tm 5 rgm <- cRgmGetSingletonPtr cRgmInitialiseAllResourceGroups rgm return (EngineStatus root sceneManager rgm inputManager renderWindow camera viewport keyboard) -- camera functions setCameraPos :: EngineStatus -> Vector3 -> IO () setCameraPos (EngineStatus _ _ _ _ _ camera _ _) pos = do cCSetPosition2 camera pos setCameraLookAt :: EngineStatus -> Vector3 -> IO () setCameraLookAt (EngineStatus _ _ _ _ _ camera _ _) vec3 = do cCLookAt camera vec3 -- light functions createLight :: EngineStatus -> ColourValue -> Float -> Float -> Float -> String -> IO (Light) createLight (EngineStatus _ sceneManager _ _ _ _ _ _) colour x y z name = do cSmSetAmbientLight sceneManager colour light <- cSmCreateLight sceneManager name cLSetPosition light x y z return (Light light) setLightPos :: Light -> Float -> Float -> Float -> IO () setLightPos (Light light) x y z = do cLSetPosition light x y z -- entity functions loadEntity :: EngineStatus -> String -> String -> IO (Entity) loadEntity (EngineStatus _ sceneManager _ _ _ _ _ _) name mesh = do entity <- cSmCreateEntity sceneManager name mesh "General" rootNode <- cSmGetRootSceneNode sceneManager let vzero = Vector3 0.0 0.0 0.0 let qident = Quaternion 1.0 0.0 0.0 0.0 entityNode <- cSnCreateChildSceneNode rootNode vzero qident cSnAttachObject entityNode entity return (Entity entity entityNode) getEntityFromObject :: EngineStatus -> HG3DClass -> IO (Entity) getEntityFromObject (EngineStatus _ sceneManager _ _ _ _ _ _) object = do rootNode <- cSmGetRootSceneNode sceneManager let vzero = Vector3 0.0 0.0 0.0 let qident = Quaternion 1.0 0.0 0.0 0.0 entityNode <- cSnCreateChildSceneNode rootNode vzero qident cSnAttachObject entityNode object return (Entity object entityNode) getEntityOrientation :: Entity -> IO (Quaternion) getEntityOrientation (Entity entity entityNode) = do quat <- cNGetOrientation entityNode return (quat) setEntityOrientation :: Entity -> Quaternion -> IO () setEntityOrientation (Entity entity entityNode) quat = do cNSetOrientation entityNode quat return () -- object functions createLineObject :: EngineStatus -> String -> String -> Vector3 -> Vector3 -> IO () createLineObject (EngineStatus _ sceneManager _ _ _ _ _ _) name materialName vStart vEnd = do mo <- cSmCreateManualObject sceneManager name cMnoBegin mo materialName OtLineList "General" cMnoPosition mo vStart cMnoPosition mo vEnd cMnoEnd mo rootNode <- cSmGetRootSceneNode sceneManager cSnAttachObject rootNode mo return () -- event functions isKeyDown :: EngineStatus -> EnumKeyCode -> IO (Bool) isKeyDown (EngineStatus _ _ _ _ _ _ _ keyboard) keycode = do isdown <- cOISKIsKeyDown keyboard keycode return (isdown) -- renderLoop function renderLoop :: EngineStatus -> (EngineStatus -> IO ()) -> IO () renderLoop (EngineStatus root sceneManager rgm inputManager window camera viewport keyboard) stepFunc = do fUMessagePump closed <- cRwIsClosed window if (closed) then return () else do cRRenderOneFrame root cOISOCapture keyboard stepFunc (EngineStatus root sceneManager rgm inputManager window camera viewport keyboard) renderLoop (EngineStatus root sceneManager rgm inputManager window camera viewport keyboard) stepFunc