diff --git a/HGamer3D-API.cabal b/HGamer3D-API.cabal --- a/HGamer3D-API.cabal +++ b/HGamer3D-API.cabal @@ -1,5 +1,5 @@ Name: HGamer3D-API -Version: 0.1.0 +Version: 0.1.1 Synopsis: Library to enable 3D game development for Haskell - API Description: Library, to enable 3D game development for Haskell, @@ -24,7 +24,7 @@ Extra-source-files: Setup.hs Library - Build-Depends: base >= 3 && < 5, HGamer3D-Data, HGamer3D-Ogre-Binding, HGamer3D-OIS-Binding + Build-Depends: base >= 3 && < 5, HGamer3D-Data == 0.1.0, HGamer3D-Ogre-Binding == 0.1.0, HGamer3D-OIS-Binding == 0.1.0 Exposed-modules: HGamer3D.APIs.One Other-modules: diff --git a/HGamer3D/APIs/One.hs b/HGamer3D/APIs/One.hs --- a/HGamer3D/APIs/One.hs +++ b/HGamer3D/APIs/One.hs @@ -23,21 +23,41 @@ module HGamer3D.APIs.One ( - -- types + -- Data types + ------------- + ColourValue (ColourValue), Quaternion (Quaternion), Vector3 (Vector3), + Radian (Radian), + Degree (Degree), - -- Enums - module HGamer3D.Bindings.OIS.EnumKeyCode, + + -- Data types - basic systems - -- Data types - Entity (Entity), - EngineStatus (EngineStatus), + EngineSystem (EngineSystem, esRoot, esSceneManager, esResourceGroupManager, esTextureManager, esControllerManager), + ViewSystem (ViewSystem, vsCamera, vsRenderWindow, vsViewport), + InputSystem (InputSystem, isInputManager, isKeyboard, isMouse), + + + -- Data types - internal objects + -- The consctructores are provided, in case, extension on the base + -- of the pure wrapping is used + Light (Light), + Object (ManualObject, Mesh), + Node (Node), + Time (Time), + Animation (Animation), + GraphicsObject (GraphicsObject, LightObject, CombinedObject), + -- Enums + -------- + + module HGamer3D.Bindings.OIS.EnumKeyCode, + -- Functions - -- + ------------ -- Initialize initializeHG3D, @@ -46,20 +66,38 @@ setCameraPos, setCameraLookAt, - -- Light + -- Light Creation + createAmbientLight, createLight, - setLightPos, - -- Entities - loadEntity, - getEntityOrientation, - setEntityOrientation, - getEntityFromObject, + -- Graphics Object Creation + createLine, + createCube, + createMesh, + + + -- Graphics Object Functions + getPosition, + setPosition, + getOrientation, + setOrientation, + getScale, + setScale, + combineGraphicsObjects, - -- Object functions - createLineObject, + -- helper function + getGraphicsObject, - -- event functions + -- Animation Functions + getAnimation, + startAnimation, + stopAnimation, + setAnimationTime, + + -- Time Functions + getTime, + + -- Event Functions isKeyDown, -- run it @@ -79,6 +117,8 @@ import HGamer3D.Data.ColourValue import HGamer3D.Data.Quaternion import HGamer3D.Data.Vector3 +import HGamer3D.Data.Radian +import HGamer3D.Data.Degree import HGamer3D.Bindings.Ogre.TypeColourValue import HGamer3D.Bindings.Ogre.TypeQuaternion @@ -96,8 +136,12 @@ import HGamer3D.Bindings.Ogre.ClassRenderWindow import HGamer3D.Bindings.Ogre.ClassResourceGroupManager import HGamer3D.Bindings.Ogre.ClassTextureManager +import HGamer3D.Bindings.Ogre.ClassControllerManager import HGamer3D.Bindings.Ogre.ClassViewport import HGamer3D.Bindings.Ogre.ClassFrustum +import HGamer3D.Bindings.Ogre.ClassAnimationState +import HGamer3D.Bindings.Ogre.ClassEntity +import HGamer3D.Bindings.Ogre.ClassControllerManager import HGamer3D.Bindings.OIS.Utils import HGamer3D.Bindings.OIS.ClassInputManager @@ -117,28 +161,60 @@ 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 + +-- Input System +data InputSystem = InputSystem { + isMouse::HG3DClass, + isKeyboard::HG3DClass, + isInputManager::HG3DClass +} deriving (Show, Eq) + +-- View System +data ViewSystem = ViewSystem { + vsCamera::HG3DClass, + vsRenderWindow::HG3DClass, + vsViewport::HG3DClass +} deriving (Show, Eq) + +-- Engine System +data EngineSystem = EngineSystem { + esRoot::HG3DClass, + esSceneManager::HG3DClass, + esResourceGroupManager::HG3DClass, + esTextureManager::HG3DClass, + esControllerManager::HG3DClass +} deriving (Show, Eq) + + +-- common 3D objects, internal data objects (to get typesafety, later to be done with typed pointers) data Light = Light HG3DClass -data Entity = Entity HG3DClass HG3DClass +data Object = ManualObject HG3DClass | Mesh HG3DClass +data Node = Node HG3DClass +data Time = Time Float +data Animation = Animation HG3DClass --- basic initialize function +-- common 3D Objects +data GraphicsObject = GraphicsObject Object Node | LightObject Light | CombinedObject Node -initializeHG3D :: String -> String -> IO (EngineStatus) +-- + + +-- basic initialize function +-- +initializeHG3D :: String -> String -> IO (EngineSystem, ViewSystem, InputSystem) 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" @@ -156,108 +232,259 @@ cFSetAspectRatio camera ((fromIntegral width) / (fromIntegral height)) --- tm <- cTmGetSingletonPtr --- cTmSetDefaultNumMipmaps tm 5 + tm <- cTmGetSingletonPtr + cTmSetDefaultNumMipmaps tm 20 rgm <- cRgmGetSingletonPtr cRgmInitialiseAllResourceGroups rgm + + cm <- cCmNew - return (EngineStatus root sceneManager rgm inputManager renderWindow camera viewport keyboard) + return ( + EngineSystem root sceneManager rgm tm cm, + ViewSystem camera renderWindow viewport, + InputSystem mouse keyboard inputManager + ) -- camera functions -setCameraPos :: EngineStatus -> Vector3 -> IO () -setCameraPos (EngineStatus _ _ _ _ _ camera _ _) pos = do - cCSetPosition2 camera pos +setCameraPos :: ViewSystem -> Vector3 -> IO () +setCameraPos vs pos = do + cCSetPosition2 (vsCamera vs) pos -setCameraLookAt :: EngineStatus -> Vector3 -> IO () -setCameraLookAt (EngineStatus _ _ _ _ _ camera _ _) vec3 = do - cCLookAt camera vec3 +setCameraLookAt :: ViewSystem -> Vector3 -> IO () +setCameraLookAt vs vec3 = do + cCLookAt (vsCamera vs) 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) +createAmbientLight :: EngineSystem -> ColourValue -> IO () +createAmbientLight es colour = do + cSmSetAmbientLight (esSceneManager es) colour + return () -setLightPos :: Light -> Float -> Float -> Float -> IO () -setLightPos (Light light) x y z = do + +createLight :: EngineSystem -> String -> ColourValue -> Vector3 -> IO (GraphicsObject) +createLight es lightName colour (Vector3 x y z) = do + cSmSetAmbientLight (esSceneManager es) colour + light <- cSmCreateLight (esSceneManager es) lightName cLSetPosition light x y z + return (LightObject (Light light)) + +-- helper functions, not exported --- entity functions +getNodeFromGraphicsObject :: GraphicsObject -> HG3DClass +getNodeFromGraphicsObject (GraphicsObject _ (Node node)) = node +getNodeFromGraphicsObject (CombinedObject (Node node)) = node -loadEntity :: EngineStatus -> String -> String -> IO (Entity) -loadEntity (EngineStatus _ sceneManager _ _ _ _ _ _) name mesh = do +getObjectFromGraphicsObject :: GraphicsObject -> HG3DClass +getObjectFromGraphicsObject (GraphicsObject (ManualObject object) (Node node)) = object +getObjectFromGraphicsObject (GraphicsObject (Mesh mesh) (Node node)) = mesh - entity <- cSmCreateEntity sceneManager name mesh "General" - rootNode <- cSmGetRootSceneNode sceneManager +getNewNode :: EngineSystem -> IO (HG3DClass) +getNewNode es = do + rootNode <- cSmGetRootSceneNode (esSceneManager es) 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) + node <- cSnCreateChildSceneNode rootNode vzero qident + return (node) -getEntityFromObject :: EngineStatus -> HG3DClass -> IO (Entity) -getEntityFromObject (EngineStatus _ sceneManager _ _ _ _ _ _) object = do +getGraphicsObject :: EngineSystem -> Object -> IO (GraphicsObject) +getGraphicsObject es (ManualObject object) = do + node <- getNewNode es + cSnAttachObject node object + return (GraphicsObject (ManualObject object) (Node node) ) +getGraphicsObject es (Mesh mesh) = do + node <- getNewNode es + cSnAttachObject node mesh + return (GraphicsObject (Mesh mesh) (Node node) ) - 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) +-- use "BaseWhiteNoLighting" Material -getEntityOrientation :: Entity -> IO (Quaternion) -getEntityOrientation (Entity entity entityNode) = do - quat <- cNGetOrientation entityNode +createLine :: EngineSystem -> String -> String -> ColourValue -> Vector3 -> Vector3 -> IO (GraphicsObject) +createLine es lineName materialName colour vStart vEnd = do + mo <- cSmCreateManualObject (esSceneManager es) lineName + cMnoBegin mo materialName OtLineList "General" + cMnoPosition mo vStart + cMnoColour mo colour + cMnoPosition mo vEnd + cMnoColour mo colour + cMnoEnd mo + + go <- getGraphicsObject es (ManualObject mo) + return (go) + + +createCube :: EngineSystem -> String -> String -> ColourValue -> Vector3 -> IO (GraphicsObject) +createCube es cubeName materialName colour pos = do + mo <- cSmCreateManualObject (esSceneManager es) cubeName + -- set Dynamic to false + cMnoSetDynamic mo False + + -- basic parameters + let lsize = 1.0 + let cp = 1.0 * lsize + let cm = -1.0 * lsize + + cMnoBegin mo materialName OtTriangleList "General" + + cMnoPosition2 mo cm cp cm -- a vertex + cMnoColour mo colour + cMnoPosition2 mo cp cp cm -- a vertex + cMnoColour mo colour + cMnoPosition2 mo cp cm cm -- a vertex + cMnoColour mo colour + cMnoPosition2 mo cm cm cm -- a vertex + cMnoColour mo colour + + cMnoPosition2 mo cm cp cp -- a vertex + cMnoColour mo colour + cMnoPosition2 mo cp cp cp -- a vertex + cMnoColour mo colour + cMnoPosition2 mo cp cm cp -- a vertex + cMnoColour mo colour + cMnoPosition2 mo cm cm cp -- a vertex + cMnoColour mo colour + + cMnoTriangle mo 0 1 2 + cMnoTriangle mo 2 3 0 + cMnoTriangle mo 4 6 5 + cMnoTriangle mo 6 4 7 + + cMnoTriangle mo 0 4 5 + cMnoTriangle mo 5 1 0 + cMnoTriangle mo 2 6 7 + cMnoTriangle mo 7 3 2 + + cMnoTriangle mo 0 7 4 + cMnoTriangle mo 7 0 3 + cMnoTriangle mo 1 5 6 + cMnoTriangle mo 6 2 1 + + cMnoEnd mo + + go <- getGraphicsObject es (ManualObject mo) + setPosition go pos + return (go) + + +createMesh :: EngineSystem -> String -> String -> IO (GraphicsObject) +createMesh es meshName meshFile = do + + entity <- cSmCreateEntity (esSceneManager es) meshName meshFile "General" + go <- getGraphicsObject es (Mesh entity) + return (go) + + +-- combine objects into new one +combineGraphicsObjects :: EngineSystem -> [GraphicsObject] -> IO (GraphicsObject) +combineGraphicsObjects es listObjects = do + + node <- getNewNode es + sequence_ (map ( \object -> do + let objectnode = getNodeFromGraphicsObject object + parent <- cNGetParent objectnode + -- currently no check here, if parent exists! + -- no parent is only valid for root node and this is not accessible to the + -- user of this api (should not be used, at least) + cNRemoveChild2 parent objectnode + cNAddChild node objectnode + return () + ) + listObjects) + return ( CombinedObject (Node node) ) + + +-- +-- GraphicsObject functions +-- + +getPosition :: GraphicsObject -> IO (Vector3) +getPosition go = do + pos <- cNGetPosition (getNodeFromGraphicsObject go) + return (pos) + +setPosition :: GraphicsObject -> Vector3 -> IO () +setPosition go pos = do + cNSetPosition (getNodeFromGraphicsObject go) pos + return () + +setLightPos :: Light -> Float -> Float -> Float -> IO () +setLightPos (Light light) x y z = do + cLSetPosition light x y z + +getOrientation :: GraphicsObject -> IO (Quaternion) +getOrientation go = do + quat <- cNGetOrientation (getNodeFromGraphicsObject go) return (quat) -setEntityOrientation :: Entity -> Quaternion -> IO () -setEntityOrientation (Entity entity entityNode) quat = do - cNSetOrientation entityNode quat +setOrientation :: GraphicsObject -> Quaternion -> IO () +setOrientation go quat = do + cNSetOrientation (getNodeFromGraphicsObject go) quat return () +getScale :: GraphicsObject -> IO (Vector3) +getScale go = do + scale <- cNGetScale (getNodeFromGraphicsObject go) + return (scale) --- 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 +setScale :: GraphicsObject -> Vector3 -> IO () +setScale go scale = do + cNSetScale (getNodeFromGraphicsObject go) scale return () +-- Animation Functions +getAnimation :: GraphicsObject -> String -> IO (Animation) +getAnimation (GraphicsObject (Mesh mesh) _ ) animName = do + anim <- cEGetAnimationState mesh animName + return (Animation anim) + +startAnimation :: Animation -> IO () +startAnimation (Animation anim) = do + cAnsSetEnabled anim True + cAnsSetLoop anim True + +stopAnimation :: Animation -> IO () +stopAnimation (Animation anim) = do + cAnsSetEnabled anim False + cAnsSetLoop anim False + +setAnimationTime :: Animation -> Time -> IO () +setAnimationTime (Animation anim) (Time time) = do + cAnsSetTimePosition anim time + +-- Time Functions +getTime :: EngineSystem -> IO (Time) +getTime es = do + time <- cCmGetElapsedTime (esControllerManager es) + return (Time time) + + -- event functions -isKeyDown :: EngineStatus -> EnumKeyCode -> IO (Bool) -isKeyDown (EngineStatus _ _ _ _ _ _ _ keyboard) keycode = do - isdown <- cOISKIsKeyDown keyboard keycode +isKeyDown :: InputSystem -> EnumKeyCode -> IO (Bool) +isKeyDown is keycode = do + isdown <- cOISKIsKeyDown (isKeyboard is) keycode return (isdown) -- renderLoop function -renderLoop :: EngineStatus -> (EngineStatus -> IO ()) -> IO () -renderLoop (EngineStatus root sceneManager rgm inputManager window camera viewport keyboard) stepFunc = do +renderLoop :: EngineSystem -> ViewSystem -> InputSystem -> (EngineSystem -> ViewSystem -> InputSystem -> IO ()) -> IO () +renderLoop es vs is stepFunc = do fUMessagePump - closed <- cRwIsClosed window + closed <- cRwIsClosed (vsRenderWindow vs) 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 + cRRenderOneFrame (esRoot es) + cOISOCapture (isKeyboard is) + stepFunc es vs is + renderLoop es vs is stepFunc diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2012 Dr. Peter Althainz +Copyright (c) 2012 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.