HGamer3D-Graphics3D 0.3.2 → 0.4.0
raw patch · 21 files changed
+1704/−1246 lines, 21 filesdep +containersdep ~HGamer3D-Datadep ~HGamer3D-Ogre-Binding
Dependencies added: containers
Dependency ranges changed: HGamer3D-Data, HGamer3D-Ogre-Binding
Files
- HGamer3D-Graphics3D.cabal +4/−3
- HGamer3D/Graphics3D.hs +0/−58
- HGamer3D/Graphics3D/BaseAPI.hs +95/−0
- HGamer3D/Graphics3D/Basic3D.hs +0/−129
- HGamer3D/Graphics3D/Engine.hs +0/−201
- HGamer3D/Graphics3D/Internal/Base.hs +385/−0
- HGamer3D/Graphics3D/Internal/Camera.hs +173/−0
- HGamer3D/Graphics3D/Internal/Light.hs +195/−0
- HGamer3D/Graphics3D/Internal/PlatonShapes.hs +228/−0
- HGamer3D/Graphics3D/Internal/Shapes.hs +314/−0
- HGamer3D/Graphics3D/Light.hs +0/−196
- HGamer3D/Graphics3D/Object3D.hs +0/−342
- HGamer3D/Graphics3D/PlatonObjects.hs +0/−233
- HGamer3D/Graphics3D/Schema/Camera.hs +51/−0
- HGamer3D/Graphics3D/Schema/Figure.hs +38/−0
- HGamer3D/Graphics3D/Schema/Geometry.hs +50/−0
- HGamer3D/Graphics3D/Schema/Light.hs +50/−0
- HGamer3D/Graphics3D/Schema/Material.hs +35/−0
- HGamer3D/Graphics3D/Schema/Scene.hs +48/−0
- HGamer3D/Graphics3D/Types.hs +0/−84
- HGamer3D/Internal/Graphics3D.hs +38/−0
HGamer3D-Graphics3D.cabal view
@@ -1,5 +1,5 @@ Name: HGamer3D-Graphics3D -Version: 0.3.2 +Version: 0.4.0 Synopsis: 3D Graphics Functionality for HGamer3D Description: HGamer3D is a game engine for developing 3D games in the programming @@ -18,10 +18,11 @@ Extra-source-files: Setup.hs Library - Build-Depends: base >= 3 && < 5, mtl, transformers, filepath, directory, HGamer3D-Data >= 0.3.0 && < 0.4.0, HGamer3D-Ogre-Binding >= 0.3.0 && < 0.4.0 + Build-Depends: base >= 3 && < 5, containers, mtl, transformers, filepath, directory, HGamer3D-Data >= 0.4.0 && < 0.5.0, HGamer3D-Ogre-Binding >= 0.4.0 && < 0.5.0 - Exposed-modules: HGamer3D.Graphics3D.Types, HGamer3D.Graphics3D.Basic3D, HGamer3D.Graphics3D.Object3D, HGamer3D.Graphics3D.Light, HGamer3D.Graphics3D.PlatonObjects, HGamer3D.Graphics3D.Engine, HGamer3D.Graphics3D + Exposed-modules: HGamer3D.Graphics3D.Schema.Figure, HGamer3D.Graphics3D.Schema.Geometry, HGamer3D.Graphics3D.Schema.Camera, HGamer3D.Graphics3D.Schema.Light, HGamer3D.Graphics3D.Schema.Material, HGamer3D.Graphics3D.Schema.Scene, HGamer3D.Graphics3D.Internal.Base, HGamer3D.Graphics3D.Internal.Shapes, HGamer3D.Graphics3D.Internal.Light, HGamer3D.Graphics3D.Internal.PlatonShapes, HGamer3D.Graphics3D.Internal.Camera, HGamer3D.Graphics3D.BaseAPI, HGamer3D.Internal.Graphics3D + Other-modules: c-sources:
− HGamer3D/Graphics3D.hs
@@ -1,58 +0,0 @@--- This source file is part of HGamer3D--- (A project to enable 3D game development in Haskell)--- For the latest info, see http://www.hgamer3d.org------ (c) 2011-2013 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.---- Graphics.hs---- | 3D Graphics for HGamer3D-module HGamer3D.Graphics3D--(- module HGamer3D.Data,- module HGamer3D.Util,- module HGamer3D.Graphics3D.Types,- module HGamer3D.Graphics3D.Basic3D,- module HGamer3D.Graphics3D.Object3D,- module HGamer3D.Graphics3D.Light,- module HGamer3D.Graphics3D.PlatonObjects,- module HGamer3D.Graphics3D.Engine,- initHGamer3D,- exitHGamer3D,- loopHGamer3D-)--where-- import HGamer3D.Data- import HGamer3D.Util- import HGamer3D.Graphics3D.Types- import HGamer3D.Graphics3D.Basic3D- import HGamer3D.Graphics3D.Object3D- import HGamer3D.Graphics3D.Light- import HGamer3D.Graphics3D.PlatonObjects- import HGamer3D.Graphics3D.Engine-- initHGamer3D windowName sceneManagerType fConfig fLog = do- (g3ds, camera, viewport, window) <- initGraphics3D windowName sceneManagerType fConfig fLog- return (g3ds, camera, viewport)- - exitHGamer3D = exitGraphics3D- - loopHGamer3D = loopGraphics3D---
+ HGamer3D/Graphics3D/BaseAPI.hs view
@@ -0,0 +1,95 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- Graphics.hs++-- | 3D Graphics for HGamer3D, public API.+module HGamer3D.Graphics3D.BaseAPI++(+ -- * Basic Types for the Graphics3D System+ Graphics3DSystem,+ Object3D,+ Camera,++ -- * Initializing the Graphics3D Subsystem+ + -- |+ -- The initialization, step and free functions are called from the HGamer3D corresponding functions, therefore+ -- they do not need to be called in code, which includes HGamer3D - BaseAPI.+ + initGraphics3D,+ stepGraphics3D,+ freeGraphics3D,++ -- * Creating, Updating and Removing of 3D Objects+ Graphics3DItem (..),+ + -- * Creating simple 3D objects+ sphere,+ cube,+ cuboid,+ ikosaeder,+ dodekaeder,++ -- * Light+ Light,+ addLight,+ updateLight,+ removeLight,+ + HGamer3D.Graphics3D.Internal.Light.setAmbientLight,+ pointLight,+ spotLight,+ spotLightSetDirection,+ directionalLight,++ -- * Material+ Material (..),+ + -- * Misc Functions++ addCamera,+ removeCamera,+ updateCamera,+ cameraLookAt,+ cameraAdaptAspectRatio,++ addResourceLocationMedia,+ addResourceZipfileMedia,+ addResourceLocationGUI,++)++where++ import HGamer3D.Data+ import HGamer3D.Util+ + import HGamer3D.Graphics3D.Internal.Base+ import HGamer3D.Graphics3D.Internal.Light+ import HGamer3D.Graphics3D.Internal.Shapes+ import HGamer3D.Graphics3D.Internal.Camera+ + import HGamer3D.Graphics3D.Schema.Material+ +-- import HGamer3D.Graphics3D.Internal.PlatonShapes+ +++
− HGamer3D/Graphics3D/Basic3D.hs
@@ -1,129 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}---- This source file is part of HGamer3D--- (A project to enable 3D game development in Haskell)--- For the latest info, see http://www.hgamer3d.org------ (c) 2011-2013 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.---- Basic3D.hs---- | Basic functions for the Graphics3D module-module HGamer3D.Graphics3D.Basic3D (--- cameraLookAt,- - -- * Background Colour- HGamer3D.Graphics3D.Basic3D.setBackgroundColour,- - -- * Resource locations- -- $audioresource- - addResourceLocationMedia,- addResourceZipfileMedia,- addResourceLocationGUI-)--where --import HGamer3D.Data--import HGamer3D.Bindings.Ogre.ClassCamera as Camera-import HGamer3D.Bindings.Ogre.ClassViewport as Viewport-import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager--import HGamer3D.Graphics3D.Types---- Camera functions------instance Position3D Camera where-- position3D (Camera c) = do- pos <- Camera.getPosition c- return (pos)- - positionTo3D (Camera c) pos = do- Camera.setPosition2 c pos- return ()- -instance Direction3D Camera where-- direction3D (Camera c) = do- d <- Camera.getDirection c- return d- - directionTo3D (Camera c) v = do- Camera.setDirection2 c v- -instance Orientation3D Camera where-- orientation3D (Camera c) = do- q <- Camera.getOrientation c- let uq = mkNormal q- return uq- - orientationTo3D (Camera c) uq = do- Camera.setOrientation c (fromNormal uq)- return ()---- | set the direction in a way, that the camera looks toward a specified point-cameraLookAt :: Camera -> Vec3 -> IO ()-cameraLookAt (Camera c) v = do- Camera.lookAt c v- return ()----- specific single function------- | sets the background colour of the 3d drawing window-setBackgroundColour :: Viewport -> Colour -> IO ()-setBackgroundColour (Viewport viewport) bgColour = do- Viewport.setBackgroundColour viewport bgColour---- locations of media in same folder as program resides--- ---- | adds a resource location for 3D media (Ogre)-addResourceLocationMedia :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D- -> String -- ^ path to new resource location, the path should identify a directory- -> IO ()-addResourceLocationMedia g3ds path = do- let (ResourceGroupManager rgm) = (g3dsResourceGroupManager g3ds)- ResourceGroupManager.addResourceLocation rgm path "FileSystem" "General" False- ResourceGroupManager.initialiseResourceGroup rgm "General"---- | adds a resource location for 3D media (Ogre) which is a zip file-addResourceZipfileMedia :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> String -- ^ path to new resource location, the path should identify a zip file- -> IO ()-addResourceZipfileMedia g3ds path = do- let (ResourceGroupManager rgm) = (g3dsResourceGroupManager g3ds)- ResourceGroupManager.addResourceLocation rgm path "Zip" "General" False- ResourceGroupManager.initialiseResourceGroup rgm "General"---- | adds a resource location for GUI media (CEGUI) which is a directory-addResourceLocationGUI :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D- -> String -- ^ path to the directory with the GUI media in it- -> String -- ^ category of GUI media, for example: Layout, Images, ...- -> IO ()-addResourceLocationGUI g3ds path category = do- let (ResourceGroupManager rgm) = (g3dsResourceGroupManager g3ds)- ResourceGroupManager.addResourceLocation rgm path "FileSystem" category False- ResourceGroupManager.initialiseResourceGroup rgm category-
− HGamer3D/Graphics3D/Engine.hs
@@ -1,201 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}---- This source file is part of HGamer3D--- (A project to enable 3D game development in Haskell)--- For the latest info, see http://www.hgamer3d.org------ (c) 2011-2013 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.---- EngineHelper.hs---- | Initialization functions for the Graphics3D module-module HGamer3D.Graphics3D.Engine (-- initGraphics3D,- graphics3DPumpWindowMessages,- exitGraphics3D,- loopGraphics3D,- renderOneFrame,- checkQuitReceived-) --where--import HGamer3D.Data-import HGamer3D.Util--import qualified HGamer3D.Bindings.Ogre.ClassRoot as Root-import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager-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.ClassLogManager as LogManager-import HGamer3D.Bindings.Ogre.ClassLog as Log-import HGamer3D.Bindings.Ogre.ClassHG3DUtilities as Util-import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget-import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject-import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType-import HGamer3D.Bindings.Ogre.StructHG3DClass-import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType-import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities--import HGamer3D.Graphics3D.Types-import HGamer3D.Graphics3D.Basic3D--import Control.Monad-import Control.Monad.Trans-import Control.Monad.IO.Class-import Control.Monad.State.Class--import Control.Concurrent-import Data.Maybe---- | pump window messages for graphics--- Not to be used, if WinEvent pollWinEvent or pumpWinEvents is used!-graphics3DPumpWindowMessages :: IO ()-graphics3DPumpWindowMessages = do- WindowEventUtilities.messagePump- return ()---- | renders one frame on the screen-renderOneFrame :: Graphics3DSystem -> IO ()-renderOneFrame g3ds = do - let (RootObject root) = g3dsRoot g3ds- Root.renderOneFrame root- return ()---loopGraphics3D :: Graphics3DSystem -> IO Bool-loopGraphics3D g3ds = do- renderOneFrame g3ds- graphics3DPumpWindowMessages- i <- checkQuitReceived- return (i == 1)- -exitGraphics3D :: Graphics3DSystem -> IO ()-exitGraphics3D g3ds = do- let (RootObject root) = g3dsRoot g3ds- let (RenderTarget rt) = g3dsRenderTarget g3ds- Root.destroyRenderTarget root rt- Root.delete root- return ()---- | initializes the 3d graphics module-initGraphics3D :: String -- ^ Name of the window, displayed- -> String -- ^ SceneManager type used- -> Bool -- ^ flag, show configuration dialogue- -> Bool -- ^ flag, is logging enabled- -> IO (Graphics3DSystem, Camera, Viewport, Window)- -initGraphics3D windowName sceneManagerType fConfig fLog = do-- -- configuration path can be app user dir or local dir- localDir <- getAppConfigDirectory- appDir <- getExeConfigDirectory- configFile <- findFileInDirs "engine.cfg" [localDir, appDir]- pluginsFile <- findFileInDirs "plugins.cfg" [localDir, appDir]- - -- check both files exists- let config = case configFile of- Just cf -> cf- Nothing -> error $ "HGamer3D - Graphics3D: could not find engine configuration file engine.cfg"- - let plugins = case pluginsFile of- Just pf -> pf- Nothing -> error $ "HGamer3D - Graphics3D: could not find plugins configuration file plugins.cfg"- - 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 ""- setupCloseEventHandler renderWindow- windowHandle <- Util.getWindowHandle renderWindow- - -- 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- - -- resource locations, if path given, use this as base, if not use standard locations- - rgm <- ResourceGroupManager.getSingletonPtr- - ResourceGroupManager.createResourceGroup rgm "Schemes" False- ResourceGroupManager.createResourceGroup rgm "Imagesets" False- ResourceGroupManager.createResourceGroup rgm "Fonts" False- ResourceGroupManager.createResourceGroup rgm "Layouts" False- ResourceGroupManager.createResourceGroup rgm "LookNFeel" False- ResourceGroupManager.createResourceGroup rgm "LuaScripts" False- ResourceGroupManager.createResourceGroup rgm "XMLSchemas" False- - mediapath1 <- getAppMediaDirectory- mediapath2 <- getExeMediaDirectory- - mapM (\mediapath -> do- ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "materials") "FileSystem" "General" False- ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "schemes") "FileSystem" "Schemes" False- ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "imagesets") "FileSystem" "Imagesets" False- ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "fonts") "FileSystem" "Fonts" False- ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "layouts") "FileSystem" "Layouts" False- ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "looknfeel") "FileSystem" "LookNFeel" False- ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "lua_scripts") "FileSystem" "LuaScripts" False- ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "xml_schemas") "FileSystem" "XMLSchemas" False- return ()) [mediapath1, mediapath2]- -- ResourceGroupManager.initialiseAllResourceGroups rgm- uniqueName <- createUniqueName "HG3DObj"- - return $ (Graphics3DSystem (RootObject root) (SceneManager sceneManager) (ResourceGroupManager rgm) (LogManager lmgr) (TextureManager tm) (RenderTarget renderWindow) uniqueName, (Camera camera), (Viewport viewport), (Window windowHandle)) --
+ HGamer3D/Graphics3D/Internal/Base.hs view
@@ -0,0 +1,385 @@+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- Graphics3D/Internal/Base.hs++module HGamer3D.Graphics3D.Internal.Base +where++import HGamer3D.Data+import HGamer3D.Data.HG3DClass+import HGamer3D.Data.Window++import HGamer3D.Util++import qualified HGamer3D.Bindings.Ogre.ClassRoot as Root+import HGamer3D.Bindings.Ogre.ClassCamera as Camera+import HGamer3D.Bindings.Ogre.ClassNode as Node+import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager+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.ClassLogManager as LogManager+import HGamer3D.Bindings.Ogre.ClassLog as Log+import HGamer3D.Bindings.Ogre.ClassHG3DUtilities as Util+import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget+import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject+import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType+import HGamer3D.Bindings.Ogre.StructHG3DClass+import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType+import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities+import HGamer3D.Bindings.Ogre.ClassSceneNode as SceneNode++import Control.Monad+import Control.Monad.Trans+import Control.Monad.IO.Class+import Control.Monad.State.Class+import qualified System.Info as SI++import Control.Concurrent+import Data.Maybe++import HGamer3D.Data+import HGamer3D.Util++import HGamer3D.Graphics3D.Schema.Material+import HGamer3D.Graphics3D.Schema.Geometry+import HGamer3D.Graphics3D.Schema.Figure+import qualified HGamer3D.Graphics3D.Schema.Scene as Sc+import qualified HGamer3D.Graphics3D.Schema.Camera as Cam++data SceneManager = SceneManager HG3DClass+data ResourceGroupManager = ResourceGroupManager HG3DClass+data RootObject = RootObject HG3DClass+data TextureManager = TextureManager HG3DClass+data LogManager = LogManager HG3DClass+data RenderTarget = RenderTarget HG3DClass++-- | This data type holds the internal pointers to implementation objects and some additional state+-- like a unique name generator for implementation purposes.+data Graphics3DSystem = Graphics3DSystem {+ g3dsRoot :: RootObject,+ g3dsSceneManager :: SceneManager,+ g3dsResourceGroupManager :: ResourceGroupManager,+ g3dsLogManager :: LogManager,+ g3dsTextureManager :: TextureManager,+ g3dsRenderTarget :: RenderTarget,+ g3dsUniqueName :: UniqueName+}++-- | initializes the 3d graphics module+initGraphics3D :: String -- ^ Name of the window, displayed+ -> String -- ^ SceneManager type used+ -> Bool -- ^ flag, show configuration dialogue+ -> Bool -- ^ flag, is logging enabled+ -> IO (Graphics3DSystem, Window)+ +initGraphics3D windowName sceneManagerType fConfig fLog = do++ -- configuration path can be app user dir or local dir+ localDir <- getAppConfigDirectory+ appDir <- getExeConfigDirectory+ configFile <- findFileInDirs "engine.cfg" [localDir, appDir]+ pluginsFile <- findFileInDirs "plugins.cfg" [localDir, appDir]+ + -- check both files exists+ let config = case configFile of+ Just cf -> cf+ Nothing -> error $ "HGamer3D - Graphics3D: could not find engine configuration file engine.cfg"+ + let plugins = case pluginsFile of+ Just pf -> pf+ Nothing -> error $ "HGamer3D - Graphics3D: could not find plugins configuration file plugins.cfg"+ + 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 ""+ setupCloseEventHandler renderWindow+ windowHandle <- Util.getWindowHandle renderWindow+ + -- 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+ + -- resource locations, if path given, use this as base, if not use standard locations+ + rgm <- ResourceGroupManager.getSingletonPtr+ + ResourceGroupManager.createResourceGroup rgm "Schemes" False+ ResourceGroupManager.createResourceGroup rgm "Imagesets" False+ ResourceGroupManager.createResourceGroup rgm "Fonts" False+ ResourceGroupManager.createResourceGroup rgm "Layouts" False+ ResourceGroupManager.createResourceGroup rgm "LookNFeel" False+ ResourceGroupManager.createResourceGroup rgm "LuaScripts" False+ ResourceGroupManager.createResourceGroup rgm "XMLSchemas" False+ + mediapath1 <- getAppMediaDirectory+ mediapath2 <- getExeMediaDirectory+ + mapM (\mediapath -> do+ ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "materials") "FileSystem" "General" False+ ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "schemes") "FileSystem" "Schemes" False+ ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "imagesets") "FileSystem" "Imagesets" False+ ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "fonts") "FileSystem" "Fonts" False+ ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "layouts") "FileSystem" "Layouts" False+ ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "looknfeel") "FileSystem" "LookNFeel" False+ ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "lua_scripts") "FileSystem" "LuaScripts" False+ ResourceGroupManager.addResourceLocation rgm (mediapath ++ osSep ++ "xml_schemas") "FileSystem" "XMLSchemas" False+ return ()) [mediapath1, mediapath2]+ ++ ResourceGroupManager.initialiseAllResourceGroups rgm+ uniqueName <- createUniqueName "HG3DObj"+ + return $ (Graphics3DSystem (RootObject root) (SceneManager sceneManager) (ResourceGroupManager rgm) (LogManager lmgr) (TextureManager tm) (RenderTarget renderWindow) uniqueName, (Window windowHandle)) +++-- | steps the game loop by one tick, renders a frame and handles system messages+stepGraphics3D :: Graphics3DSystem -- ^ the graphics3d system+ -> IO Bool -- ^ quit flag, true if window closed+stepGraphics3D g3ds = do+ renderOneFrame g3ds+ -- this one is quite tricky, on Linux we need to call the message loop in addition to WinEvent!+ if SI.os /= "mingw32" then graphics3DPumpWindowMessages else return ()+ graphics3DPumpWindowMessages+ i <- checkQuitReceived+ return (i == 1)++-- | frees resources and shutdown the Graphics3D sub-system+freeGraphics3D :: Graphics3DSystem -> IO ()+freeGraphics3D g3ds = do+ let (RootObject root) = g3dsRoot g3ds+ let (RenderTarget rt) = g3dsRenderTarget g3ds+ Root.destroyRenderTarget root rt+ Root.delete root+ return ()++-- | adds a resource location for 3D media (Ogre)+addResourceLocationMedia :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D+ -> String -- ^ path to new resource location, the path should identify a directory+ -> IO ()+addResourceLocationMedia g3ds path = do+ let (ResourceGroupManager rgm) = (g3dsResourceGroupManager g3ds)+ ResourceGroupManager.addResourceLocation rgm path "FileSystem" "General" False+ ResourceGroupManager.initialiseResourceGroup rgm "General"++-- | adds a resource location for 3D media (Ogre) which is a zip file+addResourceZipfileMedia :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D + -> String -- ^ path to new resource location, the path should identify a zip file+ -> IO ()+addResourceZipfileMedia g3ds path = do+ let (ResourceGroupManager rgm) = (g3dsResourceGroupManager g3ds)+ ResourceGroupManager.addResourceLocation rgm path "Zip" "General" False+ ResourceGroupManager.initialiseResourceGroup rgm "General"++-- | adds a resource location for GUI media (CEGUI) which is a directory+addResourceLocationGUI :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D+ -> String -- ^ path to the directory with the GUI media in it+ -> String -- ^ category of GUI media, for example: Layout, Images, ...+ -> IO ()+addResourceLocationGUI g3ds path category = do+ let (ResourceGroupManager rgm) = (g3dsResourceGroupManager g3ds)+ ResourceGroupManager.addResourceLocation rgm path "FileSystem" category False+ ResourceGroupManager.initialiseResourceGroup rgm category++-- | pump window messages for graphics+-- Not to be used, if WinEvent pollWinEvent or pumpWinEvents is used!+graphics3DPumpWindowMessages :: IO ()+graphics3DPumpWindowMessages = do+ WindowEventUtilities.messagePump+ return ()++-- | renders one frame on the screen+renderOneFrame :: Graphics3DSystem -> IO ()+renderOneFrame g3ds = do + let (RootObject root) = g3dsRoot g3ds+ Root.renderOneFrame root+ return ()+++-- | Typed Ogre Classes: Node+data ONode = ON HG3DClass -- this object is an Ogre Node++-- | Typed Ogre Classes: Entity+data OEntity = OE HG3DClass -- this object is an Ogre Entity++-- | Typed Ogre Classes: Light+data OLight = OL HG3DClass -- this object is an Ogre Light++-- | Typed Ogre Classes: Camera+data OCamera = OC HG3DClass -- this object is an Ogre Camera++-- | Typed Ogre Classes: Material+data OMaterial = OM HG3DClass -- this object is an Ogre Material+++-- | Typeclass for types, which have a main Node+class HasNode a where+ getNode :: a -> ONode+ getNode' :: a -> HG3DClass+ getNode' = (\(ON n) -> n) . getNode+ setNodePos :: a -> Position -> IO ()+ setNodePos hn pos = Node.setPosition (getNode' hn) pos+ setNodeOri :: a -> Orientation -> IO ()+ setNodeOri hn ori = Node.setOrientation (getNode' hn) (fromNormal ori)+ setNodeSiz :: a -> Size -> IO ()+ setNodeSiz hn siz = Node.setScale (getNode' hn) siz++instance HasNode ONode where+ getNode n = n++-- | Typeclass for objects which can be attached to Nodes+class NodeContent a where+ attachToNode :: a -> ONode -> IO ()+ detachFromNode :: a -> ONode -> IO ()++instance NodeContent OEntity where+ attachToNode (OE en) (ON n) = SceneNode.attachObject n en+ detachFromNode (OE en) (ON n) = SceneNode.detachObject2 n en++instance NodeContent OCamera where+ attachToNode (OC en) (ON n) = SceneNode.attachObject n en+ detachFromNode (OC en) (ON n) = SceneNode.detachObject2 n en++instance NodeContent OLight where+ attachToNode (OL en) (ON n) = SceneNode.attachObject n en+ detachFromNode (OL en) (ON n) = SceneNode.detachObject2 n en+++-- |+-- For the data driven API, we need an internal representation, which+-- holds state inside the engine for outside defined data items (see Schema).+-- The following data definitions provide the framework for capturing+-- engine state for Figure and Geometry objects.+--+-- The EngineData Type holds a tree of items, corresponding to a Figure schema+-- data item, which also holds a corresponding pure data tree.+data EngineData = EDEntityNode OEntity ONode+ | EDNodeAndSub ONode [EngineData]++-- | A 3D Object represents the state inside the engine for a Schema 3D data item+data Object3D a = Object3D EngineData a++-- |+-- The Graphics3DItem TypeClass provides functions, which create, modify and delete objects in+-- the 3D world by simple data definitions. Instances of this TypeClass provide the implementations+-- behind for various 3D objects in the 3D world.+class Graphics3DItem a where+ object3D :: Graphics3DSystem -> a -> IO (Object3D a)+ update3D :: Graphics3DSystem -> Object3D a -> a -> IO (Object3D a)+ remove3D :: Graphics3DSystem -> (Object3D a) -> IO ()++instance HasNode EngineData where+ getNode (EDEntityNode _ node) = node+ getNode (EDNodeAndSub node _) = node++instance HasNode (Object3D a) where+ getNode (Object3D (EDEntityNode _ node) _) = node+ getNode (Object3D (EDNodeAndSub node _) _) = node++_getRootNode :: Graphics3DSystem -> IO ONode+_getRootNode g3ds = do+ let (SceneManager scm) = (g3dsSceneManager g3ds)+ rootNode <- SceneManager.getRootSceneNode scm+ return (ON rootNode)++_createSubNode :: ONode -> IO ONode+_createSubNode (ON parent) = SceneNode.createChildSceneNode parent zeroVec3 unitQ >>= (return . ON)++_addEntityToNode :: Graphics3DSystem -> ONode -> OEntity -> IO ()+_addEntityToNode g3ds(ON node) (OE meshEntity) = SceneNode.attachObject node meshEntity ++_exchangeEntityInNode :: Graphics3DSystem -> ONode -> OEntity -> OEntity -> IO ()+_exchangeEntityInNode g3ds (ON meshNode) (OE oldMeshEntity) (OE newMeshEntity) = do+ let (SceneManager scm) = (g3dsSceneManager g3ds)+ SceneNode.detachObject2 meshNode oldMeshEntity+ SceneManager.destroyEntity scm oldMeshEntity+ SceneNode.attachObject meshNode newMeshEntity++_removeEntityAndNode :: Graphics3DSystem -> ONode -> OEntity -> ONode -> IO ()+_removeEntityAndNode g3ds (ON parent) (OE meshEntity ) (ON meshNode) = do+ let (SceneManager scm) = (g3dsSceneManager g3ds)+ rootNode <- SceneManager.getRootSceneNode scm+ SceneNode.detachObject2 meshNode meshEntity+ SceneManager.destroyEntity scm meshEntity+ Node.removeChild2 parent meshNode+ SceneManager.destroySceneNode2 scm meshNode++setSceneParameter :: Graphics3DSystem -> Sc.SceneParameter -> IO ()+setSceneParameter g3ds scene = do+ let (SceneManager scm) = g3dsSceneManager g3ds+ let (Sc.SceneParameter aLightColour shadow sky) = scene+ -- set ambient Light+ SceneManager.setAmbientLight scm aLightColour+ -- set Shadow Mode to be done++ -- set skybox+ case sky of+ Sc.NoSky -> do+ SceneManager.setSkyBoxEnabled scm False+ SceneManager.setSkyDomeEnabled scm False+ Sc.SkyBox (ResourceMaterial mname) distance -> do+ SceneManager.setSkyDomeEnabled scm False+ SceneManager.setSkyBox scm True mname distance True unitQ "General"+ Sc.SkyDome (ResourceMaterial mname) curvature tiling distance -> do+ SceneManager.setSkyBoxEnabled scm False+ SceneManager.setSkyDome scm True mname curvature tiling distance True unitQ 16 16 (-1) "General"++ return ()
+ HGamer3D/Graphics3D/Internal/Camera.hs view
@@ -0,0 +1,173 @@+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- Graphics3D/Internal/Camera.hs++module HGamer3D.Graphics3D.Internal.Camera+where++import HGamer3D.Data+import HGamer3D.Data.HG3DClass+import HGamer3D.Data.Window++import HGamer3D.Util++import qualified HGamer3D.Bindings.Ogre.ClassRoot as Root+import HGamer3D.Bindings.Ogre.ClassCamera as Camera+import HGamer3D.Bindings.Ogre.ClassNode as Node+import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager+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.ClassLogManager as LogManager+import HGamer3D.Bindings.Ogre.ClassLog as Log+import HGamer3D.Bindings.Ogre.ClassHG3DUtilities as Util+import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget+import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject+import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType+import HGamer3D.Bindings.Ogre.StructHG3DClass+import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType+import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities++import Control.Monad+import Control.Monad.Trans+import Control.Monad.IO.Class+import Control.Monad.State.Class+import qualified System.Info as SI++import Control.Concurrent+import Data.Maybe++import HGamer3D.Data+import HGamer3D.Util++import HGamer3D.Graphics3D.Schema.Material+import HGamer3D.Graphics3D.Schema.Geometry+import HGamer3D.Graphics3D.Schema.Figure+import qualified HGamer3D.Graphics3D.Schema.Camera as Cam+import HGamer3D.Graphics3D.Internal.Base+++{- ----------------------------------------------------------------+ Camera+ ---------------------------------------------------------------- -}++-- | Camera, internal data object for engine+data Camera = Camera {+ cameraCamObject :: HG3DClass,+ cameraViewportObject :: HG3DClass,+ cameraSchema :: Cam.Camera+ }++-- | add a camera, you probably want to do this at least once+addCamera :: Graphics3DSystem -- ^ the graphics system+ -> Cam.Camera -- ^ the Schema data for the camera+ -> IO Camera -- ^ the resulting engine object+addCamera g3ds schema = do+ let (SceneManager sceneManager) = g3dsSceneManager g3ds+ let uname = g3dsUniqueName g3ds+ let (RenderTarget renderWindow) = g3dsRenderTarget g3ds+ let Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgr) = schema+ -- create camera+ cameraName <- (nextUniqueName uname) >>= (\n -> return ("Camera"++n))+ camera <- SceneManager.createCamera sceneManager cameraName+ -- add Viewport+ viewport <- RenderTarget.addViewport renderWindow camera z (rectX pos) (rectY pos) (rectWidth pos) (rectHeight pos)+ -- set Viewport parameters+ Viewport.setBackgroundColour viewport bgr+ -- set Frustum parameters+ Frustum.setNearClipDistance camera nd+ Frustum.setFarClipDistance camera fd+ Frustum.setFOVy camera (fromAngle fov)+ -- create camera return value+ let cam = Camera camera viewport schema+ -- adapt aspect ratio+ cameraAdaptAspectRatio cam++ return cam++-- | remove a camera +removeCamera :: Graphics3DSystem -> Camera -> IO ()+removeCamera g3ds (Camera camera viewport schema) = do+ let (SceneManager sceneManager) = g3dsSceneManager g3ds+ let (RenderTarget renderWindow) = g3dsRenderTarget g3ds+ let Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgr) = schema+ RenderTarget.removeViewport renderWindow z+ SceneManager.destroyCamera sceneManager camera++-- | update an existing camera with new parameters+updateCamera :: Graphics3DSystem -> Camera -> Cam.Camera -> IO Camera+updateCamera g3ds cam@(Camera camera viewport schema) schema' = do+ + let Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgr) = schema+ let Cam.Camera (Cam.Frustum nd' fd' fov') (Cam.Viewport z' pos' bgr') = schema'+ -- if zorder or position are not equal, we need to rebuild+ if (z /= z') || (pos /= pos') then do+ removeCamera g3ds cam+ addCamera g3ds schema'+ else do+ -- adapt single values, as needed+ if nd /= nd' then Frustum.setNearClipDistance camera nd' else return ()+ if fd /= fd' then Frustum.setFarClipDistance camera fd' else return ()+ if fov /= fov' then Frustum.setFOVy camera (fromAngle fov') else return ()+ if bgr /= bgr' then Viewport.setBackgroundColour viewport bgr' else return ()+ return (Camera camera viewport schema')+ +-- | adapt the aspect ration, in case the window size and aspect ratio changes, this+-- is called inside the engine automatically.+cameraAdaptAspectRatio :: Camera -> IO ()+cameraAdaptAspectRatio cam = do+ let (Camera camera viewport schema) = cam+ height <- Viewport.getActualHeight viewport+ width <- Viewport.getActualWidth viewport+ Frustum.setAspectRatio camera ((fromIntegral width) / (fromIntegral height))+ return ()+ +instance HasPosition Camera where+ position (Camera c _ _) = Camera.getPosition c+ positionTo (Camera c _ _) pos = Camera.setPosition2 c pos+ +instance HasOrientation Camera where+ orientation (Camera c _ _) = do+ q <- Camera.getOrientation c+ let uq = mkNormal q+ return uq+ orientationTo (Camera c _ _) uq = do+ Camera.setOrientation c (fromNormal uq)+ return ()++-- | set the direction in a way, that the camera looks toward a specified point+cameraLookAt :: Camera -> Vec3 -> IO ()+cameraLookAt (Camera c _ _) v = do+ Camera.lookAt c v+ return ()++-- | Background colour of the 3d drawing window+setBackgroundColour :: Graphics3DSystem -> Camera -> Colour -> IO Camera+setBackgroundColour g3ds cam@(Camera camera viewport schema) bgColour = do+ let Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgr) = schema+ let schema' = Cam.Camera (Cam.Frustum nd fd fov) (Cam.Viewport z pos bgColour)+ updateCamera g3ds cam schema'+
+ HGamer3D/Graphics3D/Internal/Light.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_HADDOCK hide #-} + +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.hgamer3d.org +-- +-- (c) 2011-2014 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. + +-- Graphics3D/Internal/Light.hs + +-- | Creating and managing Light in Base API. Internal implementation module. Public API is in HGamer3D.Graphics3D. + + +module HGamer3D.Graphics3D.Internal.Light +where + +import Data.Maybe + +import HGamer3D.Data +import HGamer3D.Data.HG3DClass +import HGamer3D.Util + +import GHC.Ptr + +import HGamer3D.Bindings.Ogre.ClassPtr +import HGamer3D.Bindings.Ogre.Utils + +import HGamer3D.Bindings.Ogre.StructColour +import HGamer3D.Bindings.Ogre.StructSharedPtr + +import HGamer3D.Bindings.Ogre.EnumSceneType +import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace +import HGamer3D.Bindings.Ogre.EnumLightType + +--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.ClassManualObject as ManualObject +import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType +import HGamer3D.Bindings.Ogre.StructHG3DClass +import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType + +import HGamer3D.Data.HG3DClass +import HGamer3D.Data.Transform3D +import HGamer3D.Graphics3D.Internal.Base + +import Control.Monad +import Control.Monad.Trans +import Control.Monad.IO.Class +import Control.Monad.State.Class + +import qualified HGamer3D.Graphics3D.Schema.Light as L + + +-- | The light. +data Light = Light ONode OLight L.Light + +instance HasNode Light where + getNode (Light node _ _) = node + +instance HasPosition Light where + position obj = Node.getPosition (getNode' obj) + positionTo obj pos = Node.setPosition (getNode' obj) pos + +instance HasOrientation Light where + orientation obj = do + q <- Node.getOrientation (getNode' obj) + let uq = mkNormal q + return uq + orientationTo obj uq = do + Node.setOrientation (getNode' obj) (fromNormal uq) + return () + +addLight :: Graphics3DSystem -> L.Light -> IO Light +addLight g3ds schema = do + let (SceneManager scm) = (g3dsSceneManager g3ds) + let (L.Light diffuse@(Colour r g b _) specular@(Colour r' g' b' _) ltype) = schema + lightName <- nextUniqueName (g3dsUniqueName g3ds) + light <- SceneManager.createLight scm lightName + Light.setDiffuseColour light r g b + Light.setSpecularColour light r' g' b' + case ltype of + L.PointLight -> Light.setType light LT_POINT + L.DirectionalLight dir -> do + Light.setType light LT_DIRECTIONAL + Light.setDirection2 light dir + L.SpotLight dir inner outer -> do + Light.setType light LT_SPOTLIGHT + Light.setDirection2 light dir + Light.setSpotlightInnerAngle light (fromAngle inner) + Light.setSpotlightOuterAngle light (fromAngle outer) + let l = OL light + rn <- _getRootNode g3ds + n <- _createSubNode rn + attachToNode l n + return $ Light n l schema + +removeLight :: Graphics3DSystem -> Light -> IO () +removeLight g3ds (Light n@(ON node) l@(OL light) schema) = do + let (SceneManager scm) = (g3dsSceneManager g3ds) + detachFromNode l n + (ON rn) <- _getRootNode g3ds + Node.removeChild2 rn node + SceneManager.destroyLight2 scm light + +updateLight :: Graphics3DSystem -> Light -> L.Light -> IO Light +updateLight g3ds l schema = do + let (SceneManager scm) = (g3dsSceneManager g3ds) + removeLight g3ds l + addLight g3ds schema + +-- | Ambient light is present everywhere, this function creates it and sets the colour of it. +-- There is no light object, since movement, rotation, scaling would make no sense anyhow. +setAmbientLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D + -> Colour -> IO () +setAmbientLight g3ds colour = do + let (SceneManager scm) = (g3dsSceneManager g3ds) + SceneManager.setAmbientLight scm colour + +-- | creates a point light at a specific location +pointLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D + -> Colour -- ^ diffuse Color of the light + -> Colour -- ^ specular Color of the light + -> Vec3 -- ^ Position, where light is created + -> IO (Light) -- ^ The light object +pointLight g3ds diffuse specular pos = do + let schema = L.Light diffuse specular L.PointLight + light <- addLight g3ds schema + positionTo light pos + return $ light + +-- | creates a spot light at a specific location +spotLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D + -> Colour -- ^ diffuse Colour of the light + -> Colour -- ^ specular Colour of the light + -> Vec3 -- ^ Position, where light is created + -> Vec3 -- ^ Direction, where light points + -> Angle -- ^ inner Angle of cone (5..355 degrees) + -> Angle -- ^ outer Angle of cone (5..355 degrees) + -> IO Light -- ^ The light object +spotLight g3ds diffuse specular pos dir inner outer = do + let schema = L.Light diffuse specular (L.SpotLight dir inner outer) + light <- addLight g3ds schema + positionTo light pos + return $ light + +-- | sets spotlight direction +spotLightSetDirection :: Graphics3DSystem -> Light -> Vec3 -> IO Light +spotLightSetDirection g3ds light dir' = do + let (Light n l schema) = light + let (L.Light diffuse@(Colour r g b _) specular@(Colour r' g' b' _) ltype) = schema + case ltype of + (L.SpotLight dir inner outer) -> updateLight g3ds light (L.Light diffuse specular (L.SpotLight dir' inner outer)) + _ -> return light + +-- | creates a directional light at a specific location +directionalLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D + -> Colour -- ^ diffuse Colour of the light + -> Colour -- ^ specular Colour of light + -> Vec3 -- ^ direction of light + -> IO (Light) -- ^ The light object +directionalLight g3ds diffuse specular dir = do + let schema = L.Light diffuse specular (L.DirectionalLight dir) + light <- addLight g3ds schema + return $ light + +
+ HGamer3D/Graphics3D/Internal/PlatonShapes.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2013 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.++-- Graphics3D/Internal/PlatonShapes.hs++-- | Create platonic shapes, ikosaeder and dodekaeder, implementation module. Public API is in HGamer3D.Graphics3D.+module HGamer3D.Graphics3D.Internal.PlatonShapes +where+++import GHC.Ptr++import HGamer3D.Data+import HGamer3D.Data.HG3DClass+import HGamer3D.Util++import HGamer3D.Bindings.Ogre.ClassPtr+import HGamer3D.Bindings.Ogre.Utils++import HGamer3D.Bindings.Ogre.StructColour+import HGamer3D.Bindings.Ogre.StructSharedPtr+import HGamer3D.Bindings.Ogre.StructHG3DClass++import HGamer3D.Bindings.Ogre.EnumSceneType+import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace+import HGamer3D.Bindings.Ogre.EnumLightType+import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType+import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType++--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.ClassManualObject as ManualObject++import HGamer3D.Graphics3D.Internal.Base++import Control.Monad+import Control.Monad.Trans+import Control.Monad.IO.Class+import Control.Monad.State.Class++vminus = Vec3 (-1.0) (-1.0) (-1.0)++getNormOfFace vertices (a, b, c) = normalize cross+ where + v1 = vertices !! a+ v2 = vertices !! b+ v3 = vertices !! c + cross = (v2 &- v1) `crossprod` (v3 &- v1)+ ++isIn (a, b, c) n = if n == a then True else + if n == b then True else+ if n == c then True else+ False+++_createPlatonObject :: Graphics3DSystem -> Colour -> [Vec3] -> [(Int, Int, Int)] -> Int -> IO HG3DClass+_createPlatonObject g3ds colour vertices faces iColor = do++ let (SceneManager scm) = (g3dsSceneManager g3ds)+ uid <- nextUniqueName (g3dsUniqueName g3ds)++ mo <- SceneManager.createManualObject scm uid+ -- set Dynamic to false+ ManualObject.setDynamic mo False++ let normsOfFaces = map (getNormOfFace vertices) faces+ + let vzero = Vec3 0.0 0.0 0.0 + + let normsOfVertices = map vnorm allVerticesIndexes+ where + allVerticesIndexes = [ i | i <- [0..(length vertices)]] + vnorm = (\i -> normalize $ foldr (&+) vzero (map (\face -> if isIn face i then normsOfFaces !! i else vzero) faces))++ sequence $ map (\((x,y,z), norm) -> do+ ManualObject.begin mo "BaseWhiteNoLightning" OT_TRIANGLE_LIST "General"+ ManualObject.position mo (vertices !! x)+ ManualObject.normal mo norm+ ManualObject.position mo (vertices !! y)+ ManualObject.position mo (vertices !! z)+ ManualObject.triangle mo 0 1 2+ ManualObject.end mo) (zip faces normsOfFaces)++ return mo+ ++-- | create an ikoaeder mesh - from the mesh more objects can be created+ikosaederE :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D+ -> Colour -- ^ colour of the ikosaeder+ -> IO HG3DClass -- ^ created mesh object as entity+ikosaederE g3ds colour = do+ let (SceneManager scm) = (g3dsSceneManager g3ds)+ uid <- nextUniqueName (g3dsUniqueName g3ds)++ let bodyName = "B" ++ uid+ let meshName = "M" ++ uid+ + let x = 0.525731112119133606+ let z = 0.850650808352039932+ + let vertices = [+ ( Vec3 (-x) 0.0 z),+ ( Vec3 x 0.0 z),+ ( Vec3 (-x) 0.0 (-z)),+ ( Vec3 x 0.0 (-z)),+ ( Vec3 0.0 z x), + ( Vec3 0.0 z (-x)), + ( Vec3 0.0 (-z) x), + ( Vec3 0.0 (-z) (-x)),+ ( Vec3 z x 0.0),+ ( Vec3 (-z) x 0.0), + ( Vec3 z (-x) 0.0),+ ( Vec3 (-z) (-x) 0.0)+ ]+ + let faces = [++ (0,4,1), (0,9,4), (9,5,4), (4,5,8), (4,8,1), + (8,10,1), (8,3,10), (5,3,8), (5,2,3), (2,7,3),+ (7,10,3), (7,6,10), (7,11,6), (11,0,6), (0,1,6),+ (6,1,10), (9,0,11), (9,11,2), (9,2,5), (7,2,11)+ + ]+ + mo <- _createPlatonObject g3ds colour vertices faces 0+ ManualObject.convertToMesh mo meshName "General"+ entity <- SceneManager.createEntity3 scm meshName+ return $ entity+ ++-- | create a dodekaeder mesh+dodekaederE :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D+ -> Colour -- ^ colour of the dodekaeder+ -> IO HG3DClass -- ^ created dodekaeder mesh as entity+dodekaederE g3ds colour = do+ let (SceneManager scm) = (g3dsSceneManager g3ds)+ uid <- nextUniqueName (g3dsUniqueName g3ds)++ let bodyName = "B" ++ uid+ let meshName = "M" ++ uid+ + let s = 0.618034+ let t = 1.618034++ + let vertices = [+ + (Vec3 1.0 1.0 1.0), + (Vec3 1.0 1.0 (-1.0)), + (Vec3 1.0 (-1.0) 1.0), + (Vec3 1.0 (-1.0) (-1.0)), + (Vec3 (-1.0) 1.0 1.0), + (Vec3 (-1.0) 1.0 (-1.0)), + (Vec3 (-1.0) (-1.0) 1.0), + (Vec3 (-1.0) (-1.0) (-1.0)), + (Vec3 s t 0.0),+ (Vec3 (-s) t 0.0), + (Vec3 s (-t) 0.0),+ (Vec3 (-s) (-t) 0.0), + (Vec3 t 0.0 s), + (Vec3 t 0.0 (-s)),+ (Vec3 (-t) 0.0 s), + (Vec3 (-t) 0.0 (-s)), + (Vec3 0.0 s t),+ (Vec3 0.0 (-s) t), + (Vec3 0.0 s (-t)), + (Vec3 0.0 (-s) (-t))++ ]+ + let faces = [+ +-- (1,8,0,12,13), (4, 9, 5, 15, 14), +-- (2, 10, 3, 13, 12), (7, 11, 6, 14, 15), +-- (2, 12, 0, 16, 17), (1, 13, 3, 19, 18),+-- (4, 14, 6, 17, 16), (7, 15, 5, 18, 19),+-- (4, 16, 0, 8, 9), (2, 17, 6, 11, 10),+-- (1, 18, 5, 9, 8), (7, 19, 3, 10, 11)+ + (1,8,0,12,13), (4, 9, 5, 15, 14), + (2, 10, 3, 13, 12), (7, 11, 6, 14, 15), + (2, 12, 0, 16, 17), (1, 13, 3, 19, 18),+ (4, 14, 6, 17, 16), (7, 15, 5, 18, 19),+ (4, 16, 0, 8, 9), (2, 17, 6, 11, 10),+ (1, 18, 5, 9, 8), (7, 19, 3, 10, 11)+ + ]+ + let faces2 = foldl (++) [] $ map ( \(a, b, c, d, e) -> [ (a, b, e), (b, d, e), (c, d, b) ] ) faces++ mo <- _createPlatonObject g3ds colour vertices faces2 0+ ManualObject.convertToMesh mo meshName "General"+ entity <- SceneManager.createEntity3 scm meshName+ return $ entity
+ HGamer3D/Graphics3D/Internal/Shapes.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2013 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.++-- Graphics3D/Internal/Object3D.hs++-- | Creating and managing 3D objects functionality for Graphics3D module, internal implemenatation module. Public API is HGamer3D.Graphics3D.+module HGamer3D.Graphics3D.Internal.Shapes ++where++import HGamer3D.Data+import HGamer3D.Data.HG3DClass+import HGamer3D.Util+ +import GHC.Ptr++import HGamer3D.Bindings.Ogre.ClassPtr+import HGamer3D.Bindings.Ogre.Utils++import HGamer3D.Bindings.Ogre.StructColour+import HGamer3D.Bindings.Ogre.StructSharedPtr++import HGamer3D.Bindings.Ogre.EnumSceneType+import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace+import HGamer3D.Bindings.Ogre.EnumLightType++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.ClassHG3DUtilities as HG3DUtils++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.Data.Transform3D+import HGamer3D.Graphics3D.Internal.Base++import Control.Monad+import Control.Monad.Trans+import Control.Monad.State.Class++import HGamer3D.Graphics3D.Schema.Material+import HGamer3D.Graphics3D.Schema.Geometry+import HGamer3D.Graphics3D.Schema.Figure+import HGamer3D.Graphics3D.Internal.PlatonShapes+++{- -------------------------------------------------------------------------------+ EngineItem for Geometry+ ------------------------------------------------------------------------------- -}++-- helper functions++_createGeometry :: Graphics3DSystem -> Geometry -> IO OEntity+_createGeometry g3ds geo = do+ let (SceneManager scm) = (g3dsSceneManager g3ds)+ entity <- case geo of+ ResourceGeometry s -> SceneManager.createEntity3 scm s+ Cube -> SceneManager.createEntity6 scm PT_CUBE+ Sphere -> SceneManager.createEntity6 scm PT_SPHERE+ Ikosaeder -> ikosaederE g3ds white+ Dodekaeder -> dodekaederE g3ds white+ Plane -> SceneManager.createEntity6 scm PT_PLANE+ _ -> error "HGamer3D.Graphics3D.Internal.Shapes._createMesh: Geo not implemented"+ let rE = OE entity+ if (geo /= Dodekaeder) && (geo /= Ikosaeder) then+ _buildTV rE+ else return ()+ return $ rE++_buildTV :: OEntity -> IO ()+_buildTV (OE entity) = HG3DUtils.buildTangentVectors entity+++{- -------------------------------------------------------------------------------+ EngineItem for Figure+ ------------------------------------------------------------------------------- -}++_createResourceFigure :: Graphics3DSystem -> String -> IO OEntity+_createResourceFigure g3ds name = do+ let (SceneManager scm) = (g3dsSceneManager g3ds)+ -- create the entity from the mesh+ entity <- SceneManager.createEntity3 scm name+ return $ OE entity++_setMaterial :: OEntity -> Material -> IO ()+_setMaterial (OE entity) material = do+ case material of+ (ResourceMaterial name) -> do+ Entity.setMaterialName entity name "General"+ _ -> error "HGamer3D.Graphics3D.Internal.Shapes._setMaterial: Material not implemented"++_setNodePOS n pos ori siz = do+ setNodePos n pos+ setNodeOri n ori+ setNodeSiz n siz+ +_createFigure :: Graphics3DSystem -> ONode -> Figure -> IO (EngineData)+_createFigure g3ds parent fig = do+ node <- _createSubNode parent+ case fig of+ SimpleFigure geo mat -> do+ meshEntity <- _createGeometry g3ds geo+ _setMaterial meshEntity mat+ _addEntityToNode g3ds node meshEntity+ return (EDEntityNode meshEntity node)+ ResourceFigure name -> do+ meshEntity <- _createResourceFigure g3ds name+ _buildTV meshEntity+ _addEntityToNode g3ds node meshEntity+ return (EDEntityNode meshEntity node)+ CombinedFigure arrSubs -> do+ resArr <- mapM (\(pos, ori, size, fig) -> do+ newData <- _createFigure g3ds node fig+ _setNodePOS newData pos ori size+ return newData) arrSubs+ return (EDNodeAndSub node resArr)++data UpdateActions = ResetMaterial+ | ResetGeometry+ | ResetResource+ | CompareSub+ | Rebuild+ | DoNothing+ + deriving (Eq, Show)+++_updateFigure :: Graphics3DSystem -> ONode -> EngineData -> Figure -> Figure -> IO (EngineData)+_updateFigure g3ds parent edata oldFig newFig = do+ let node = getNode edata++ -- check, which action is needed+ + let action = case oldFig of+ SimpleFigure oldGeo oldMat -> case newFig of+ SimpleFigure newGeo newMat -> if newGeo == oldGeo+ then+ if newMat == oldMat+ then DoNothing+ else ResetMaterial+ else ResetGeometry+ ResourceFigure name -> ResetResource+ CombinedFigure _ -> Rebuild+ ResourceFigure oldName -> case newFig of+ ResourceFigure newName -> if newName == oldName+ then DoNothing+ else ResetResource+ SimpleFigure newGeo newMat -> ResetGeometry+ CombinedFigure _ -> Rebuild+ CombinedFigure oldSubs -> case newFig of+ SimpleFigure _ _ -> Rebuild+ ResourceFigure _ -> Rebuild+ CombinedFigure newSubs -> if (length oldSubs) == (length newSubs)+ then CompareSub+ else Rebuild+ + edataNew <-+ + -- perform the single actions, we can keep existing node and single EngineData item form+ if action == ResetMaterial || action == ResetGeometry || action == ResetResource+ then do+ let (EDEntityNode eOld nOld) = edata+ case action of+ ResetMaterial -> do+ let (SimpleFigure geo mat) = newFig+ _setMaterial eOld mat+ return edata+ ResetGeometry -> do+ let (SimpleFigure geo mat) = newFig+ eNew <- _createGeometry g3ds geo+ _setMaterial eNew mat+ _exchangeEntityInNode g3ds nOld eOld eNew+ return (EDEntityNode eNew nOld)+ ResetResource -> do+ let (ResourceFigure name) = newFig+ eNew <- _createResourceFigure g3ds name+ -- _buildTV eNew+ _exchangeEntityInNode g3ds nOld eOld eNew+ return (EDEntityNode eNew nOld)++ -- perform the actions, we compare two equal length subarrays+ else if action == CompareSub+ then do+ let (CombinedFigure oldSubs) = oldFig+ let (CombinedFigure newSubs) = newFig+ let (EDNodeAndSub node' edOldArr) = edata+ outArr <- mapM ( \(oldED, (posO, oriO, sizeO, oldFig), (posN, oriN, sizeN, newFig)) -> do+ newED <- _updateFigure g3ds node' oldED oldFig newFig+ if posO /= posN then setNodePos newED posN else return ()+ if oriO /= oriN then setNodeOri newED oriN else return ()+ if sizeO /= sizeN then setNodeSiz newED sizeN else return ()+ return newED+ ) (zip3 edOldArr oldSubs newSubs)+ return (EDNodeAndSub node' outArr)++ -- perform the actions, do a complete rebuild, since structure does not match+ else if action == Rebuild+ then do+ -- delete old structure (to be done)+ _removeFigure g3ds parent edata+ -- create new structure, this is the easy part+ _createFigure g3ds parent newFig++ -- no action needed, all the same+ else if action == DoNothing+ then return edata++ else return $ error ("HGamer3D.Graphics3D.Internal.Shapes._updateFigure: build action not known " ++ (show action))+ + return edataNew+ +_removeFigure :: Graphics3DSystem -> ONode -> EngineData -> IO ()+_removeFigure g3ds parent edata = do+ case edata of+ EDEntityNode e n -> _removeEntityAndNode g3ds parent e n+ EDNodeAndSub n subs -> (mapM (\edata' -> _removeFigure g3ds n edata') subs) >> return ()+ +instance Graphics3DItem Figure where+ + object3D g3ds fig = do+ rootNode <- _getRootNode g3ds+ edata <- _createFigure g3ds rootNode fig+ return $ Object3D edata fig++ update3D g3ds ob3d newFig = do+ rootNode <- _getRootNode g3ds+ let (Object3D oldEdata oldFig) = ob3d+ newEdata <- _updateFigure g3ds rootNode oldEdata oldFig newFig+ return $ Object3D newEdata newFig++ remove3D g3ds ob3d = do+ rootNode <- _getRootNode g3ds+ let (Object3D edata fig) = ob3d+ _removeFigure g3ds rootNode edata+ return ()+++{- -------------------------------------------------------------------------------+ intelligent constructors for simple geometries+ ------------------------------------------------------------------------------- -}++sphere :: Graphics3DSystem -> Float -> Material -> IO (Object3D Figure)+sphere g3ds radius material = object3D g3ds (CombinedFigure [+ (zeroVec3, unitU, Vec3 radius radius radius,+ SimpleFigure Sphere material) ])++cube :: Graphics3DSystem -> Float -> Material -> IO (Object3D Figure)+cube g3ds len material = object3D g3ds (CombinedFigure [+ (zeroVec3, unitU, Vec3 len len len,+ SimpleFigure Cube material) ])++cuboid :: Graphics3DSystem -> Vec3 -> Material -> IO (Object3D Figure)+cuboid g3ds vec material = object3D g3ds (CombinedFigure [+ (zeroVec3, unitU, vec, SimpleFigure Cube material) ])+ +dodekaeder :: Graphics3DSystem -> Float -> Material -> IO (Object3D Figure)+dodekaeder g3ds len material = object3D g3ds (CombinedFigure [+ (zeroVec3, unitU, Vec3 len len len, SimpleFigure Dodekaeder material) ])+ +ikosaeder :: Graphics3DSystem -> Float -> Material -> IO (Object3D Figure)+ikosaeder g3ds len material = object3D g3ds (CombinedFigure [+ (zeroVec3, unitU, Vec3 len len len, SimpleFigure Ikosaeder material) ])+ +instance HasPosition (Object3D Figure) where+ position obj = Node.getPosition (getNode' obj)+ positionTo obj pos = Node.setPosition (getNode' obj) pos+ +instance HasSize (Object3D Figure) where+ size obj = Node.getScale (getNode' obj)+ sizeTo obj pos = Node.setScale (getNode' obj) pos+ +instance HasOrientation (Object3D Figure) where+ orientation obj = do+ q <- Node.getOrientation (getNode' obj)+ let uq = mkNormal q+ return uq+ orientationTo obj uq = do+ Node.setOrientation (getNode' obj) (fromNormal uq)+ return ()+
− HGamer3D/Graphics3D/Light.hs
@@ -1,196 +0,0 @@-{-# LANGUAGE FlexibleContexts #-} - --- This source file is part of HGamer3D --- (A project to enable 3D game development in Haskell) --- For the latest info, see http://www.hgamer3d.org --- --- (c) 2011-2013 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. - --- Light.hs - --- | Creating and managing Light in Base API. - - -module HGamer3D.Graphics3D.Light ( - - -- * Types - Light (..), - - -- * create and modify light sources - HGamer3D.Graphics3D.Light.setAmbientLight, - pointLight, - spotLight, - setSpotLightAngle, - directionalLight -) - -where - - -import HGamer3D.Data -import HGamer3D.Util - -import GHC.Ptr - -import HGamer3D.Bindings.Ogre.ClassPtr -import HGamer3D.Bindings.Ogre.Utils - -import HGamer3D.Bindings.Ogre.StructColour -import HGamer3D.Bindings.Ogre.StructSharedPtr - -import HGamer3D.Bindings.Ogre.EnumSceneType -import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace -import HGamer3D.Bindings.Ogre.EnumLightType - ---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.ClassManualObject as ManualObject -import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType -import HGamer3D.Bindings.Ogre.StructHG3DClass -import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType - -import HGamer3D.Data.HG3DClass -import HGamer3D.Data.Operation3D -import HGamer3D.Graphics3D.Types -import HGamer3D.Graphics3D.Engine - -import Control.Monad -import Control.Monad.Trans -import Control.Monad.IO.Class -import Control.Monad.State.Class - - - --- | The light. -data Light = Light HG3DClass deriving (Show) - -instance Position3D Light where - - position3D (Light l) = do - pos <- Light.getPosition l - return (pos) - - positionTo3D (Light l) pos = do - let (Vec3 x y z) = pos - Light.setPosition l x y z - return () - -instance Direction3D Light where - - direction3D (Light l) = do - d <- Light.getDirection l - return d - - directionTo3D (Light l) v = do - Light.setDirection2 l v - return () - - --- | Ambient light is present everywhere, this function creates it and sets the colour of it. --- There is no light object, since movement, rotation, scaling would make no sense anyhow. - -setAmbientLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> Colour -> IO () -setAmbientLight g3ds colour = do - let (SceneManager scm) = (g3dsSceneManager g3ds) - SceneManager.setAmbientLight scm colour - return () - - --- | creates a point light at a specific location -pointLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> Colour -- ^ Color of the light - -> Vec3 -- ^ Position, where light is created - -> IO (Light) -- ^ The light object - -pointLight g3ds (Colour r g b al) (Vec3 x y z) = do - let (SceneManager scm) = (g3dsSceneManager g3ds) - lightName <- nextUniqueName (g3dsUniqueName g3ds) - - light <- SceneManager.createLight scm lightName - Light.setType light LT_POINT - Light.setPosition light x y z - Light.setDiffuseColour light r g b - Light.setSpecularColour light r g b - let eo = Light light - return eo - --- | creates a spot light at a specific location -spotLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> Colour -- ^ Color of the light - -> Vec3 -- ^ Position, where light is created - -> IO Light -- ^ The light object -spotLight g3ds (Colour r g b al) (Vec3 x y z) = do - let (SceneManager scm) = (g3dsSceneManager g3ds) - lightName <- nextUniqueName (g3dsUniqueName g3ds) - - light <- SceneManager.createLight scm lightName - Light.setType light LT_SPOTLIGHT - Light.setPosition light x y z - Light.setDiffuseColour light r g b - Light.setSpecularColour light r g b - let eo = Light light - return eo - --- | set the angle of a spotlight -setSpotLightAngle :: Light -- ^ spotlight - -> Angle -- ^ angle of the light cone, should be between 5 and 355 degree - -> IO () -setSpotLightAngle (Light light) a = do - if (a >= (Deg 5)) && (a <= (Deg 355)) - then do - let innerAngle = fromAngle $ a `subA` (Deg 4.5) - let outerAngle = fromAngle $ a `addA` (Deg 4.5) - Light.setSpotlightInnerAngle light innerAngle - Light.setSpotlightOuterAngle light outerAngle - return () - else do - return () - - --- | creates a directional light at a specific location -directionalLight :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> Colour -- ^ Color of the light - -> Vec3 -- ^ Position, where light is created - -> IO (Light) -- ^ The light object - -directionalLight g3ds (Colour r g b al) (Vec3 x y z) = do - let (SceneManager scm) = (g3dsSceneManager g3ds) - lightName <- nextUniqueName (g3dsUniqueName g3ds) - - light <- SceneManager.createLight scm lightName - Light.setType light LT_DIRECTIONAL - Light.setPosition light x y z - Light.setDiffuseColour light r g b - Light.setSpecularColour light r g b - let eo = Light light - return eo -
− HGamer3D/Graphics3D/Object3D.hs
@@ -1,342 +0,0 @@-{-# LANGUAGE FlexibleContexts #-} - --- This source file is part of HGamer3D --- (A project to enable 3D game development in Haskell) --- For the latest info, see http://www.hgamer3d.org --- --- (c) 2011-2013 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. - --- Object3D.hs - --- | Creating and managing 3D objects functionality for Graphics3D module -module HGamer3D.Graphics3D.Object3D ( - - -- * Mesh creation functions, standard meshes - sphereMesh, - cubeMesh, - planeMesh, - resourceMesh, - - -- * Mesh creation functions, special meshes - colouredCubeMesh, - colouredLineMesh, - rainbowCubeMesh, - - -- * clone objects from meshes - object3DFromMesh, - object3DFromObjects, - - -- * Special movements - yaw3D, - roll3D, - pitch3D -) - -where - -import HGamer3D.Data -import HGamer3D.Util - -import GHC.Ptr - -import HGamer3D.Bindings.Ogre.ClassPtr -import HGamer3D.Bindings.Ogre.Utils - -import HGamer3D.Bindings.Ogre.StructColour -import HGamer3D.Bindings.Ogre.StructSharedPtr - -import HGamer3D.Bindings.Ogre.EnumSceneType -import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace -import HGamer3D.Bindings.Ogre.EnumLightType - ---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.ClassHG3DUtilities as HG3DUtils - -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.Data.Operation3D -import HGamer3D.Graphics3D.Types -import HGamer3D.Graphics3D.Engine - -import Control.Monad -import Control.Monad.Trans -import Control.Monad.State.Class - - - --- set the material of an Ogre entity, used during mesh creation -_setMaterial :: HG3DClass -- ^ 3d object - -> Material -- ^ material - -> IO () -_setMaterial entity material = do - case material of - (ResourceMaterial name) -> do - Entity.setMaterialName entity name "General" - return () - - --- | creates a Sphere Mesh, from which Spheres can be cloned -sphereMesh :: Mesh -- ^ the mesh created -sphereMesh = SphereMesh - --- | creates a Cube Mesh, from which Cubes can be cloned -cubeMesh :: Mesh -- ^ the mesh created -cubeMesh = CubeMesh - --- | creates a Plane Mesh, from which Planes can be cloned -planeMesh :: Mesh -- ^ the mesh created -planeMesh = PlaneMesh - --- | creates a Plane Mesh, from which Planes can be cloned -resourceMesh :: String -- ^ the name of the resource - -> Mesh -- ^ the mesh created -resourceMesh resourceName = ResourceMesh resourceName - --- | clones a 3D object from a mesh -object3DFromMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> Mesh -- ^ mesh used for creation - -> Maybe Material -- ^ a material to be applied, if needed - -> Bool -- ^ flag, build tangent vectors, if set - -> IO Object3D -- ^ created 3d object -object3DFromMesh g3ds mesh mbMaterial buildTV = do - let (SceneManager scm) = (g3dsSceneManager g3ds) - -- create the entity from the mesh - entity <- case mesh of - CubeMesh -> SceneManager.createEntity6 scm PT_CUBE - SphereMesh -> SceneManager.createEntity6 scm PT_SPHERE - PlaneMesh -> SceneManager.createEntity6 scm PT_PLANE - ResourceMesh resourceName -> SceneManager.createEntity3 scm resourceName - ManualMesh meshName -> SceneManager.createEntity3 scm meshName - -- create tangent vectors - if buildTV then - HG3DUtils.buildTangentVectors entity - else - return () - -- apply material, if needed, wanted - case mbMaterial of - Just material -> _setMaterial entity material - Nothing -> return () - -- now create node and attach entity to it - rootNode <- SceneManager.getRootSceneNode scm - let vzero = Vec3 0.0 0.0 0.0 - let qident = Q (Vec4 1.0 0.0 0.0 0.0) - node <- SceneNode.createChildSceneNode rootNode vzero qident - SceneNode.attachObject node entity - -- return object - return (SingleObject3D mesh node) - -_getNode :: Object3D -> HG3DClass -_getNode (SingleObject3D entity node) = node -_getNode (CombinedObject3D objects node) = node - --- | combine 3D objects to a new object -object3DFromObjects :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - ->[Object3D] -- ^ A list of objects, to be grouped - -> IO Object3D -- ^ The return value is a new 3d object. -object3DFromObjects g3ds listObjects = do - let (SceneManager scm) = (g3dsSceneManager g3ds) - rootNode <- SceneManager.getRootSceneNode scm - let vzero = Vec3 0.0 0.0 0.0 - let qident = Q (Vec4 1.0 0.0 0.0 0.0) - node <- SceneNode.createChildSceneNode rootNode vzero qident - sequence_ (map ( \object -> do - let objectnode = _getNode object - parent <- Node.getParent objectnode - Node.removeChild2 parent objectnode - Node.addChild node objectnode - return () ) listObjects) - return ( CombinedObject3D listObjects node) - --- | Creates a line with a colour from start and end point (mesh as object template) -colouredLineMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> Vec3 -- ^ start point - -> Vec3 -- ^ end point - -> Colour -- ^ colour - -> IO Mesh -- ^ line mesh -colouredLineMesh g3ds vStart vEnd colour = do - uid <- nextUniqueName (g3dsUniqueName g3ds) - let (SceneManager scm) = (g3dsSceneManager g3ds) - let lineName = "L" ++ uid - let meshName = "M" ++ uid - - mo <- SceneManager.createManualObject scm lineName - ManualObject.begin mo "BaseWhiteNoLighting" OT_LINE_LIST "General" - ManualObject.position mo vStart - ManualObject.colour mo colour - ManualObject.position mo vEnd - ManualObject.colour mo colour - ManualObject.end mo - ManualObject.convertToMesh mo meshName "General" - return $ ManualMesh meshName - --- |Creates a coloured cube mesh -colouredCubeMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> Colour -- ^ colour - -> IO Mesh -- ^ cube mesh -colouredCubeMesh g3ds colour = do - uid <- nextUniqueName (g3dsUniqueName g3ds) - let (SceneManager scm) = (g3dsSceneManager g3ds) - let cubeName = "C" ++ uid - let meshName = "M" ++ uid - - mo <- SceneManager.createManualObject scm cubeName - - -- basic parameters - let lsize = 1.0 - let cp = 1.0 * lsize - let cm = -1.0 * lsize - - ManualObject.begin mo "BaseWhiteNoLighting" OT_TRIANGLE_LIST "General" - - ManualObject.position2 mo cm cp cm -- a vertex - ManualObject.colour mo colour - ManualObject.position2 mo cp cp cm -- a vertex - ManualObject.colour mo colour - ManualObject.position2 mo cp cm cm -- a vertex - ManualObject.colour mo colour - ManualObject.position2 mo cm cm cm -- a vertex - ManualObject.colour mo colour - - ManualObject.position2 mo cm cp cp -- a vertex - ManualObject.colour mo colour - ManualObject.position2 mo cp cp cp -- a vertex - ManualObject.colour mo colour - ManualObject.position2 mo cp cm cp -- a vertex - ManualObject.colour mo colour - ManualObject.position2 mo cm cm cp -- a vertex - ManualObject.colour mo colour - - ManualObject.triangle mo 0 1 2 - ManualObject.triangle mo 2 3 0 - ManualObject.triangle mo 4 6 5 - ManualObject.triangle mo 6 4 7 - - ManualObject.triangle mo 0 4 5 - ManualObject.triangle mo 5 1 0 - ManualObject.triangle mo 2 6 7 - ManualObject.triangle mo 7 3 2 - - ManualObject.triangle mo 0 7 4 - ManualObject.triangle mo 7 0 3 - ManualObject.triangle mo 1 5 6 - ManualObject.triangle mo 6 2 1 - - ManualObject.end mo - - ManualObject.convertToMesh mo meshName "General" - return $ ManualMesh meshName - - --- | Creates a rainbow coloured cube mesh -rainbowCubeMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D - -> IO Mesh -rainbowCubeMesh g3ds = do - uid <- nextUniqueName (g3dsUniqueName g3ds) - let (SceneManager scm) = (g3dsSceneManager g3ds) - let cubeName = "C" ++ uid - let meshName = "M" ++ uid - let materialName = "BaseWhiteNoLighting" - - mo <- SceneManager.createManualObject scm cubeName - - -- basic parameters - let lsize = 1.0 - let cp = 1.0 * lsize - let cm = -1.0 * lsize - - ManualObject.begin mo "BaseWhiteNoLighting" OT_TRIANGLE_LIST "General" - - sequence $ map (\(x, y, z, c) -> liftIO (ManualObject.position2 mo x y z) >> liftIO (ManualObject.colour mo c) ) [ - (cm, cp, cm, (Colour 0.0 1.0 0.0 1.0) ), - (cp, cp, cm, (Colour 1.0 1.0 0.0 1.0) ), - (cp, cm, cm, (Colour 1.0 0.0 0.0 1.0) ), - (cm, cm, cm, (Colour 0.0 0.0 0.0 1.0) ), - - (cm, cp, cp, (Colour 0.0 1.0 1.0 1.0) ), - (cp, cp, cp, (Colour 1.0 1.0 1.0 1.0) ), - (cp, cm, cp, (Colour 1.0 0.0 1.0 1.0) ), - (cm, cm, cp, (Colour 0.0 0.0 1.0 1.0) ) ] - - sequence $ map (\(x,y,z) -> ManualObject.triangle mo x y z) [ - (0, 1, 2), - (2, 3, 0), - (4, 6, 5), - (6, 4, 7), - - (0, 4, 5), - (5, 1, 0), - (2, 6, 7), - (7, 3, 2), - - (0, 7, 4), - (7, 0, 3), - (1, 5, 6), - (6, 2, 1) ] - - ManualObject.end mo - ManualObject.convertToMesh mo meshName "General" - return $ ManualMesh meshName - -instance Position3D Object3D where - - position3D obj = do - pos <- Node.getPosition (_getNode obj) - return (pos) - - positionTo3D obj pos = do - Node.setPosition (_getNode obj) pos - return () - -instance Scale3D Object3D where - - scale3D obj = do - pos <- Node.getScale (_getNode obj) - return (pos) - - scaleTo3D obj pos = do - Node.setScale (_getNode obj) pos - return () - -instance Orientation3D Object3D where - - orientation3D obj = do - q <- Node.getOrientation (_getNode obj) - let uq = mkNormal q - return uq - - orientationTo3D obj uq = do - Node.setOrientation (_getNode obj) (fromNormal uq) - return () -
− HGamer3D/Graphics3D/PlatonObjects.hs
@@ -1,233 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}---- This source file is part of HGamer3D--- (A project to enable 3D game development in Haskell)--- For the latest info, see http://www.hgamer3d.org------ (c) 2011-2013 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.---- PlatonObjects.hs---- | Create platonic objects, ikosaeder and dodekaeder-module HGamer3D.Graphics3D.PlatonObjects (-- createIkosaederMesh,- createDodekaederMesh-) --where---import GHC.Ptr--import HGamer3D.Data-import HGamer3D.Util--import HGamer3D.Bindings.Ogre.ClassPtr-import HGamer3D.Bindings.Ogre.Utils--import HGamer3D.Bindings.Ogre.StructColour-import HGamer3D.Bindings.Ogre.StructSharedPtr-import HGamer3D.Bindings.Ogre.StructHG3DClass--import HGamer3D.Bindings.Ogre.EnumSceneType-import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace-import HGamer3D.Bindings.Ogre.EnumLightType-import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType-import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType----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.ClassManualObject as ManualObject--import HGamer3D.Graphics3D.Types-import HGamer3D.Graphics3D.Object3D-import HGamer3D.Graphics3D.Engine--import Control.Monad-import Control.Monad.Trans-import Control.Monad.IO.Class-import Control.Monad.State.Class---vminus = Vec3 (-1.0) (-1.0) (-1.0)--getNormOfFace vertices (a, b, c) = normalize cross- where - v1 = vertices !! a- v2 = vertices !! b- v3 = vertices !! c - cross = (v2 &- v1) `crossprod` (v3 &- v1)- --isIn (a, b, c) n = if n == a then True else - if n == b then True else- if n == c then True else- False---_createPlatonObject :: Graphics3DSystem -> Colour -> [Vec3] -> [(Int, Int, Int)] -> Int -> IO HG3DClass-_createPlatonObject g3ds colour vertices faces iColor = do-- let (SceneManager scm) = (g3dsSceneManager g3ds)- uid <- nextUniqueName (g3dsUniqueName g3ds)-- mo <- SceneManager.createManualObject scm uid- -- set Dynamic to false- ManualObject.setDynamic mo False-- let normsOfFaces = map (getNormOfFace vertices) faces- - let vzero = Vec3 0.0 0.0 0.0 - - let normsOfVertices = map vnorm allVerticesIndexes- where - allVerticesIndexes = [ i | i <- [0..(length vertices)]] - vnorm = (\i -> normalize $ foldr (&+) vzero (map (\face -> if isIn face i then normsOfFaces !! i else vzero) faces))-- sequence $ map (\((x,y,z), norm) -> do- ManualObject.begin mo "BaseWhiteNoLightning" OT_TRIANGLE_LIST "General"- ManualObject.position mo (vertices !! x)- ManualObject.normal mo norm- ManualObject.position mo (vertices !! y)- ManualObject.position mo (vertices !! z)- ManualObject.triangle mo 0 1 2- ManualObject.end mo) (zip faces normsOfFaces)-- return mo- ---- | create an ikoaeder mesh - from the mesh more objects can be created-createIkosaederMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D- -> Colour -- ^ colour of the ikosaeder- -> IO Mesh -- ^ created mesh object-createIkosaederMesh g3ds colour = do- let (SceneManager scm) = (g3dsSceneManager g3ds)- uid <- nextUniqueName (g3dsUniqueName g3ds)-- let bodyName = "B" ++ uid- let meshName = "M" ++ uid- - let x = 0.525731112119133606- let z = 0.850650808352039932- - let vertices = [- ( Vec3 (-x) 0.0 z),- ( Vec3 x 0.0 z),- ( Vec3 (-x) 0.0 (-z)),- ( Vec3 x 0.0 (-z)),- ( Vec3 0.0 z x), - ( Vec3 0.0 z (-x)), - ( Vec3 0.0 (-z) x), - ( Vec3 0.0 (-z) (-x)),- ( Vec3 z x 0.0),- ( Vec3 (-z) x 0.0), - ( Vec3 z (-x) 0.0),- ( Vec3 (-z) (-x) 0.0)- ]- - let faces = [-- (0,4,1), (0,9,4), (9,5,4), (4,5,8), (4,8,1), - (8,10,1), (8,3,10), (5,3,8), (5,2,3), (2,7,3),- (7,10,3), (7,6,10), (7,11,6), (11,0,6), (0,1,6),- (6,1,10), (9,0,11), (9,11,2), (9,2,5), (7,2,11)- - ]- - mo <- _createPlatonObject g3ds colour vertices faces 0- ManualObject.convertToMesh mo meshName "General"- return $ ManualMesh meshName- ---- | create a dodekaeder mesh-createDodekaederMesh :: Graphics3DSystem -- ^ the Graphics3D system object, returned by initGraphics3D- -> Colour -- ^ colour of the dodekaeder- -> IO Mesh -- ^ created dodekaeder mesh-createDodekaederMesh g3ds colour = do- let (SceneManager scm) = (g3dsSceneManager g3ds)- uid <- nextUniqueName (g3dsUniqueName g3ds)-- let bodyName = "B" ++ uid- let meshName = "M" ++ uid- - let s = 0.618034- let t = 1.618034-- - let vertices = [- - (Vec3 1.0 1.0 1.0), - (Vec3 1.0 1.0 (-1.0)), - (Vec3 1.0 (-1.0) 1.0), - (Vec3 1.0 (-1.0) (-1.0)), - (Vec3 (-1.0) 1.0 1.0), - (Vec3 (-1.0) 1.0 (-1.0)), - (Vec3 (-1.0) (-1.0) 1.0), - (Vec3 (-1.0) (-1.0) (-1.0)), - (Vec3 s t 0.0),- (Vec3 (-s) t 0.0), - (Vec3 s (-t) 0.0),- (Vec3 (-s) (-t) 0.0), - (Vec3 t 0.0 s), - (Vec3 t 0.0 (-s)),- (Vec3 (-t) 0.0 s), - (Vec3 (-t) 0.0 (-s)), - (Vec3 0.0 s t),- (Vec3 0.0 (-s) t), - (Vec3 0.0 s (-t)), - (Vec3 0.0 (-s) (-t))-- ]- - let faces = [- --- (1,8,0,12,13), (4, 9, 5, 15, 14), --- (2, 10, 3, 13, 12), (7, 11, 6, 14, 15), --- (2, 12, 0, 16, 17), (1, 13, 3, 19, 18),--- (4, 14, 6, 17, 16), (7, 15, 5, 18, 19),--- (4, 16, 0, 8, 9), (2, 17, 6, 11, 10),--- (1, 18, 5, 9, 8), (7, 19, 3, 10, 11)- - (1,8,0,12,13), (4, 9, 5, 15, 14), - (2, 10, 3, 13, 12), (7, 11, 6, 14, 15), - (2, 12, 0, 16, 17), (1, 13, 3, 19, 18),- (4, 14, 6, 17, 16), (7, 15, 5, 18, 19),- (4, 16, 0, 8, 9), (2, 17, 6, 11, 10),- (1, 18, 5, 9, 8), (7, 19, 3, 10, 11)- - ]- - let faces2 = foldl (++) [] $ map ( \(a, b, c, d, e) -> [ (a, b, e), (b, d, e), (c, d, b) ] ) faces-- mo <- _createPlatonObject g3ds colour vertices faces2 0- ManualObject.convertToMesh mo meshName "General"- mesh <- SceneManager.createEntity3 scm meshName- return $ ManualMesh meshName
+ HGamer3D/Graphics3D/Schema/Camera.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- HGamer3D/Graphics3D/Schema/Camera.hs++-- | Types which describe the Scene, the high level of a Scene Tree+module HGamer3D.Graphics3D.Schema.Camera++where++import Data.Typeable+import HGamer3D.Data as Dat++-- | The data to specify a camera+data Camera = Camera { + frustum :: Frustum, -- ^ Frustum of the camera ,+ viewport :: Viewport -- ^ Where to draw on the window+ } deriving (Eq, Show, Typeable)+ +-- | The frustum defines the area from which objects are rendered into the camera+data Frustum = Frustum {+ nearDistance :: Float, -- ^ clipping distance near, objects which are nearer are not shown+ farDistance :: Float, -- ^ clipping distance far, objects, which are more away are not shown+ fieldOfViewHorizontal :: Dat.Angle -- ^ The field of view angle horizontally, the vertical direction is automatically determined by the aspect ratio of the final viewport window.+ } deriving (Eq, Show, Typeable)++deriving instance Typeable1 Dat.Rectangle++data Viewport = Viewport {+ zOrder :: Int, -- ^ Z order in case of overlapping Viewports, higher ZOrders are on top+ position :: Dat.Rectangle Float, -- ^ position of viewport in Window, coordinates reaching from 0.0 to 1.0+ backgroundColor :: Colour+} deriving (Eq, Show, Typeable)+ +
+ HGamer3D/Graphics3D/Schema/Figure.hs view
@@ -0,0 +1,38 @@+{-# Language StandaloneDeriving, DeriveDataTypeable #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- HGamer3D/Graphics3D/Schema/Figure.hs++-- | data types which describe a combined geometry together with materials, a complete figure++module HGamer3D.Graphics3D.Schema.Figure++where++import Data.Typeable+import qualified HGamer3D.Data as D++import HGamer3D.Graphics3D.Schema.Geometry+import HGamer3D.Graphics3D.Schema.Material++data Figure = SimpleFigure Geometry Material+ | ResourceFigure String+ | CombinedFigure [(D.Position, D.Orientation, D.Size, Figure)]+ deriving (Eq, Show, Typeable)+
+ HGamer3D/Graphics3D/Schema/Geometry.hs view
@@ -0,0 +1,50 @@+{-# Language StandaloneDeriving, DeriveDataTypeable #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- HGamer3D/Graphics3D/Schema/Geometry.hs++-- | data types which describe the Geometry ++module HGamer3D.Graphics3D.Schema.Geometry++where++import Data.Typeable+import qualified HGamer3D.Data as D++data Geometry = ++ -- loaded from resources+ ResourceGeometry String++ -- Primitive 3D Geometries+ | Cube+ | Sphere+-- | Cylinder++ -- Platon Geometries+ | Ikosaeder+ | Dodekaeder++ -- 2D Geometries+ | Plane+-- | Line++ deriving (Eq, Show, Typeable)+
+ HGamer3D/Graphics3D/Schema/Light.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- HGamer3D/Graphics3D/Schema/Light.hs++-- | Types which describe Light+module HGamer3D.Graphics3D.Schema.Light++where++import Data.Typeable++import HGamer3D.Data as Dat+++-- | The Light data type+++data Light = Light {+ diffuseColour :: Colour,+ specularColour :: Colour,+ lightType :: LightType+ } deriving (Eq, Show, Typeable)++data LightType = PointLight -- ^ A source shining from one location+ | DirectionalLight Vec3 -- ^ A source shining from one direction (like the sun)+ | SpotLight Vec3 Angle Angle -- ^ A source shining from one location into one direction with a cone,+ -- angles are inner angle, outer angle (a flashlight).+ -- Angles should be between 5 and 355 degrees.+ deriving (Eq, Show, Typeable)+ +++
+ HGamer3D/Graphics3D/Schema/Material.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- HGamer3D/Graphics3D/Schema/Material.hs++-- | data types which describe Materials+module HGamer3D.Graphics3D.Schema.Material++where++import qualified HGamer3D.Data as D+import Data.Typeable++-- | The material itself+data Material = ResourceMaterial String -- ^ the name given the material resource in the resource system+ deriving (Eq, Show, Typeable)++ +
+ HGamer3D/Graphics3D/Schema/Scene.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 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.++-- HGamer3D/Graphics3D/Schema/Scene.hs++-- | Types which describe global Scene Parameters+module HGamer3D.Graphics3D.Schema.Scene++where++import Data.Typeable++import HGamer3D.Data as Dat+import HGamer3D.Graphics3D.Schema.Material++data SceneParameter = SceneParameter {+ ambientLight :: Colour,+ shadowType :: ShadowType,+ skyType :: SkyType+ } deriving (Eq, Show, Typeable)++data ShadowType = NoShadows+ | TextureAdditive+ | TextureModulative+ | StencilAdditive+ | StencilModulative+ deriving (Eq, Show, Typeable)++data SkyType = NoSky+ | SkyBox Material Float -- Distance+ | SkyDome Material Float Float Float -- Curvature, Tiling, Distance+ deriving (Eq, Show, Typeable)
− HGamer3D/Graphics3D/Types.hs
@@ -1,84 +0,0 @@-{-# LANGUAGE FlexibleContexts #-} - --- This source file is part of HGamer3D --- (A project to enable 3D game development in Haskell) --- For the latest info, see http://www.hgamer3d.org --- --- (c) 2011-2013 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. - --- Types.hs - --- | Basic types for the Graphics3D module -module HGamer3D.Graphics3D.Types ( - - -- * Basic Engine Entities - SceneManager (..), - ResourceGroupManager (..), - RootObject (..), - Viewport (..), - LogManager (..), - TextureManager (..), - Camera (..), - RenderTarget (..), - - Graphics3DSystem (..), - - -- * Type Definitions - Object3D (..), - Material (..), - Mesh (..), - -) - -where - -import HGamer3D.Data -import HGamer3D.Util - --- | The material. Define how an object is looking. Currently we have materials from resources -data Material = ResourceMaterial String -- ^ a named material, already installed as a resource - --- | The mesh. A mesh in HGamer3D is just that, a mesh loaded from a template, a manual mesh, or loaded from file. It comes with default --- material, but 3D objects based on this can get other materials individually. -data Mesh = CubeMesh | -- ^ Cube Mesh-Type - PlaneMesh | -- ^ Plane Mesh-Type - SphereMesh | -- ^ Sphere Mesh-Type - ResourceMesh String | -- ^ Mesh resource loaded from file - ManualMesh String -- ^ Manual Mesh-Type, identified by name - --- | The basic 3D object. Each object is a single instance, which can be displayed, moved, scaled, rotated, ... --- Objects are created cloned from meshes (templates for ojbects) or manually, by manual object creation methods. -data Object3D = SingleObject3D Mesh HG3DClass | -- ^ a single object, consisting of a Mesh and a Node (Ogre) - CombinedObject3D [Object3D] HG3DClass -- ^ a combined object,consisting of many objects and a node for the combined one - -data SceneManager = SceneManager HG3DClass -data ResourceGroupManager = ResourceGroupManager HG3DClass -data RootObject = RootObject HG3DClass -data Viewport = Viewport HG3DClass -data TextureManager = TextureManager HG3DClass -data LogManager = LogManager HG3DClass -data Camera = Camera HG3DClass -data RenderTarget = RenderTarget HG3DClass - -data Graphics3DSystem = Graphics3DSystem { - g3dsRoot :: RootObject, - g3dsSceneManager :: SceneManager, - g3dsResourceGroupManager :: ResourceGroupManager, - g3dsLogManager :: LogManager, - g3dsTextureManager :: TextureManager, - g3dsRenderTarget :: RenderTarget, - g3dsUniqueName :: UniqueName -} -
+ HGamer3D/Internal/Graphics3D.hs view
@@ -0,0 +1,38 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2014 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.++-- Graphics.hs++-- | Internal API of Graphics3D (Implementation)+module HGamer3D.Internal.Graphics3D++(+ module HGamer3D.Graphics3D.Internal.Base,+ module HGamer3D.Graphics3D.Internal.Shapes,+ module HGamer3D.Graphics3D.Internal.Light,+ module HGamer3D.Graphics3D.Internal.PlatonShapes,+ module HGamer3D.Graphics3D.Internal.Camera+)++where++import HGamer3D.Graphics3D.Internal.Base+import HGamer3D.Graphics3D.Internal.Shapes+import HGamer3D.Graphics3D.Internal.Light+import HGamer3D.Graphics3D.Internal.PlatonShapes+import HGamer3D.Graphics3D.Internal.Camera