HGamer3D 0.1.8 → 0.1.9
raw patch · 17 files changed
+1972/−906 lines, 17 filesdep +FindBindep +HGamer3D-CEGUI-Bindingdep +containersdep ~HGamer3D-Datadep ~HGamer3D-Ogre-Bindingdep ~HGamer3D-SFML-Binding
Dependencies added: FindBin, HGamer3D-CEGUI-Binding, containers
Dependency ranges changed: HGamer3D-Data, HGamer3D-Ogre-Binding, HGamer3D-SFML-Binding
Files
- HGamer3D.cabal +11/−16
- HGamer3D/APIs/Base/Audio.hs +0/−233
- HGamer3D/APIs/Base/Audio/Audio.hs +246/−0
- HGamer3D/APIs/Base/Common.hs +0/−153
- HGamer3D/APIs/Base/Engine/Engine.hs +270/−0
- HGamer3D/APIs/Base/Engine/Types.hs +98/−0
- HGamer3D/APIs/Base/GUI/BasicGUI.hs +187/−0
- HGamer3D/APIs/Base/GUI/EngineHelper.hs +156/−0
- HGamer3D/APIs/Base/Graphics3D/Basic3D.hs +170/−0
- HGamer3D/APIs/Base/Graphics3D/Engine3D.hs +0/−260
- HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs +172/−0
- HGamer3D/APIs/Base/Graphics3D/Light.hs +18/−15
- HGamer3D/APIs/Base/Graphics3D/Object3D.hs +216/−60
- HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs +245/−0
- HGamer3D/APIs/Base/InputSystem.hs +0/−154
- HGamer3D/APIs/Base/InputSystem/InputSystem.hs +165/−0
- HGamer3D/BaseAPI.hs +18/−15
HGamer3D.cabal view
@@ -1,32 +1,27 @@ Name: HGamer3D -Version: 0.1.8 -Synopsis: Library to enable 3D game development for Haskell +Version: 0.1.9 +Synopsis: Windows Game Engine for the Haskell Programmer 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 + HGamer3D is a game engine for developing 3D games in the programming + language Haskell. The game engine uses available libraries for 3D graphics, + sound, input device handling, gui programming and other areas and make + those functions available for the Haskell programmer by providing + a Haskell API on top of that. HGamer3D is available on Windows only. License: OtherLicense License-file: LICENSE Author: Peter Althainz -Maintainer: althainz@googlemail.com +Maintainer: althainz@gmail.com Build-Type: Simple Cabal-Version: >=1.2 -Homepage: http://www.althainz.de/HGamer3D.html +Homepage: http://www.hgamer3d.org Category: Game Extra-source-files: Setup.hs Library - Build-Depends: base >= 3 && < 5, text, directory, Win32, mtl, HGamer3D-Data == 0.1.8, HGamer3D-Ogre-Binding == 0.1.8, HGamer3D-SFML-Binding == 0.1.8 + Build-Depends: base >= 3 && < 5, containers, text, directory, Win32, mtl, FindBin, HGamer3D-Data >= 0.1.9, HGamer3D-Ogre-Binding == 0.1.9, HGamer3D-SFML-Binding == 0.1.9, HGamer3D-CEGUI-Binding == 0.1.9 - 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 + Exposed-modules: HGamer3D.APIs.Base.Engine.Types,HGamer3D.APIs.Base.Graphics3D.Basic3D,HGamer3D.APIs.Base.Graphics3D.EngineHelper,HGamer3D.APIs.Base.Graphics3D.Light,HGamer3D.APIs.Base.Graphics3D.Object3D,HGamer3D.APIs.Base.Graphics3D.PlatonObjects,HGamer3D.APIs.Base.GUI.BasicGUI,HGamer3D.APIs.Base.GUI.EngineHelper,HGamer3D.APIs.Base.Engine.Engine,HGamer3D.APIs.Base.Audio.Audio,HGamer3D.APIs.Base.InputSystem.InputSystem,HGamer3D.BaseAPI Other-modules: c-sources:
− HGamer3D/APIs/Base/Audio.hs
@@ -1,233 +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.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/Audio/Audio.hs view
@@ -0,0 +1,246 @@+-- 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++-- |Base API, Audio Module, Audio Sub-Module.+-- Basic Audio functionality of the HGamer3D engine.+++module HGamer3D.APIs.Base.Audio.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.Engine.Types++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, gs) <- ask+ let dir = (csHG3DPath cs)+ let progdir = (csProgPath cs)+ -- first try in runtime folder+ fOk <- liftIO $ Music.openFromFile music (dir ++ "\\media\\sound\\" ++ filename)+ if fOk then+ return (Just (Music music))+ else do+ fOk <- liftIO $ Music.openFromFile music (progdir ++ "\\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, gs) <- ask+ let dir = (csHG3DPath cs)+ let progdir = (csProgPath 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+ fOk <- liftIO $ SoundBuffer.loadFromFile buffer (progdir ++ "\\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+deleteAudioSource (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
@@ -1,153 +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.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.8-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/Engine/Engine.hs view
@@ -0,0 +1,270 @@+-- 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.++-- Engine.hs++-- |Base API, Engine Module, Engine Sub-Module.+-- Basic functionality of the HGamer3D engine.+++module HGamer3D.APIs.Base.Engine.Engine (++ getUniqueName,+ mapFunctionToFunctionTag,+ getFunctionFromFunctionTag,+ initCommonSystem,+ + getTimeMS,+ runMHGamer3D,+ initHGamer3D,+ + renderLoop+) ++where+++import GHC.Ptr++import HGamer3D.Data.Colour+import HGamer3D.Data.Vector+import HGamer3D.Data.Angle+import HGamer3D.Data.HG3DClass++import HGamer3D.Bindings.Ogre.ClassRoot as Root+import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump+import HGamer3D.Bindings.Ogre.ClassRenderWindow as RenderWindow+import HGamer3D.Bindings.Ogre.ClassWindowUtilsHG3D as WindowUtils+import HGamer3D.Bindings.CEGUI.ClassSystem as CEGUISystem+import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton+import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController++import HGamer3D.APIs.Base.Engine.Types+import qualified HGamer3D.APIs.Base.InputSystem.InputSystem as IS++import HGamer3D.APIs.Base.Graphics3D.EngineHelper+import HGamer3D.APIs.Base.GUI.EngineHelper++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Reader+import Control.Monad.State+import Control.Concurrent++import System.Win32.Process+import qualified Data.Text as T+import System.Directory+import System.Environment (getArgs)+import qualified Data.Map as Map+import System.Win32.Time+import System.Environment.FindBin+++-- identification dll+--+hg3ddllname :: String+hg3ddllname = "HGamer3D-Version-0.1.9-DontDelete.txt"++-- unique identifiers, by appending a unique integer to a prefix++getUniqueName :: String -> MHGamer3D String+getUniqueName prefix = do ++ HG3DEngineState (x:xs) <- lift get+ lift $ put (HG3DEngineState xs)+ return (prefix ++ (show x))+ +-- event function mapping++mapFunctionToFunctionTag :: EventFunction a -> String -> EventMap a -> EventMap a+mapFunctionToFunctionTag function tag efmap = Map.insert tag function efmap+ +getFunctionFromFunctionTag :: String -> EventMap a -> Maybe (EventFunction a)+getFunctionFromFunctionTag tag efmap = Map.lookup tag efmap+++-- function, which finds installation path of HG3D+--++getHG3DPath :: IO (String, 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 ""+ progpath <- getProgPath+ return (T.unpack path, progpath)++initCommonSystem :: IO CommonSystem+initCommonSystem = do+ (csHG3DPath, csProgPath) <- getHG3DPath+ return (CommonSystem csHG3DPath csProgPath)++-- Milliseconds Timescale+++getTimeMS :: MHGamer3D (TimeMS)+getTimeMS = do + fr <- liftIO $ queryPerformanceFrequency+ wt <- liftIO $ queryPerformanceCounter+ return (TimeMS $ fromIntegral (wt * 1000 `div` fr))+ ++runMHGamer3D :: MHGamer3DState -> MHGamer3D a -> IO (a, MHGamer3DState)+runMHGamer3D (MHGamer3DState readerstate enginestate) action = do+ (actionResult, newEnginestate) <- runStateT (runReaderT action readerstate ) enginestate+ return (actionResult, MHGamer3DState readerstate newEnginestate)++data MouseState = MouseUp | MouseDown deriving (Eq)++data TimeMouseState = TimeMouseState {+ tmsMouse::MouseState,+ tmsTimeMS::TimeMS+ }+ +initTimeMouseState :: MHGamer3D (TimeMouseState)+initTimeMouseState = do+ tms <- getTimeMS+ leftButton <- IS.isMouseButtonPressed IS.MouseButtonLeft+ let ms = if leftButton then MouseUp else MouseDown+ return (TimeMouseState ms tms)+++initHGamer3D :: String -> IO MHGamer3DState+initHGamer3D windowName = do++ -- init Commons configs+ cs <- initCommonSystem+ + -- get flags from program arguments+ let hg3dpath = (csHG3DPath cs) + 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+ + -- init Graphics3D configs and engine+ g3s <- initGraphics3D windowName "OctreeSceneManager" hg3dpath fConfig fDX fLog+ + -- init GUI configs and engine+ gui <- initGUIEngine fLog+ + let state = HG3DEngineState [1..] + return (MHGamer3DState (cs, g3s, gui) state)+ +-- renderStep a :: TimeMS -> a -> MHGamer3D (Bool, a)+-- this function needs to be defined in ++renderInternalStep :: Int -> TimeMouseState -> MHGamer3D (Bool, TimeMouseState)+renderInternalStep frameRate (TimeMouseState lastMouseState (TimeMS lastTime)) = do+ (cs, g3s, gui) <- 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+ let messagePump = g3sMessagePump g3s+ liftIO $ MessagePump.messagePump messagePump+ closed <- liftIO $ RenderWindow.isClosed (g3sRenderWindow g3s)+ if (closed) then+ return (False, (TimeMouseState lastMouseState (TimeMS time)) )+ else do+ -- here comes the things, we need to do each time+ -- + let delta2 = (fromIntegral (time - lastTime)) * 1000.0+ -- mouse state injection+ leftButton <- IS.isMouseButtonPressed IS.MouseButtonLeft+ let ms = if leftButton then MouseDown else MouseUp+ if lastMouseState == MouseUp && ms == MouseDown then do+ liftIO $ CEGUISystem.injectMouseButtonDown (guiSystem gui) CEGUIButton.MouseLeftButton+ return ()+ else do+ return ()+ if lastMouseState == MouseDown && ms == MouseUp then do+ liftIO $ CEGUISystem.injectMouseButtonUp (guiSystem gui) CEGUIButton.MouseLeftButton+ return ()+ else do+ return ()+ -- mouse position injection+ (xm, ym) <- IS.getMousePosition+ leftButton <- IS.isMouseButtonPressed IS.MouseButtonLeft+ (width, height, colorDepth, left, top) <- liftIO $ RenderWindow.getMetrics (g3sRenderWindow g3s)+ (topT, bottomT, leftT, rightT) <- liftIO $ WindowUtils.getWindowTopLeft (g3sRenderWindow g3s) + let offLeft = (rightT - leftT - width) `div` 2+ let offRight = bottomT - topT - height - offLeft+ -- key press injection+ keypressInject+ + let mouseX = xm - left - offLeft+ let mouseY = ym - top - offRight+ liftIO $ CEGUISystem.injectMousePosition (guiSystem gui) (fromIntegral mouseX) (fromIntegral mouseY)+ -- time pulse injection+ liftIO $ CEGUISystem.injectTimePulse (guiSystem gui) delta2+ -- display 3D and GUI+ liftIO $ Root.renderOneFrame (g3sRoot g3s)+ liftIO $ CEGUISystem.renderGUI (guiSystem gui)+ + return (True, (TimeMouseState ms (TimeMS time)) )+++renderInternalLoop :: Int -> TimeMouseState -> gamestateType -> EventMap gamestateType -> (TimeMS -> gamestateType -> MHGamer3D (Bool, gamestateType)) -> MHGamer3D ()+renderInternalLoop frameRate rsold gamestate eventMap renderStep = do+ let (TimeMouseState ms (TimeMS timeold)) = rsold+ gsnew <- getEventsFromGui gamestate eventMap+ (flagStep, rs) <- renderInternalStep frameRate rsold+ let (TimeMouseState ms (TimeMS time)) = rs+ let delta = (TimeMS (time - timeold))+ (flagLoop, gsnew2) <- renderStep delta gsnew+ if (flagStep && flagLoop) then do+ renderInternalLoop frameRate rs gsnew2 eventMap renderStep+ else return ()+ +renderLoop :: Int -> gamestateType -> EventMap gamestateType -> (TimeMS -> gamestateType -> MHGamer3D (Bool, gamestateType)) -> MHGamer3D ()+renderLoop frameRate gamestate eventMap renderStep = do+ rs <- initTimeMouseState+ renderInternalLoop frameRate rs gamestate eventMap renderStep++-- event loop++getEventsFromGui :: a -> EventMap a -> MHGamer3D a+getEventsFromGui a eventMap = do+ (cs, es, gs) <- ask+ let eventController = guiEventController gs+ processEvents <- liftIO $ HG3DEventController.eventsAvailable eventController+ + outera <- if processEvents then do+ (name, sender, window) <- liftIO $ HG3DEventController.popEvent eventController+ let evt = GUIEvent name sender window+ let evtfunc = getFunctionFromFunctionTag name eventMap+ innera <- case evtfunc of+ Just func -> do+ fa <- func evt a+ return fa+ Nothing -> return a+ loopa <- getEventsFromGui innera eventMap+ return loopa+ else do+ return a+ return outera+
+ HGamer3D/APIs/Base/Engine/Types.hs view
@@ -0,0 +1,98 @@+-- 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.++-- Types.hs++-- |Base API, Engine Module, Types Sub-Module.+-- Basic types of the HGamer3D engine.+++module HGamer3D.APIs.Base.Engine.Types (++ MHGamer3D,+ Event (..),+ EventFunction,+ EventMap,+ + CommonSystem (..),+ Graphics3DSystem (..),+ GUISystem (..),+ + HG3DReaderState (..),+ HG3DEngineState (..),+ + MHGamer3DState (..),+ TimeMS (..),+)++where ++import HGamer3D.Data.HG3DClass+import Control.Monad.Reader+import Control.Monad.State+import qualified Data.Map as Map+++data CommonSystem = CommonSystem {+ csHG3DPath::String,+ csProgPath::String+}+ +data Graphics3DSystem = Graphics3DSystem {+ g3sRoot::HG3DClass,+ g3sSceneManager::HG3DClass,+ g3sResourceGroupManager::HG3DClass,+ g3sTextureManager::HG3DClass,+ g3sControllerManager::HG3DClass,+ g3sLogManager::HG3DClass,+ g3sCamera::HG3DClass,+ g3sRenderWindow::HG3DClass,+ g3sViewport::HG3DClass,+ g3sMessagePump::HG3DClass+} ++data GUISystem = GUISystem {+ guiRenderer::HG3DClass,+ guiSystem::HG3DClass,+ guiWindowManager::HG3DClass,+ guiFontManager::HG3DClass,+ guiSchemeManager::HG3DClass,+ guiEventController::HG3DClass+} ++data Event = GUIEvent String String HG3DClass -- name sender window++type EventFunction a = Event -> a -> MHGamer3D a+type EventMap a = Map.Map String (EventFunction a)++type HG3DReaderState = (CommonSystem, Graphics3DSystem, GUISystem)++data HG3DEngineState = HG3DEngineState {+ esUniqueNumbers::[Integer]+}++data MHGamer3DState = MHGamer3DState HG3DReaderState HG3DEngineState++type MHGamer3D a = (ReaderT HG3DReaderState) (StateT HG3DEngineState IO) a+++data TimeMS = TimeMS Int -- time in milliseconds++instance Show TimeMS where+ show (TimeMS s) = (show s) ++ " Milliseconds"+
+ HGamer3D/APIs/Base/GUI/BasicGUI.hs view
@@ -0,0 +1,187 @@+-- 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.++-- BasicGUI.hs++-- |Base API, GUI Module, BasicGUI Sub-Module.+-- Basic GUI functionality.+++module HGamer3D.APIs.Base.GUI.BasicGUI++(+ loadWindowFromFile,+ addWindowToDisplay,+ removeWindowFromDisplay,+ + enableWindow,+ disableWindow,+ activateWindow,+ deactivateWindow,+ showWindow,+ hideWindow,+ + getChildWindow,+ findChildWindowRecursive,+ getWindowProperty,+ setWindowProperty,+ + loadScheme,+ loadFont,+ HGamer3D.APIs.Base.GUI.BasicGUI.setDefaultFont,+ setDefaultMouseCursor,+ HGamer3D.APIs.Base.GUI.BasicGUI.setDefaultTooltip,+ + mapGUIEventToFunctionTag,+ mapGUIEventToFunction+)++where++import GHC.Ptr++import HGamer3D.APIs.Base.Engine.Types+import HGamer3D.APIs.Base.Engine.Engine+import HGamer3D.Bindings.CEGUI.ClassPtr+import HGamer3D.Bindings.CEGUI.Utils++import HGamer3D.Bindings.CEGUI.ClassWindow as Window+import HGamer3D.Bindings.CEGUI.ClassWindowManager as WindowManager+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as WindowManagerHG3D+import HGamer3D.Bindings.CEGUI.ClassWindow as Window+import HGamer3D.Bindings.CEGUI.ClassSystem as System+import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as SystemHG3D+import HGamer3D.Bindings.CEGUI.ClassPropertySet as PropertySet+import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF ++import HGamer3D.Data.HG3DClass+import Control.Monad.Trans+import Control.Monad.Reader+import HGamer3D.Data.Vector+++loadWindowFromFile :: String -> String -> MHGamer3D (HG3DClass)+loadWindowFromFile layoutFile prefix = do+ (cs, g3s, gui) <- ask+ hg3dWinMgr <- liftIO $ WindowManagerHG3D.new+ window <- liftIO $ WindowManagerHG3D.loadWindowLayoutHG3D hg3dWinMgr layoutFile prefix+ liftIO $ WindowManagerHG3D.delete hg3dWinMgr+ return (window)++addWindowToDisplay :: HG3DClass -> MHGamer3D ()+addWindowToDisplay window = do+ (cs, g3s, gui) <- ask+ guiSheet <- liftIO $ System.getGUISheet (guiSystem gui)+ liftIO $ Window.addChildWindow2 guiSheet window++removeWindowFromDisplay :: HG3DClass -> MHGamer3D ()+removeWindowFromDisplay window = do+ (cs, g3s, gui) <- ask+ guiSheet <- liftIO $ System.getGUISheet (guiSystem gui)+ liftIO $ Window.removeChildWindow2 guiSheet window++enableWindow :: HG3DClass -> MHGamer3D ()+enableWindow window = do+ (cs, g3s, gui) <- ask+ liftIO $ Window.enable window++disableWindow :: HG3DClass -> MHGamer3D ()+disableWindow window = do+ (cs, g3s, gui) <- ask+ liftIO $ Window.disable window++activateWindow :: HG3DClass -> MHGamer3D ()+activateWindow window = do+ (cs, g3s, gui) <- ask+ liftIO $ Window.activate window++deactivateWindow :: HG3DClass -> MHGamer3D ()+deactivateWindow window = do+ (cs, g3s, gui) <- ask+ liftIO $ Window.deactivate window++showWindow :: HG3DClass -> MHGamer3D ()+showWindow window = do+ (cs, g3s, gui) <- ask+ liftIO $ Window.show window++hideWindow :: HG3DClass -> MHGamer3D ()+hideWindow window = do+ (cs, g3s, gui) <- ask+ liftIO $ Window.hide window++getChildWindow :: HG3DClass -> String -> MHGamer3D HG3DClass+getChildWindow window name = do+ window <- liftIO $ Window.getChild window name+ return window++findChildWindowRecursive :: HG3DClass -> String -> MHGamer3D (Maybe HG3DClass)+findChildWindowRecursive window name = do+ window <- liftIO $ Window.getChildRecursive window name+ if (ocPtr window) == nullPtr then do+ return Nothing+ else do+ return (Just window)+ +getWindowProperty :: HG3DClass -> String -> MHGamer3D String+getWindowProperty window name = do+ prop <- liftIO $ PropertySet.getProperty window name+ return prop++setWindowProperty :: HG3DClass -> String -> String -> MHGamer3D ()+setWindowProperty window name value = do+ liftIO $ PropertySet.setProperty window name value++loadScheme :: String -> MHGamer3D ()+loadScheme schemeName = do+ (cs, g3s, gui) <- ask+ liftIO $ SystemHG3D.schemeManagerCreate (guiSchemeManager gui) schemeName++loadFont :: String -> MHGamer3D () +loadFont fontName = do+ (cs, g3s, gui) <- ask+ liftIO $ SystemHG3D.fontManagerCreate (guiFontManager gui) fontName+ +setDefaultFont :: String -> MHGamer3D () +setDefaultFont fontName = do+ (cs, g3s, gui) <- ask+ liftIO $ System.setDefaultFont (guiSystem gui) fontName+ +setDefaultMouseCursor :: String -> String -> MHGamer3D () +setDefaultMouseCursor schemeName cursorName = do+ (cs, g3s, gui) <- ask+ liftIO $ System.setDefaultMouseCursor3 (guiSystem gui) schemeName cursorName++setDefaultTooltip :: String -> MHGamer3D () +setDefaultTooltip ttName = do+ (cs, g3s, gui) <- ask+ liftIO $ System.setDefaultTooltip2 (guiSystem gui) ttName++mapGUIEventToFunctionTag :: Event -> String -> MHGamer3D ()+mapGUIEventToFunctionTag event functionTag = do+ case event of+ GUIEvent name sender window -> do+ liftIO $ EvtSF.subscribeScriptedEvent window name functionTag+ return ()++mapGUIEventToFunction :: HG3DClass -> String -> EventFunction a -> EventMap a -> MHGamer3D (EventMap a)+mapGUIEventToFunction window eventName function eventMap = do+ functionTag <- getUniqueName "Event"+ let newmap = mapFunctionToFunctionTag function functionTag eventMap+ liftIO $ EvtSF.subscribeScriptedEvent window eventName functionTag+ return newmap
+ HGamer3D/APIs/Base/GUI/EngineHelper.hs view
@@ -0,0 +1,156 @@+-- 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.++-- EngineHelper.hs++-- |Base API, GUI Module, EngineHelper Sub-Module.+-- Functionality of the GUI module, which is needed for the game engine.+++module HGamer3D.APIs.Base.GUI.EngineHelper++(+ initGUIEngine,+ keypressInject+)++where++import GHC.Ptr++import HGamer3D.Data.HG3DClass+import HGamer3D.Data.Vector++import HGamer3D.Bindings.CEGUI.ClassPtr+import HGamer3D.Bindings.CEGUI.Utils++import HGamer3D.Bindings.CEGUI.ClassOgreRenderer as CEGUIOgreRenderer+import HGamer3D.Bindings.CEGUI.ClassSystem as CEGUISystem+import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as CEGUISystemHG3D+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as CEGUIWindowManagerHG3D+import HGamer3D.Bindings.CEGUI.ClassWindowManager as CEGUIWindowManager+import HGamer3D.Bindings.CEGUI.ClassResourceProvider as CEGUIResourceProvider+import HGamer3D.Bindings.CEGUI.ClassDefaultResourceProvider as CEGUIDefaultResourceProvider+import HGamer3D.Bindings.CEGUI.ClassImageset as CEGUIImageset+import HGamer3D.Bindings.CEGUI.ClassFont as CEGUIFont+import HGamer3D.Bindings.CEGUI.ClassScheme as CEGUIScheme+import HGamer3D.Bindings.CEGUI.ClassWidgetLookManager as CEGUIWidgetLookManager+import HGamer3D.Bindings.CEGUI.ClassScriptModule as CEGUIScriptModule+import HGamer3D.Bindings.CEGUI.ClassLogger as CEGUILogger+import HGamer3D.Bindings.CEGUI.EnumLoggingLevel+import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton+import HGamer3D.Bindings.CEGUI.ClassFontManager as CEGUIFontManager+import HGamer3D.Bindings.CEGUI.ClassSchemeManager as CEGUISchemeManager+import HGamer3D.Bindings.CEGUI.ClassDefaultLogger as CEGUIDefaultLogger+import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController+import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump+++import HGamer3D.APIs.Base.Engine.Types++import Control.Monad.Trans+import Control.Monad.Reader++++initGUIEngine :: Bool -- ^fLog, log yes or no+ -> IO (GUISystem)+ +initGUIEngine fLog = do+++ -- CEGUI system+ ---------------+ + -- first logger, loglevel+ + if not fLog then do+ ceguilog <- CEGUISystemHG3D.createNoLogger + return ()+ else do+ ceguilog <- CEGUIDefaultLogger.new+ CEGUILogger.setLogFilename ceguilog "hgamer3d-gui.log" False+ CEGUILogger.setLoggingLevel ceguilog LoggingLevelInformative+ return ()++ -- bootstrap complete cegui system+ + guirenderer <- CEGUIOgreRenderer.bootstrapSystem+ + guisystem <- CEGUISystem.getSingletonPtr+ guiwindowmgr <- CEGUIWindowManagerHG3D.getSingleton+ guifontmgr <- CEGUISystemHG3D.getFontManagerSingleton+ guischememgr <- CEGUISystemHG3D.getSchemeManagerSingleton+ + CEGUIScheme.setDefaultResourceGroup "Schemes"+ CEGUIImageset.setDefaultResourceGroup "Imagesets"+ CEGUIFont.setDefaultResourceGroup "Fonts"+ CEGUIWidgetLookManager.setDefaultResourceGroup "LookNFeel"+ CEGUIWindowManager.setDefaultResourceGroup "Layouts"+-- CEGUIScriptModule.setDefaultResourceGroup "lua_scripts"++ CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLook.scheme"+ CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLookWidgets.scheme"+ CEGUISystemHG3D.fontManagerCreate guifontmgr "DejaVuSans-10.font"+ + CEGUISystem.setDefaultFont guisystem "DejaVuSans-10"+ CEGUISystem.setDefaultMouseCursor3 guisystem "WindowsLook" "MouseArrow"+ CEGUISystem.setDefaultTooltip2 guisystem "WindowsLook/Tooltip"+ + -- set standard empty gui sheet+ myRoot <- CEGUIWindowManager.createWindow guiwindowmgr "DefaultWindow" "root"+ CEGUISystem.setGUISheet guisystem myRoot+ + eventController <- HG3DEventController.new+ + return (GUISystem guirenderer guisystem guiwindowmgr guifontmgr guischememgr eventController)+++-- keypressInject++keypressInject :: MHGamer3D ()+keypressInject = do+ (cs, g3s, gui) <- ask+ let messagePump = g3sMessagePump g3s+ let gSystem = guiSystem gui+ + processEvents <- liftIO $ MessagePump.eventsPending messagePump+ if processEvents then do+ key <- liftIO $ MessagePump.getKeyDownEvent messagePump+ if key /= 0 then do+ liftIO $ CEGUISystem.injectKeyDown gSystem key+ return ()+ else do+ return ()+ key <- liftIO $ MessagePump.getKeyUpEvent messagePump+ if key /= 0 then do+ liftIO $ CEGUISystem.injectKeyUp gSystem key+ return ()+ else do+ return ()+ char <- liftIO $ MessagePump.getCharEvent messagePump+ if char /= 0 then do+ liftIO $ CEGUISystem.injectChar gSystem char+ return ()+ else do+ return ()+ keypressInject+ return ()+ else do+ return ()+
+ HGamer3D/APIs/Base/Graphics3D/Basic3D.hs view
@@ -0,0 +1,170 @@+ -- 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.++-- Basic3D.hs++-- |Base API, Graphics3D Module, Basic3D Sub-Module.+-- Basic functionality of the HGamer3D engine.+++module HGamer3D.APIs.Base.Graphics3D.Basic3D (++ Position3D (..),+ Scale3D (..),+ translate3D,+ Direction3D (..),+ Orientation3D (..),++ Camera (..),+ HGamer3D.APIs.Base.Graphics3D.Basic3D.getCamera,+ cameraLookAt,+ HGamer3D.APIs.Base.Graphics3D.Basic3D.setBackgroundColour,+ + addResourceLocationMedia,+ addResourceZipfileMedia,+ addResourceLocationGUI,+ finalizeResourceLocations +)++where ++import HGamer3D.Data.Colour+import HGamer3D.Data.Vector+import HGamer3D.Data.Angle+import HGamer3D.Data.HG3DClass++import HGamer3D.Bindings.Ogre.ClassCamera as Camera+import HGamer3D.Bindings.Ogre.ClassViewport as Viewport+import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager++import HGamer3D.APIs.Base.Engine.Types++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Reader+import Control.Monad.State+import Control.Concurrent+++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 ()++-- Camera functions+--++data Camera = Camera HG3DClass++getCamera :: MHGamer3D Camera+getCamera = do+ (cs, g3s, gui) <- ask+ let cam = Camera (g3sCamera g3s)+ 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, g3s, gui) <- ask+ liftIO $ Viewport.setBackgroundColour (g3sViewport g3s) bgColour++-- locations of media in same folder as program resides+-- ++addResourceLocationMedia :: String -> MHGamer3D ()+addResourceLocationMedia path = do+ (cs, g3s, gui) <- ask+ let progPath = csProgPath cs+ let rgm = g3sResourceGroupManager g3s+ liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "FileSystem" "General" False++addResourceZipfileMedia :: String -> MHGamer3D ()+addResourceZipfileMedia path = do+ (cs, g3s, gui) <- ask+ let progPath = csProgPath cs+ let rgm = g3sResourceGroupManager g3s+ liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "Zip" "General" False++addResourceLocationGUI :: String -> String -> MHGamer3D ()+addResourceLocationGUI path category = do+ (cs, g3s, gui) <- ask+ let progPath = csProgPath cs+ let rgm = g3sResourceGroupManager g3s+ liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "FileSystem" category False++finalizeResourceLocations :: MHGamer3D () +finalizeResourceLocations = do+ (cs, g3s, gui) <- ask+ let rgm = g3sResourceGroupManager g3s+ liftIO $ ResourceGroupManager.initialiseAllResourceGroups rgm+
− HGamer3D/APIs/Base/Graphics3D/Engine3D.hs
@@ -1,260 +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.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.Environment (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/EngineHelper.hs view
@@ -0,0 +1,172 @@+-- 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.++-- EngineHelper.hs++-- |Base API, Graphics3D Module, EngineHelper Sub-Module.+-- Functionality of the 3D module, which is needed for the game engine.+++module HGamer3D.APIs.Base.Graphics3D.EngineHelper (++ initGraphics3D+) ++where+++import GHC.Ptr+++import HGamer3D.Data.Colour+import HGamer3D.Data.Vector+import HGamer3D.Data.Angle+import HGamer3D.Data.HG3DClass++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.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.ClassRenderSystem as RenderSystem+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.ClassHG3DMessagePump as MessagePump+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.Bindings.Ogre.ClassWindowUtilsHG3D as WindowUtils++import HGamer3D.APIs.Base.Engine.Types+import HGamer3D.APIs.Base.Graphics3D.Basic3D+import qualified HGamer3D.APIs.Base.InputSystem.InputSystem as IS++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Reader+import Control.Monad.State+import Control.Concurrent++import System.Win32.Process+import System.Environment (getArgs)++initGraphics3D :: String -- ^Name of the window, displayed+ -> String -- ^SceneManager type used+ -> String -- path+ -> Bool -- fConfig+ -> Bool -- fDX+ -> Bool -- fLog+ -> IO (Graphics3DSystem)+ +initGraphics3D windowName sceneManagerType hg3dpath fConfig fDX fLog = do++ 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"+ + 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.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+ + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\schemes") "FileSystem" "Schemes" False+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\imagesets") "FileSystem" "Imagesets" False+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\fonts") "FileSystem" "Fonts" False+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\layouts") "FileSystem" "Layouts" False+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\looknfeel") "FileSystem" "LookNFeel" False+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\lua_scripts") "FileSystem" "LuaScripts" False+ ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\xml_schemas") "FileSystem" "XMLSchemas" False++ + cm <- ControllerManager.new+ WindowUtils.showCursor False+ messagePump <- MessagePump.new+ + return (Graphics3DSystem root sceneManager rgm tm cm lmgr camera renderWindow viewport messagePump )++
HGamer3D/APIs/Base/Graphics3D/Light.hs view
@@ -17,10 +17,11 @@ -- limitations under the License. -- Light.hs --- --- Light functionality +-- |Base API, Graphics3D Module, Light Sub-Module. +-- Creating and managing Light. + module HGamer3D.APIs.Base.Graphics3D.Light ( Light (..), @@ -79,8 +80,10 @@ import Control.Monad.Reader import Control.Monad.State -import HGamer3D.APIs.Base.Common -import HGamer3D.APIs.Base.Graphics3D.Engine3D +import HGamer3D.APIs.Base.Engine.Types +import HGamer3D.APIs.Base.Engine.Engine +import HGamer3D.APIs.Base.Graphics3D.EngineHelper +import HGamer3D.APIs.Base.Graphics3D.Basic3D data Light = Light HG3DClass deriving (Show) @@ -109,8 +112,8 @@ -- | 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 + (cs, g3s, gui) <- ask + liftIO $ SceneManager.setAmbientLight (g3sSceneManager g3s) colour return () @@ -120,9 +123,9 @@ -> 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 + (cs, g3s, gui) <- ask + lightName <- getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName liftIO $ Light.setType light LT_DIRECTIONAL liftIO $ Light.setPosition light x y z let eo = Light light @@ -134,9 +137,9 @@ -> 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 + (cs, g3s, gui) <- ask + lightName <- getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName liftIO $ Light.setType light LT_SPOTLIGHT liftIO $ Light.setPosition light x y z let eo = Light light @@ -149,9 +152,9 @@ -> 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 + (cs, g3s, gui) <- ask + lightName <- getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName liftIO $ Light.setType light LT_DIRECTIONAL liftIO $ Light.setPosition light x y z let eo = Light light
HGamer3D/APIs/Base/Graphics3D/Object3D.hs view
@@ -17,20 +17,34 @@ -- limitations under the License. -- Object3D.hs --- --- Graphics Objects 3D functionality +-- |Base API, Graphics3D Module, Object3D Sub-Module. +-- Creating and managing 3D objects. + module HGamer3D.APIs.Base.Graphics3D.Object3D ( Object3D (..), Material (..), + + Mesh (..), + + createColouredLineMesh, + createColouredCubeMesh, + createRainbowCubeMesh, + + createObject3D, + createSphere, createCube, createPlane, - createMesh, createLine, - setObjectMaterial, + createNamedMeshObject, + createColouredLine, + createColouredCube, + createRainbowCube, + + setObjectMaterial, combineObjects ) @@ -82,74 +96,217 @@ import Control.Monad.Reader import Control.Monad.State -import HGamer3D.APIs.Base.Common -import HGamer3D.APIs.Base.Graphics3D.Engine3D +import HGamer3D.APIs.Base.Engine.Types +import HGamer3D.APIs.Base.Engine.Engine +import HGamer3D.APIs.Base.Graphics3D.EngineHelper +import HGamer3D.APIs.Base.Graphics3D.Basic3D -data Object3D = Object3D HG3DClass HG3DClass | -- node entity - Object3DCombined HG3DClass -- node only +data Object3D = SingleObject3D HG3DClass HG3DClass | -- node entity + CombinedObject3D HG3DClass [Object3D] -- node, subnodes getNode :: Object3D -> HG3DClass -getNode (Object3D node entity) = node -getNode (Object3DCombined node) = node +getNode (SingleObject3D node entity) = node +getNode (CombinedObject3D node objects) = node +getEntities :: Object3D -> [HG3DClass] +getEntities (SingleObject3D node entity) = [entity] +getEntities (CombinedObject3D node objects) = foldl (++) [] (map getEntities objects) + data Material = NamedMaterial String -createObjectFromEntity :: HG3DClass -> EngineSystem -> IO Object3D -createObjectFromEntity entity es = do - rootNode <- SceneManager.getRootSceneNode (esSceneManager es) +data Mesh = CubeMesh | -- Cube Mesh-Type + PlaneMesh | -- Plane Mesh-Type + SphereMesh | -- Sphere Mesh-Type + NamedMesh String | -- Mesh resource loaded from file + ManualMesh String -- Manual Mesh-Type, identified by name + +createColouredLineMesh :: Vec3 -> Vec3 -> Material -> Colour -> MHGamer3D Mesh +createColouredLineMesh vStart vEnd (NamedMaterial materialName) colour = do + (cs, g3s, gui) <- ask + lineName <- getUniqueName "Line" + meshName <- getUniqueName "Mesh" + mo <- liftIO $ SceneManager.createManualObject (g3sSceneManager g3s) 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 + liftIO $ ManualObject.convertToMesh mo meshName "General" + return (ManualMesh meshName) + +-- |Creates a cube by using the ManualObject functionality of Ogre +createColouredCubeMesh :: Material -> Colour -- ^The color of the line + -> MHGamer3D Mesh -- ^Return value is a mesh +createColouredCubeMesh (NamedMaterial materialName) colour = do + + + (cs, g3s, gui) <- ask + cubeName <- getUniqueName "Cube" + meshName <- getUniqueName "Mesh" + + mo <- liftIO $ SceneManager.createManualObject (g3sSceneManager g3s) cubeName + + -- basic parameters + let lsize = 1.0 + let cp = 1.0 * lsize + let cm = -1.0 * lsize + + liftIO $ ManualObject.begin mo materialName OT_TRIANGLE_LIST "General" + + liftIO $ ManualObject.position2 mo cm cp cm -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cp cp cm -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cp cm cm -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cm cm cm -- a vertex + liftIO $ ManualObject.colour mo colour + + liftIO $ ManualObject.position2 mo cm cp cp -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cp cp cp -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cp cm cp -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cm cm cp -- a vertex + liftIO $ ManualObject.colour mo colour + + liftIO $ ManualObject.triangle mo 0 1 2 + liftIO $ ManualObject.triangle mo 2 3 0 + liftIO $ ManualObject.triangle mo 4 6 5 + liftIO $ ManualObject.triangle mo 6 4 7 + + liftIO $ ManualObject.triangle mo 0 4 5 + liftIO $ ManualObject.triangle mo 5 1 0 + liftIO $ ManualObject.triangle mo 2 6 7 + liftIO $ ManualObject.triangle mo 7 3 2 + + liftIO $ ManualObject.triangle mo 0 7 4 + liftIO $ ManualObject.triangle mo 7 0 3 + liftIO $ ManualObject.triangle mo 1 5 6 + liftIO $ ManualObject.triangle mo 6 2 1 + + liftIO $ ManualObject.end mo + + liftIO $ ManualObject.convertToMesh mo meshName "General" + return (ManualMesh meshName) + + +-- create a rainbow coloured cube with manual ojbect lib +-- +createRainbowCubeMesh :: MHGamer3D Mesh +createRainbowCubeMesh = do + + (cs, g3s, gui) <- ask + cubeName <- getUniqueName "Cube" + meshName <- getUniqueName "Mesh" + + let materialName = "BaseWhiteNoLighting" + + mo <- liftIO $ SceneManager.createManualObject (g3sSceneManager g3s) cubeName + + -- basic parameters + let lsize = 1.0 + let cp = 1.0 * lsize + let cm = -1.0 * lsize + + liftIO $ ManualObject.begin mo "BaseWhiteNoLighting" OT_TRIANGLE_LIST "General" + + sequence $ map (\(x, y, z, c) -> liftIO $ ManualObject.position2 mo x y z >> 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) -> liftIO $ 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) ] + + liftIO $ ManualObject.end mo + liftIO $ ManualObject.convertToMesh mo meshName "General" + return (ManualMesh meshName) + + + +createObject3D :: Mesh -> MHGamer3D Object3D +createObject3D mesh = do + (cs, g3s, gui) <- ask + -- first create entity from the mesh + entity <- case mesh of + CubeMesh -> liftIO $ SceneManager.createEntity6 (g3sSceneManager g3s) PT_CUBE + SphereMesh -> liftIO $ SceneManager.createEntity6 (g3sSceneManager g3s) PT_SPHERE + PlaneMesh -> liftIO $ SceneManager.createEntity6 (g3sSceneManager g3s) PT_PLANE + (NamedMesh name) -> liftIO $ SceneManager.createEntity3 (g3sSceneManager g3s) name + (ManualMesh name) -> liftIO $ SceneManager.createEntity3 (g3sSceneManager g3s) name + -- now create node and attach entity to it + rootNode <- liftIO $ SceneManager.getRootSceneNode (g3sSceneManager g3s) 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) - + node <- liftIO $ SceneNode.createChildSceneNode rootNode vzero qident + liftIO $ SceneNode.attachObject node entity + -- return object + return (SingleObject3D node entity) + createSphere :: MHGamer3D Object3D createSphere = do - (cs, es) <- ask - entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_SPHERE - ob <- liftIO $ createObjectFromEntity entity es + ob <- createObject3D SphereMesh return (ob) createCube :: MHGamer3D Object3D createCube = do - (cs, es) <- ask - entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_CUBE - ob <- liftIO $ createObjectFromEntity entity es + ob <- createObject3D CubeMesh return (ob) createPlane :: MHGamer3D Object3D createPlane = do - (cs, es) <- ask - entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_PLANE - ob <- liftIO $ createObjectFromEntity entity es + ob <- createObject3D PlaneMesh return (ob) -createMesh :: String -> MHGamer3D Object3D -createMesh name = do - (cs, es) <- ask - entity <- liftIO $ SceneManager.createEntity2 (esSceneManager es) name - ob <- liftIO $ createObjectFromEntity entity es +createNamedMeshObject :: String -> MHGamer3D Object3D +createNamedMeshObject name = do + ob <- createObject3D (NamedMesh name) 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) +createLine :: Vec3 -> Vec3 -> Colour -> MHGamer3D Object3D +createLine vStart vEnd colour = do + mesh <- createColouredLineMesh vStart vEnd (NamedMaterial "BaseWhiteNoLighting") colour + ob <- createObject3D mesh + return ob +createColouredLine vStart vEnd material colour = do + mesh <- createColouredLineMesh vStart vEnd material colour + ob <- createObject3D mesh + return ob + +createColouredCube material colour = do + mesh <- createColouredCubeMesh material colour + ob <- createObject3D mesh + return ob + +createRainbowCube = do + mesh <- createRainbowCubeMesh + ob <- createObject3D mesh + return ob + instance Position3D Object3D where position3D obj = do @@ -182,33 +339,32 @@ 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" +setObjectMaterial object (NamedMaterial name) = do + let entities = getEntities object + sequence $ map (\entity -> liftIO $ Entity.setMaterialName entity name "General") entities + return () -- |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) + (cs, g3s, gui) <- ask + rootNode <- liftIO $ SceneManager.getRootSceneNode (g3sSceneManager g3s) 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 + sequence_ (map ( \object -> do + let objectnode = getNode object 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 ) - + return ( CombinedObject3D node listObjects)
+ HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs view
@@ -0,0 +1,245 @@+-- 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.++-- PlatonObjects.hs++-- |Base API, Graphics3D Module, PlatonObjects Sub-Module.+-- Creating platonic bodies 3D objects.+++module HGamer3D.APIs.Base.Graphics3D.PlatonObjects (++ createIkosaederMesh,+ createDodekaederMesh,+ createIkosaeder,+ createDodekaeder+ +) ++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.Engine.Types+import HGamer3D.APIs.Base.Engine.Engine+import HGamer3D.APIs.Base.Graphics3D.EngineHelper+import HGamer3D.APIs.Base.Graphics3D.Basic3D+import HGamer3D.APIs.Base.Graphics3D.Object3D+++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 -> String -> String -> Colour -> [Vec3] -> [(Int, Int, Int)] -> Int -> IO HG3DClass+_createPlatonObject g3s name material colour vertices faces iColor = do++ mo <- SceneManager.createManualObject (g3sSceneManager g3s) name+ -- 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 material 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+ +++createIkosaederMesh :: String -> Colour -> MHGamer3D Mesh+createIkosaederMesh material colour = do++ (cs, g3s, gui) <- ask+ bodyName <- getUniqueName "Platon"+ meshName <- getUniqueName "Mesh"+ + 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 <- liftIO $ _createPlatonObject g3s bodyName material colour vertices faces 0+ liftIO $ ManualObject.convertToMesh mo meshName "General"+ return (ManualMesh meshName)+ ++ +createDodekaederMesh :: String -> Colour -> MHGamer3D Mesh+createDodekaederMesh material colour = do++ (cs, g3s, gui) <- ask+ bodyName <- getUniqueName "Platon"+ meshName <- getUniqueName "Mesh"+ + 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 <- liftIO $ _createPlatonObject g3s bodyName material colour vertices faces2 0+ liftIO $ ManualObject.convertToMesh mo meshName "General"+ return (ManualMesh meshName)+++createIkosaeder material colour = do+ mesh <- createIkosaederMesh material colour+ ob <- createObject3D mesh+ return ob+++createDodekaeder material colour = do+ mesh <- createDodekaederMesh material colour+ ob <- createObject3D mesh+ return ob+
− HGamer3D/APIs/Base/InputSystem.hs
@@ -1,154 +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.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/APIs/Base/InputSystem/InputSystem.hs view
@@ -0,0 +1,165 @@+-- 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++-- |Base API, InputSystem Module, InputSystem Sub-Module.+-- The input system handles Mouse, Keyboard and Joystick Input.+++module HGamer3D.APIs.Base.InputSystem.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,+ isJoystickConnected,+ + getJoystickAxes,+ getJoystickButtons,+ + isJoystickButtonPressed,+ getJoystickAxisPosition,+ + -- Keyboard Functions+ isKeyPressed,+ + -- Mouse Functions+ isMouseButtonPressed,+ getMousePosition,+ + + +)++where++import GHC.Ptr++import HGamer3D.Data.HG3DClass+import HGamer3D.Data.Vector++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.Engine.Types++import Control.Monad.Trans+import Control.Monad.Reader+++-- 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..15]]+ jns <- filterM (\jn -> do+ c <- liftIO $ Joystick.isConnected jn+ return (c) ) ns+ let js = map Joystick jns+ return js+ +isJoystickConnected :: Joystick -> MHGamer3D Bool+isJoystickConnected (Joystick jn) = do+ rv <- liftIO $ Joystick.isConnected jn+ return rv+ +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
@@ -27,15 +27,16 @@ 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.Audio.Audio,+ module HGamer3D.APIs.Base.InputSystem.InputSystem,+ module HGamer3D.APIs.Base.Engine.Types,+ module HGamer3D.APIs.Base.Engine.Engine,+ module HGamer3D.APIs.Base.Graphics3D.Basic3D, module HGamer3D.APIs.Base.Graphics3D.Light, module HGamer3D.APIs.Base.Graphics3D.Object3D,+ module HGamer3D.APIs.Base.Graphics3D.PlatonObjects, - initHGamer3D-+ module HGamer3D.APIs.Base.GUI.BasicGUI ) where@@ -44,17 +45,19 @@ 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.Audio.Audio+import HGamer3D.APIs.Base.InputSystem.InputSystem+import HGamer3D.APIs.Base.Engine.Types+import HGamer3D.APIs.Base.Engine.Engine++import HGamer3D.APIs.Base.Graphics3D.Basic3D import HGamer3D.APIs.Base.Graphics3D.Light import HGamer3D.APIs.Base.Graphics3D.Object3D+import HGamer3D.APIs.Base.Graphics3D.PlatonObjects +import qualified Data.Map as Map++import HGamer3D.APIs.Base.GUI.BasicGUI+ import Control.Monad.Trans (liftIO) -initHGamer3D windowName = do- cs <- initCommon- es <- initEngine3D cs windowName "OctreeSceneManager"- let s = [1..]- return ((cs, es), s)