HGamer3D (empty) → 0.1.7
raw patch · 10 files changed
+1307/−0 lines, 10 filesdep +HGamer3D-Datadep +HGamer3D-Ogre-Bindingdep +HGamer3D-SFML-Bindingsetup-changed
Dependencies added: HGamer3D-Data, HGamer3D-Ogre-Binding, HGamer3D-SFML-Binding, Win32, base, directory, haskell98, mtl, text
Files
- HGamer3D.cabal +39/−0
- HGamer3D/APIs/Base/Audio.hs +233/−0
- HGamer3D/APIs/Base/Common.hs +153/−0
- HGamer3D/APIs/Base/Graphics3D/Engine3D.hs +260/−0
- HGamer3D/APIs/Base/Graphics3D/Light.hs +159/−0
- HGamer3D/APIs/Base/Graphics3D/Object3D.hs +214/−0
- HGamer3D/APIs/Base/InputSystem.hs +154/−0
- HGamer3D/BaseAPI.hs +60/−0
- LICENSE +13/−0
- Setup.hs +22/−0
+ HGamer3D.cabal view
@@ -0,0 +1,39 @@+Name: HGamer3D +Version: 0.1.7 +Synopsis: Library to enable 3D game development for Haskell +Description: + Library, to enable 3D game development for Haskell, + based on bindings to 3D Graphics, Audio and GUI libraries. + + This is the module, which includes all other needed modules and provides + an higher level API for primary + use. + + Platform: Windows only + License: Apache License, Version 2.0 + Install: see http://www.althainz.de/HGamer3D/Download-and-Installation.html + +License: OtherLicense +License-file: LICENSE +Author: Peter Althainz +Maintainer: althainz@googlemail.com +Build-Type: Simple +Cabal-Version: >=1.2 +Homepage: http://www.althainz.de/HGamer3D.html +Category: Game +Extra-source-files: Setup.hs + +Library + Build-Depends: base >= 3 && < 5, text, directory, Win32, mtl, HGamer3D-Data == 0.1.7, HGamer3D-Ogre-Binding == 0.1.7, HGamer3D-SFML-Binding == 0.1.7 + + Exposed-modules: HGamer3D.APIs.Base.Common,HGamer3D.APIs.Base.Audio,HGamer3D.APIs.Base.InputSystem,HGamer3D.APIs.Base.Graphics3D.Engine3D,HGamer3D.APIs.Base.Graphics3D.Light,HGamer3D.APIs.Base.Graphics3D.Object3D,HGamer3D.BaseAPI + Other-modules: + + c-sources: + + ghc-options: + cc-options: -Wno-attributes + hs-source-dirs: . + Include-dirs: . + build-depends: haskell98 + extra-libraries: stdc++.dll
+ HGamer3D/APIs/Base/Audio.hs view
@@ -0,0 +1,233 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2011 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- Audio.hs++-- |This module is one sub module of the second attempt, to provide an +-- abstracted interface to the HGamer3D API Bindings. It is named 'Two',+-- submodule Audio and handles Music and Sound.++module HGamer3D.APIs.Base.Audio++(+ -- Enums+ --+ module HGamer3D.Bindings.SFML.EnumSoundSourceStatus,+ + + -- Data+ --+ AudioSource (..), + + -- Listener Functions+ setAudioListenerVolume,+ getAudioListenerVolume,+ setAudioListenerPosition,+ setAudioListenerDirection,++ + -- Source creation and delete Functions+ createMusic,+ createSound,+ deleteAudioSource,+ + -- Source play function+ playAudioSource,+ pauseAudioSource,+ stopAudioSource,+ setAudioSourceLoop,+ getAudioSourceLoop,++ -- Source Functions+ setAudioSourcePitch,+ setAudioSourceVolume,+ setAudioSourcePosition,+ setAudioSourceAttenuation,++ getAudioSourcePitch,+ getAudioSourceVolume,+ getAudioSourceMinDistance,+ getAudioSourceAttenuation,++ attachAudioSourceToListener,+ isAudioSourceAttachedToListener,+ +)++where++import GHC.Ptr++import HGamer3D.APIs.Base.Common+import HGamer3D.Bindings.SFML.ClassPtr+import HGamer3D.Bindings.SFML.Utils++import qualified HGamer3D.Bindings.SFML.ClassListener as Listener+import qualified HGamer3D.Bindings.SFML.ClassMusic as Music +import qualified HGamer3D.Bindings.SFML.ClassSound as Sound+import qualified HGamer3D.Bindings.SFML.ClassSoundBuffer as SoundBuffer+import qualified HGamer3D.Bindings.SFML.ClassSoundSource as SoundSource+import qualified HGamer3D.Bindings.SFML.ClassSoundStream as SoundStream+import HGamer3D.Bindings.SFML.EnumSoundSourceStatus++import HGamer3D.Data.HG3DClass+import Control.Monad.Trans+import Control.Monad.Reader+import HGamer3D.Data.Vector++-- Source types++data AudioSource = Music HG3DClass | Sound HG3DClass HG3DClass+++-- Listener Functions++setAudioListenerVolume :: Float -> MHGamer3D ()+setAudioListenerVolume vol = liftIO $ Listener.setGlobalVolume vol++getAudioListenerVolume :: MHGamer3D Float+getAudioListenerVolume = liftIO $ Listener.getGlobalVolume++setAudioListenerPosition :: Vec3 -> MHGamer3D ()+setAudioListenerPosition (Vec3 x y z) = liftIO $ Listener.setPosition x y z++setAudioListenerDirection :: Vec3 -> MHGamer3D ()+setAudioListenerDirection (Vec3 x y z) = liftIO $ Listener.setDirection x y z+++-- Music Functions, deletion and cretion of Audio types+--++-- | Creates music with name+createMusic :: String -> MHGamer3D (Maybe AudioSource)+createMusic filename = do+ music <- liftIO $ Music.new+ (cs, es) <- ask+ let dir = (csHG3DPath cs)+ fOk <- liftIO $ Music.openFromFile music (dir ++ "\\media\\sound\\" ++ filename)+ if fOk then+ return (Just (Music music))+ else do+ liftIO $ Music.delete music+ return Nothing+++createSound :: String -> MHGamer3D (Maybe AudioSource)+createSound filename = do+ sound <- liftIO $ Sound.new+ buffer <- liftIO $ SoundBuffer.new+ (cs, es) <- ask+ let dir = (csHG3DPath cs)+ fOk <- liftIO $ SoundBuffer.loadFromFile buffer (dir ++ "\\media\\sound\\" ++ filename)+ if fOk then do+ liftIO $ Sound.setBuffer sound buffer + return (Just (Sound sound buffer))+ else do+ liftIO $ Sound.delete sound+ liftIO $ SoundBuffer.delete buffer+ return Nothing++deleteAudioSource :: AudioSource -> MHGamer3D ()+deleteAudioSource (Music music) = do+ liftIO $ Music.delete music+deleteSource (Sound sound buffer) = do+ liftIO $ Sound.delete sound+ liftIO $ SoundBuffer.delete buffer+++-- Source play, pause, stop+--++playAudioSource :: AudioSource -> MHGamer3D ()+playAudioSource (Music music) = do+ liftIO $ SoundStream.play music+playAudioSource (Sound sound buffer) = do+ liftIO $ Sound.play sound++pauseAudioSource :: AudioSource -> MHGamer3D ()+pauseAudioSource (Music music) = do+ liftIO $ SoundStream.pause music+pauseAudioSource (Sound sound buffer) = do+ liftIO $ Sound.pause sound++stopAudioSource :: AudioSource -> MHGamer3D ()+stopAudioSource (Music music) = do+ liftIO $ SoundStream.stop music+stopAudioSource (Sound sound buffer) = do+ liftIO $ Sound.stop sound++getAudioSourceLoop :: AudioSource -> MHGamer3D Bool+getAudioSourceLoop (Music music) = do+ fLoop <- liftIO $ SoundStream.getLoop music+ return fLoop+getAudioSourceLoop (Sound sound buffer) = do+ fLoop <- liftIO $ Sound.getLoop sound+ return fLoop++setAudioSourceLoop :: AudioSource -> Bool -> MHGamer3D ()+setAudioSourceLoop (Music music) fLoop = do+ liftIO $ SoundStream.setLoop music fLoop+setAudioSourceLoop (Sound sound buffer) fLoop = do+ liftIO $ Sound.setLoop sound fLoop+++-- Sound Source Functions+--++setAudioSourcePitch :: AudioSource -> Float -> MHGamer3D ()+setAudioSourcePitch (Music s) p = liftIO $ SoundSource.setPitch s p+setAudioSourcePitch (Sound s b) p = liftIO $ SoundSource.setPitch s p++setAudioSourceVolume :: AudioSource -> Float -> MHGamer3D ()+setAudioSourceVolume (Music s) v = liftIO $ SoundSource.setVolume s v+setAudioSourceVolume (Sound s b) v = liftIO $ SoundSource.setVolume s v++setAudioSourcePosition :: AudioSource -> Vec3 -> MHGamer3D ()+setAudioSourcePosition (Music s) (Vec3 x y z) = liftIO $ SoundSource.setPosition s x y z+setAudioSourcePosition (Sound s b) (Vec3 x y z) = liftIO $ SoundSource.setPosition s x y z++setAudioSourceAttenuation :: AudioSource -> Float -> MHGamer3D ()+setAudioSourceAttenuation (Music s) a = liftIO $ SoundSource.setAttenuation s a+setAudioSourceAttenuation (Sound s b) a = liftIO $ SoundSource.setAttenuation s a++getAudioSourcePitch :: AudioSource -> MHGamer3D Float+getAudioSourcePitch (Music s) = liftIO $ SoundSource.getPitch s+getAudioSourcePitch (Sound s b) = liftIO $ SoundSource.getPitch s+++getAudioSourceVolume :: AudioSource -> MHGamer3D Float+getAudioSourceVolume (Music s) = liftIO $ SoundSource.getVolume s+getAudioSourceVolume (Sound s b) = liftIO $ SoundSource.getVolume s++getAudioSourceMinDistance :: AudioSource -> MHGamer3D Float+getAudioSourceMinDistance (Music s) = liftIO $ SoundSource.getMinDistance s+getAudioSourceMinDistance (Sound s b) = liftIO $ SoundSource.getMinDistance s++getAudioSourceAttenuation :: AudioSource -> MHGamer3D Float+getAudioSourceAttenuation (Music s) = liftIO $ SoundSource.getAttenuation s+getAudioSourceAttenuation (Sound s b) = liftIO $ SoundSource.getAttenuation s++attachAudioSourceToListener :: AudioSource -> Bool -> MHGamer3D ()+attachAudioSourceToListener (Music s) isR = liftIO $ SoundSource.setRelativeToListener s isR+attachAudioSourceToListener (Sound s b) isR = liftIO $ SoundSource.setRelativeToListener s isR++isAudioSourceAttachedToListener :: AudioSource -> MHGamer3D Bool+isAudioSourceAttachedToListener (Music s) = liftIO $ SoundSource.isRelativeToListener s+isAudioSourceAttachedToListener (Sound s b) = liftIO $ SoundSource.isRelativeToListener s++
+ HGamer3D/APIs/Base/Common.hs view
@@ -0,0 +1,153 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2011 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- Engine3D.hs+--++-- Basic functionality of HGamer3D, Base API++module HGamer3D.APIs.Base.Common (++ MHGamer3D,+ Position3D (..),+ Scale3D (..),+ translate3D,+ Direction3D (..),+ Orientation3D (..),++ CommonSystem (..),+ EngineSystem (..),+ + getUniqueName,+ initCommon,+ + TimeMS (..),+ getTimeMS,+ + runMHGamer3D+)++where ++import HGamer3D.Data.Colour+import HGamer3D.Data.Vector+import HGamer3D.Data.Angle+import HGamer3D.Data.HG3DClass++import qualified Data.Text as T+import System.Directory++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Reader+import Control.Monad.State+import Control.Concurrent++import System.Win32.Time++-- identification dll+--+hg3ddllname :: String+hg3ddllname = "HGamer3D-Version-0.1.7-DontDelete.txt"++data CommonSystem = CommonSystem {+ csHG3DPath::String+}+ +data EngineSystem = EngineSystem {+ esRoot::HG3DClass,+ esSceneManager::HG3DClass,+ esResourceGroupManager::HG3DClass,+ esTextureManager::HG3DClass,+ esControllerManager::HG3DClass,+ esLogManager::HG3DClass,+ esCamera::HG3DClass,+ esRenderWindow::HG3DClass,+ esViewport::HG3DClass+} ++type MHGamer3D a = (ReaderT (CommonSystem, EngineSystem)) (StateT [Integer] IO) a++class Position3D t where++ position3D :: t -> MHGamer3D Vec3+ positionTo3D :: t -> Vec3 -> MHGamer3D ()+ +translate3D :: Position3D t => t -> Vec3 -> MHGamer3D ()+translate3D t v = do+ p <- position3D t+ positionTo3D t ( v &+ p )+ return ()++class Scale3D t where + + scale3D :: t -> MHGamer3D Vec3+ scaleTo3D :: t -> Vec3 -> MHGamer3D ()++class Direction3D t where+ direction3D :: t -> MHGamer3D Vec3+ directionTo3D :: t -> Vec3 -> MHGamer3D ()++class Orientation3D t where+ orientation3D :: t -> MHGamer3D UnitQuaternion+ orientationTo3D :: t -> UnitQuaternion -> MHGamer3D ()++-- unique identifiers, by appending a unique integer to a prefix+--++getUniqueName :: String -> StateT [Integer] IO String+getUniqueName prefix = do + (x:xs) <- get+ put xs+ return (prefix ++ (show x))+ ++-- function, which finds installation path of HG3D+--++getHG3DPath :: IO String+getHG3DPath = do+ env <- findExecutable hg3ddllname+ let path = case env of+ Just path -> fst (T.breakOn (T.pack $ "\\bin\\" ++ hg3ddllname) (T.pack path))+ Nothing -> T.pack ""+ return (T.unpack path)++initCommon :: IO CommonSystem+initCommon = do+ csHG3DPath <- getHG3DPath+ return (CommonSystem csHG3DPath)++-- Milliseconds Timescale++data TimeMS = TimeMS Int -- time in milliseconds++instance Show TimeMS where+ show (TimeMS s) = (show s) ++ " Milliseconds"++getTimeMS :: MHGamer3D (TimeMS)+getTimeMS = do + fr <- liftIO $ queryPerformanceFrequency+ wt <- liftIO $ queryPerformanceCounter+ return (TimeMS $ fromIntegral (wt * 1000 `div` fr))+ +runMHGamer3D :: (CommonSystem, EngineSystem) -> [Integer] -> MHGamer3D a -> IO (a, [Integer])+runMHGamer3D (cs, es) s action = do+ (actionResult, newState) <- runStateT (runReaderT action (cs, es) ) s+ return (actionResult, newState)+
+ HGamer3D/APIs/Base/Graphics3D/Engine3D.hs view
@@ -0,0 +1,260 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2011 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- Engine3D.hs+--++-- Basic functionality of the 3D engine++module HGamer3D.APIs.Base.Graphics3D.Engine3D (++ Camera (..),+ HGamer3D.APIs.Base.Graphics3D.Engine3D.getCamera,+ cameraLookAt,+ HGamer3D.APIs.Base.Graphics3D.Engine3D.setBackgroundColour,+ + initEngine3D,+ renderLoop+) ++where+++import GHC.Ptr++import HGamer3D.Bindings.Ogre.ClassPtr+import HGamer3D.Bindings.Ogre.Utils++import HGamer3D.Data.Colour+import HGamer3D.Data.Vector+import HGamer3D.Data.Angle++import HGamer3D.Bindings.Ogre.StructColour+import HGamer3D.Bindings.Ogre.StructSharedPtr++import HGamer3D.Bindings.Ogre.EnumSceneType+import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace++import HGamer3D.Bindings.Ogre.ClassCamera as Camera+import HGamer3D.Bindings.Ogre.ClassRoot as Root+import HGamer3D.Bindings.Ogre.ClassLight as Light+import HGamer3D.Bindings.Ogre.ClassNode as Node+import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager+import HGamer3D.Bindings.Ogre.ClassSceneNode as SceneNode+import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget+import HGamer3D.Bindings.Ogre.ClassRenderWindow as RenderWindow+import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager+import HGamer3D.Bindings.Ogre.ClassTextureManager as TextureManager+import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager+import HGamer3D.Bindings.Ogre.ClassViewport as Viewport+import HGamer3D.Bindings.Ogre.ClassFrustum as Frustum+import HGamer3D.Bindings.Ogre.ClassAnimationState as AnimationState+import HGamer3D.Bindings.Ogre.ClassEntity as Entity+import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager+import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities+import HGamer3D.Bindings.Ogre.ClassLogManager as LogManager+import HGamer3D.Bindings.Ogre.ClassLog as Log++import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject+import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType+import HGamer3D.Bindings.Ogre.StructHG3DClass+import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType++import HGamer3D.Data.HG3DClass+import HGamer3D.APIs.Base.Common++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Reader+import Control.Monad.State+import Control.Concurrent++import System.Win32.Process+import System (getArgs)+++-- Camera functions+--++data Camera = Camera HG3DClass++getCamera :: MHGamer3D Camera+getCamera = do+ (cs, es) <- ask+ let cam = Camera (esCamera es)+ return cam+ +instance Position3D Camera where++ position3D (Camera c) = do+ pos <- liftIO $ Camera.getPosition c+ return (pos)+ + positionTo3D (Camera c) pos = do+ liftIO $ Camera.setPosition2 c pos+ return ()+ +instance Direction3D Camera where++ direction3D (Camera c) = do+ d <- liftIO $ Camera.getDirection c+ return d+ + directionTo3D (Camera c) v = do+ liftIO $ Camera.setDirection2 c v+ +instance Orientation3D Camera where++ orientation3D (Camera c) = do+ q <- liftIO $ Camera.getOrientation c+ let uq = mkNormal q+ return uq+ + orientationTo3D (Camera c) uq = do+ liftIO $ Camera.setOrientation c (fromNormal uq)+ return ()++cameraLookAt (Camera c) v = do+ liftIO $ Camera.lookAt c v+ return ()++-- specific single function+--++setBackgroundColour :: Colour -> MHGamer3D ()+setBackgroundColour bgColour = do+ (cs, es) <- ask+ liftIO $ Viewport.setBackgroundColour (esViewport es) bgColour+++ +initEngine3D :: CommonSystem + -> String -- ^Name of the window, displayed+ -> String -- ^SceneManager type used+ -> IO (EngineSystem)+ +initEngine3D cs windowName sceneManagerType = do++ let hg3dpath = (csHG3DPath cs) + + -- create a good experience for the user, starting the + -- engine, and also, make sure, we can modify options+ + args <- getArgs+ let fConfig = foldl (||) False $ map (\arg -> if arg == "--config" then True else False) args+ let fDX = foldl (||) False $ map (\arg -> if arg == "--directx" then True else False) args+ let fLog = foldl (||) False $ map (\arg -> if arg == "--logging" then True else False) args+ let plugins = if fDX then hg3dpath ++ "\\config\\pluginsDX.cfg" else hg3dpath ++ "\\config\\plugins.cfg"+ let config = if fDX then hg3dpath ++ "\\config\\engineDX.cfg" else hg3dpath ++ "\\config\\engine.cfg"+ print "Here comes the path info"+ print plugins+ print config+ + root <- Root.new plugins config ""+ lmgr <- LogManager.getSingletonPtr+ if not fLog then do+ newlog <- LogManager.createLog lmgr "SilentLog" True False True+ return ()+ else do+ newlog <- LogManager.createLog lmgr "hgamer3d-engine.log" True False False+ return ()+ + fOk <- if fConfig then+ Root.showConfigDialog root+ else do+ fLoaded <- Root.restoreConfig root+ if not fLoaded then+ Root.showConfigDialog root+ else+ return True+ + +-- fUAddResourceLocations "resources.cfg"+ renderWindow <-Root.initialise root True windowName ""+ + -- Suppress logging unless, fLog+ + sceneManager <- Root.createSceneManager root sceneManagerType "SceneManager"+ + camera <- SceneManager.createCamera sceneManager "SimpleCamera"+ Frustum.setNearClipDistance camera 5.0+ Frustum.setFarClipDistance camera 5000.0+ ++ viewport <- RenderTarget.addViewport renderWindow camera 0 0.0 0.0 1.0 1.0+ let bgColor = Colour 0.0 0.0 0.0 1.0+ Viewport.setBackgroundColour viewport bgColor+ + height <- Viewport.getActualHeight viewport+ width <- Viewport.getActualWidth viewport+ + Frustum.setAspectRatio camera ((fromIntegral width) / (fromIntegral height))+ + tm <- TextureManager.getSingletonPtr+ TextureManager.setDefaultNumMipmaps tm 20+ + rgm <- ResourceGroupManager.getSingletonPtr+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\materials") "FileSystem" "General" False+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\Sinbad.zip") "Zip" "General" False+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\ywing.zip") "Zip" "General" False+ ResourceGroupManager.initialiseAllResourceGroups rgm+ + + cm <- ControllerManager.new++ return (EngineSystem root sceneManager rgm tm cm lmgr camera renderWindow viewport )++++-- renderStep a :: TimeMS -> a -> MHGamer3D (Bool, a)+-- this function needs to be defined in ++renderInternalStep :: Int -> TimeMS -> MHGamer3D (Bool, TimeMS)+renderInternalStep frameRate (TimeMS lastTime) = do+ (cs, es) <- ask+ -- adapt to framerate, while still doing messagePump+ (TimeMS time) <- getTimeMS+ let delta = time - lastTime+ let waitTimeMS = (1000.0 / (fromIntegral frameRate) ) - (fromIntegral delta) + time <- if waitTimeMS > 0.0 then do+ liftIO $ sleep (round waitTimeMS)+ (TimeMS time) <- getTimeMS+ return (time)+ else+ return (time)+ -- adapt+ liftIO $ WindowEventUtilities.messagePump+ closed <- liftIO $ RenderWindow.isClosed (esRenderWindow es)+ if (closed) then+ return (False, (TimeMS time))+ else do+ liftIO $ Root.renderOneFrame (esRoot es)+ return (True, (TimeMS time))++renderLoop :: Int -> TimeMS -> a -> (TimeMS -> a -> MHGamer3D (Bool, a)) -> MHGamer3D ()+renderLoop frameRate t a renderStep = do+ (cs, es) <- ask+ (flagStep, time) <- renderInternalStep frameRate t+ let delta = TimeMS (time' - t') where+ TimeMS time' = time+ TimeMS t' = t+ (flagLoop, a) <- renderStep delta a+ if (flagStep && flagLoop) then do+ renderLoop frameRate time a renderStep+ else return ()+
+ HGamer3D/APIs/Base/Graphics3D/Light.hs view
@@ -0,0 +1,159 @@+-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- Light.hs +-- + +-- Light functionality + +module HGamer3D.APIs.Base.Graphics3D.Light ( + + Light (..), + HGamer3D.APIs.Base.Graphics3D.Light.setAmbientLight, + createPointLight, + createSpotLight, + createDirectionalLight + +) + +where + + +import GHC.Ptr + +import HGamer3D.Bindings.Ogre.ClassPtr +import HGamer3D.Bindings.Ogre.Utils + +import HGamer3D.Data.Colour +import HGamer3D.Data.Vector +import HGamer3D.Data.Angle + +import HGamer3D.Bindings.Ogre.StructColour +import HGamer3D.Bindings.Ogre.StructSharedPtr + +import HGamer3D.Bindings.Ogre.EnumSceneType +import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace +import HGamer3D.Bindings.Ogre.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 Control.Monad.Trans +import Control.Monad.Reader +import Control.Monad.State + +import HGamer3D.APIs.Base.Common +import HGamer3D.APIs.Base.Graphics3D.Engine3D + +data Light = Light HG3DClass deriving (Show) + +instance Position3D Light where + + position3D (Light l) = do + pos <- liftIO $ Light.getPosition l + return (pos) + + positionTo3D (Light l) pos = do + let (Vec3 x y z) = pos + liftIO $ Light.setPosition l x y z + return () + +instance Direction3D Light where + + direction3D (Light l) = do + d <- liftIO $ Light.getDirection l + return d + + directionTo3D (Light l) v = do + liftIO $ Light.setDirection2 l v + return () + + +-- | creates a light, which fills all the room with similar strength +setAmbientLight :: Colour -> MHGamer3D () +setAmbientLight colour = do + (cs, es) <- ask + liftIO $ SceneManager.setAmbientLight (esSceneManager es) colour + return () + + +-- | creates a point light at a specific location +createPointLight :: Colour -- ^Color of the light + -> Vec3 -- ^Position, where light is created + -> MHGamer3D (Light) -- ^Return value is a graphics object + +createPointLight colour (Vec3 x y z) = do + (cs, es) <- ask + lightName <- lift $ getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (esSceneManager es) lightName + liftIO $ Light.setType light LT_DIRECTIONAL + liftIO $ Light.setPosition light x y z + let eo = Light light + return eo + +-- | creates a point light at a specific location +createSpotLight :: Colour -- ^Color of the light + -> Vec3 -- ^Position, where light is created + -> MHGamer3D (Light) -- ^Return value is a graphics object + +createSpotLight colour (Vec3 x y z) = do + (cs, es) <- ask + lightName <- lift $ getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (esSceneManager es) lightName + liftIO $ Light.setType light LT_SPOTLIGHT + liftIO $ Light.setPosition light x y z + let eo = Light light + return eo + + +-- | creates a point light at a specific location +createDirectionalLight :: Colour -- ^Color of the light + -> Vec3 -- ^Position, where light is created + -> MHGamer3D (Light) -- ^Return value is a graphics object + +createDirectionalLight colour (Vec3 x y z) = do + (cs, es) <- ask + lightName <- lift $ getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (esSceneManager es) lightName + liftIO $ Light.setType light LT_DIRECTIONAL + liftIO $ Light.setPosition light x y z + let eo = Light light + return eo +
+ HGamer3D/APIs/Base/Graphics3D/Object3D.hs view
@@ -0,0 +1,214 @@+-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- Object3D.hs +-- + +-- Graphics Objects 3D functionality + +module HGamer3D.APIs.Base.Graphics3D.Object3D ( + + Object3D (..), + Material (..), + createSphere, + createCube, + createPlane, + createMesh, + createLine, + setObjectMaterial, + combineObjects +) + +where + + +import GHC.Ptr + +import HGamer3D.Bindings.Ogre.ClassPtr +import HGamer3D.Bindings.Ogre.Utils + +import HGamer3D.Data.Colour +import HGamer3D.Data.Vector +import HGamer3D.Data.Angle + +import HGamer3D.Bindings.Ogre.StructColour +import HGamer3D.Bindings.Ogre.StructSharedPtr + +import HGamer3D.Bindings.Ogre.EnumSceneType +import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace +import HGamer3D.Bindings.Ogre.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 Control.Monad.Trans +import Control.Monad.Reader +import Control.Monad.State + +import HGamer3D.APIs.Base.Common +import HGamer3D.APIs.Base.Graphics3D.Engine3D + + +data Object3D = Object3D HG3DClass HG3DClass | -- node entity + Object3DCombined HG3DClass -- node only + +getNode :: Object3D -> HG3DClass +getNode (Object3D node entity) = node +getNode (Object3DCombined node) = node + +data Material = NamedMaterial String + +createObjectFromEntity :: HG3DClass -> EngineSystem -> IO Object3D +createObjectFromEntity entity es = do + rootNode <- SceneManager.getRootSceneNode (esSceneManager es) + 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 (Object3D node entity) + +createSphere :: MHGamer3D Object3D +createSphere = do + (cs, es) <- ask + entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_SPHERE + ob <- liftIO $ createObjectFromEntity entity es + return (ob) + +createCube :: MHGamer3D Object3D +createCube = do + (cs, es) <- ask + entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_CUBE + ob <- liftIO $ createObjectFromEntity entity es + return (ob) + +createPlane :: MHGamer3D Object3D +createPlane = do + (cs, es) <- ask + entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_PLANE + ob <- liftIO $ createObjectFromEntity entity es + return (ob) + +createMesh :: String -> MHGamer3D Object3D +createMesh name = do + (cs, es) <- ask + entity <- liftIO $ SceneManager.createEntity2 (esSceneManager es) name + ob <- liftIO $ createObjectFromEntity entity es + return (ob) + +createLine :: Vec3 -> Vec3 -> MHGamer3D Object3D +createLine vStart vEnd = do + (cs, es) <- ask + lineName <- lift $ getUniqueName "GO" + name <- lift $ getUniqueName "GO" + let materialName = "BaseWhiteNoLighting" + let colour = Colour 1.0 1.0 1.0 1.0 + mo <- liftIO $ SceneManager.createManualObject (esSceneManager es) lineName + liftIO $ ManualObject.begin mo materialName OT_LINE_LIST "General" + liftIO $ ManualObject.position mo vStart + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position mo vEnd + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.end mo + mesh <- liftIO $ ManualObject.convertToMesh mo name "General" + obj <- createMesh name + return (obj) + +instance Position3D Object3D where + + position3D obj = do + pos <- liftIO $ Node.getPosition (getNode obj) + return (pos) + + positionTo3D obj pos = do + liftIO $ Node.setPosition (getNode obj) pos + return () + +instance Scale3D Object3D where + + scale3D obj = do + pos <- liftIO $ Node.getScale (getNode obj) + return (pos) + + scaleTo3D obj pos = do + liftIO $ Node.setScale (getNode obj) pos + return () + +instance Orientation3D Object3D where + + orientation3D obj = do + q <- liftIO $ Node.getOrientation (getNode obj) + let uq = mkNormal q + return uq + + orientationTo3D obj uq = do + liftIO $ Node.setOrientation (getNode obj) (fromNormal uq) + return () + +setObjectMaterial :: Object3D -> Material -> MHGamer3D () +setObjectMaterial (Object3D node entity) (NamedMaterial name) = do + liftIO $ Entity.setMaterialName entity name "General" +setObjectMaterial (Object3DCombined node) (NamedMaterial name) = do + liftIO $ print "try to set material of combined object, not possible" + + +-- |This function groups objects into a new object +-- it is not perfoming any geometric operations, it just groups the +-- input objects. Can be used, to move and rotate a group. +combineObjects :: [Object3D] -- ^A list of objects, to be grouped + -> MHGamer3D (Object3D) -- ^The return value is a new GraphicsObject +combineObjects listObjects = do + (cs, es) <- ask + rootNode <- liftIO $ SceneManager.getRootSceneNode (esSceneManager es) + let vzero = Vec3 0.0 0.0 0.0 + let qident = Q (Vec4 1.0 0.0 0.0 0.0) + node <- liftIO $ SceneNode.createChildSceneNode rootNode vzero qident + sequence_ (map ( \(Object3D objectnode object) -> do + parent <- liftIO $ Node.getParent objectnode + -- currently no check here, if parent exists! + -- no parent is only valid for root node and this is not accessible to the + -- user of this api (should not be used, at least) + liftIO $ Node.removeChild2 parent objectnode + liftIO $ Node.addChild node objectnode + return () + ) + listObjects) + return ( Object3DCombined node ) + +
+ HGamer3D/APIs/Base/InputSystem.hs view
@@ -0,0 +1,154 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2011 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- InputSystem.hs++-- |This module is the Input System and handles Mouse, Keyboard and Joystick Input.++module HGamer3D.APIs.Base.InputSystem++(+ -- Enums+ --+ module HGamer3D.Bindings.SFML.EnumJoystickAxis,+ module HGamer3D.Bindings.SFML.EnumKey,+ module HGamer3D.Bindings.SFML.EnumMouseButton,+ + -- Joystick Data+ Joystick (..),+ JoystickButton (..),+ + -- Joystick Functions+ updateJoystickStatus,+ + getConnectedJoysticks,+ getJoystickAxes,+ getJoystickButtons,+ + isJoystickButtonPressed,+ getJoystickAxisPosition,+ + -- Keyboard Functions+ isKeyPressed,+ + -- Mouse Functions+ isMouseButtonPressed,+ getMousePosition,+ + + +)++where++import GHC.Ptr++import HGamer3D.Bindings.SFML.ClassPtr+import HGamer3D.Bindings.SFML.Utils++import qualified HGamer3D.Bindings.SFML.ClassJoystick as Joystick+import qualified HGamer3D.Bindings.SFML.ClassKeyboard as Keyboard+import qualified HGamer3D.Bindings.SFML.ClassMouse as Mouse+import qualified HGamer3D.Bindings.SFML.ClassMouseHG3D as Mouse2+import HGamer3D.Bindings.SFML.EnumJoystickAxis+import HGamer3D.Bindings.SFML.EnumKey+import HGamer3D.Bindings.SFML.EnumMouseButton++import HGamer3D.APIs.Base.Common+import HGamer3D.Data.HG3DClass+import Control.Monad.Trans+import Control.Monad.Reader+import HGamer3D.Data.Vector+++-- Joystick Data+data Joystick = Joystick Int deriving (Eq)+data JoystickButton = JoystickButton Int deriving (Eq)++instance Show Joystick where+ show (Joystick j) = show $ "Joystick-" ++ (show j)++instance Show JoystickButton where+ show (JoystickButton jb) = show $ "JoystickButton-" ++ (show jb)++instance Show EnumJoystickAxis where+ show axis = "JoystickAxis-" ++ (case axis of+ JoystickAxisX -> "X"+ JoystickAxisY -> "Y"+ JoystickAxisZ -> "Z"+ JoystickAxisR -> "R"+ JoystickAxisU -> "U"+ JoystickAxisV -> "V"+ JoystickAxisPovX -> "PovX"+ JoystickAxisPovY -> "PoxY"+ )+ ++-- Joystick funtions+--++updateJoystickStatus :: MHGamer3D ()+updateJoystickStatus = liftIO Joystick.update++getConnectedJoysticks :: MHGamer3D [Joystick]+getConnectedJoysticks = do+ let ns = [ x | x <- [0..20]]+ jns <- filterM (\jn -> do+ c <- liftIO $ Joystick.isConnected jn+ return (c) ) ns+ let js = map Joystick jns+ return js++getJoystickAxes:: Joystick -> MHGamer3D [EnumJoystickAxis]+getJoystickAxes (Joystick j) = do+ axes <- filterM ( \a -> do+ liftIO $ Joystick.hasAxis j a) [ JoystickAxisX, JoystickAxisY, JoystickAxisZ, + JoystickAxisR, JoystickAxisU, JoystickAxisV, + JoystickAxisPovX, JoystickAxisPovY ]+ return axes+++getJoystickButtons :: Joystick -> MHGamer3D [JoystickButton]+getJoystickButtons (Joystick j) = do+ jn <- liftIO $ Joystick.getButtonCount j+ let btns = map JoystickButton [0..(jn-1)]+ return btns++isJoystickButtonPressed :: Joystick -> JoystickButton -> MHGamer3D Bool+isJoystickButtonPressed (Joystick j) (JoystickButton b) = liftIO $ Joystick.isButtonPressed j b++getJoystickAxisPosition :: Joystick -> EnumJoystickAxis -> MHGamer3D Float+getJoystickAxisPosition (Joystick j) ax = liftIO $ Joystick.getAxisPosition j ax+++-- Keyboard functions+--++isKeyPressed :: EnumKey -> MHGamer3D Bool+isKeyPressed key = liftIO $ Keyboard.isKeyPressed key++-- Mouse functions+--++isMouseButtonPressed :: EnumMouseButton -> MHGamer3D Bool+isMouseButtonPressed mb = liftIO $ Mouse.isButtonPressed mb++getMousePosition :: MHGamer3D (Int, Int)+getMousePosition = liftIO Mouse2.getPosition++
+ HGamer3D/BaseAPI.hs view
@@ -0,0 +1,60 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2011 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- BaseAPI.hs++-- |This module includes the basic API of HGamer3D++module HGamer3D.BaseAPI++(+ module HGamer3D.Data.Colour,+ module HGamer3D.Data.Vector,+ module HGamer3D.Data.Angle,++ module HGamer3D.APIs.Base.Audio,+ module HGamer3D.APIs.Base.InputSystem,+ module HGamer3D.APIs.Base.Common,+ module HGamer3D.APIs.Base.Graphics3D.Engine3D,+ module HGamer3D.APIs.Base.Graphics3D.Light,+ module HGamer3D.APIs.Base.Graphics3D.Object3D,+ + initHGamer3D++)++where++import HGamer3D.Data.Colour+import HGamer3D.Data.Vector+import HGamer3D.Data.Angle++import HGamer3D.APIs.Base.Audio+import HGamer3D.APIs.Base.InputSystem+import HGamer3D.APIs.Base.Common+import HGamer3D.APIs.Base.Graphics3D.Engine3D+import HGamer3D.APIs.Base.Graphics3D.Light+import HGamer3D.APIs.Base.Graphics3D.Object3D++import Control.Monad.Trans (liftIO)++initHGamer3D windowName = do+ cs <- initCommon+ es <- initEngine3D cs windowName "OctreeSceneManager"+ let s = [1..]+ return ((cs, es), s)
+ LICENSE view
@@ -0,0 +1,13 @@+(c) 2011-2012 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.
+ Setup.hs view
@@ -0,0 +1,22 @@+-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- Setup.hs + +import Distribution.Simple +main = defaultMain